Драм-машина на Perl в 120 строк / Хабр

Попробуем написать простенькую драм-машину на перле используя MIDI и Tkx в качестве графического тулкита.

Основные возможности

47 инструментов, одновременно может быть использовано 4.
Управление с клавиатуры.
Регулятор громкости.
Регулятор BPM от 60 до 600 ударов в минуту.

Вообще идея программы родилась случайно, в тот момент когда я наткнулся на статью про General MIDI. Так вот, данная спецификация предусматривает специальный канал под номером 10 для ударных инструментов.

Необходимые номера нот можно найти на этой странице.

Нам потребуются модули: Win32API::MIDI и Tkx. Последний у вас уже будет установлен, если вы используете ActivePerl.

Перейдем к программированию

#!/usr/bin/perl
use strict;
use Tkx;
use Win32API::MIDI;

Определяем хеш, пара: название инструмента => номер ноты

my %drums = (
        'Bass Drum 2'     => 35,
        'Bass Drum 1'     => 36,
        'Side Stick'      => 37,
        'Snare Drum 1'    => 38,
        'Hand Clap'       => 39,
        'Snare Drum 2'    => 40,
        'Low Tom 2'       => 41,
        'Closed Hi-hat'   => 42,
        'Low Tom 1'       => 43,
        'Pedal Hi-hat'    => 44,
        'Mid Tom 2'       => 45,
        'Open Hi-hat'     => 46,
        'Mid Tom 1'       => 47,
        'High Tom 2'      => 48,
        'Crash Cymbal 1'  => 49,
        'High Tom 1'      => 50,
        'Ride Cymbal 1'   => 51,
        'Chinese Cymbal'  => 52,
        'Ride Bell'       => 53,
        'Tambourine'      => 54,
        'Splash Cymbal'   => 55,
        'Cowbell'         => 56,
        'Crash Cymbal 2'  => 57,
        'Vibra Slap'      => 58,
        'Ride Cymbal 2'   => 59,
        'High Bongo'      => 60,
        'Low Bongo'       => 61,
        'Mute High Conga' => 62,
        'Open High Conga' => 63,
        'Low Conga'       => 64,
        'High Timbale'    => 65,
        'Low Timbale'     => 66,
        'High Agogo'      => 67,
        'Low Agogo'       => 68,
        'Cabasa'          => 69,
        'Maracas'         => 70,
        'Short Whistle'   => 71,
        'Long Whistle'    => 72,
        'Short Guiro'     => 73,
        'Long Guiro'      => 74,
        'Claves'          => 75,
        'High Wood Block' => 76,
        'Low Wood Block'  => 77,
        'Mute Cuica'      => 78,
        'Open Cuica'      => 79,
        'Mute Triangle'   => 80,
        'Open Triangle'   => 81,
);

Выставляем значения по умолчанию и ритмический рисунок, как на скриншоте

my $bpm  = 300;
my $bit  = 0;
my $bits = [[0, 1, 1, 0], [0, 0, 1, 0], [1, 0, 0, 0], [1, 0, 1, 0]];

my @volume  = (127, 127, 127, 127);
my @drumset = ('Bass Drum 2', 'Bass Drum 1', 'Snare Drum 1', 'Snare Drum 2');
my @kb_keys = (qw(Q W E R A S D F U I O P H J K L));

Создаем объект Win32API::MIDI

my $mo = new Win32API::MIDI::Out() or die "Cannot create MIDI output";

Создаем виджет окна программы, устанавливаем заголовок, и отключаем возможность изменения размера

my $mw = Tkx::widget->new('.');
   $mw->g_wm_title('Drum Machine in Perl');  
   $mw->g_wm_resizable(0, 0);

my @pad = (-padx => 4, -pady => 4, -sticky => 'nsew');

Рисуем интерфейс, биндим хоткеи

for my $i (0..3) {
        my $combo = $mw->new_ttk__combobox(
                -textvariable => \$drumset[$i],
                -state        => 'readonly',
                -values       => [sort {$drums{$a} <=> $drums{$b}} keys %drums],
        );
        my $scale = $mw->new_ttk__scale(
                -variable => \$volume[$i],
                -from     => 0,
                -to       => 127,
                -length   => 50,
        );
        $combo->g_grid(-row => $i, -column => 0, @pad);
        $scale->g_grid(-row => $i, -column => 1, @pad);
        for my $j (0..3) {
                my $k = $kb_keys[4 * $i + $j];
                my $c = $mw->new_ttk__checkbutton(
                        -variable => \$bits->[$i]->[$j],
                        -style    => 'Toolbutton',
                        -text     => " $k ",
                );
                Tkx::bind(all => $_ => sub { $c->invoke() }) for (lc($k), uc($k));
                Tkx::grid($c, -row => $i, -column => $j + 2, @pad);
        }
}

my $bpm_label = $mw->new_ttk__label(-text => "$bpm BPM");
my $bpm_scale = $mw->new_ttk__scale(
        -variable => \$bpm,
        -from     => 60,
        -to       => 600,
        -command  => sub { $bpm_label->m_configure(-text => int($bpm).' BPM') },
);

$bpm_label->g_grid(-row => 4, -column => 0);
$bpm_scale->g_grid(-row => 5, -column => 0);

Основной цикл, посылаем короткое сообщение секвенсору, вычисляем в зависимости от BPM, интервал через которой вызываем druploop().

sub drumloop {
        my $b = $bit++ % 4;
        for (0..3) {
                if ($bits->[$_]->[$b]) {
                        $mo->ShortMsg((0x00000090 | 9) | ($drums{$drumset[$_]} << 8) | ($volume[$_] << 16));
                }
        }
        Tkx::after(int(60000 / $bpm) => \&drumloop);
}

Tkx::after(1000 => \&drumloop);
Tkx::MainLoop;

Вот и все. Собрал билд под Windows.

Ссылки
Исходный код
Билд под Windows (под Wine тоже работает)

Драм-машина на Perl в 120 строк

Публикации

Ближайшие события