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

Основные возможности
Вообще идея программы родилась случайно, в тот момент когда я наткнулся на статью про General MIDI. Так вот, данная спецификация предусматривает специальный канал под номером 10 для ударных инструментов.
Необходимые номера нот можно найти на этой странице.
Нам потребуются модули: Win32API::MIDI и Tkx. Последний у вас уже будет установлен, если вы используете ActivePerl.
Перейдем к программированию
Определяем хеш, пара: название инструмента => номер ноты
Выставляем значения по умолчанию и ритмический рисунок, как на скриншоте
Создаем объект Win32API::MIDI
Создаем виджет окна программы, устанавливаем заголовок, и отключаем возможность изменения размера
Рисуем интерфейс, биндим хоткеи
Основной цикл, посылаем короткое сообщение секвенсору, вычисляем в зависимости от BPM, интервал через которой вызываем druploop().
Вот и все. Собрал билд под Windows.
Ссылки
Исходный код
Билд под Windows (под Wine тоже работает)

Основные возможности
- 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 тоже работает)