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

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

    image

    Основные возможности
    1. 47 инструментов, одновременно может быть использовано 4.
    2. Управление с клавиатуры.
    3. Регулятор громкости.
    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 тоже работает)
    Поделиться публикацией

    Похожие публикации

    Комментарии 20

      +4
      подсветку синтаксиса хорошо бы… освойте <source>

      название инструмента => номер ноты

      ноты ли? или всё же инструмента?
        +4
        в нотации MIDI именно ноты
          +2
          В наборе инструментов General MIDI принято иметь специальные инструменты, называемые «Drum Set». Они отличаются от обычных инструментов тем, что имеют отдельный звук (сэмпл) на каждую ноту. Например вот так.
            +1
            в mid на канале ударных каждой ноте соответствует свой инструмент
            0
            Спасибо, позалипал в барабаны.
            Автоматизировать бы прогу, нарастание темпа, сделать запись звука для дальнейшего монтажа в форже.
              +4
              Автоматизировать бы прогу, нарастание темпа, сделать запись звука для дальнейшего монтажа в форже

              мне кажется, для этого уже средств напридумывано в достаточном количестве…
                +8
                Травмировали наличием целого мира по ссылке
              –2
              Матрица рассчитана на ввод только четвертей — а хочется хотя-бы восьмые, а так только очень простые ритмы получаются. А в идеале — шестнадцатые и триоли. А также реализацию в виде VST-плагина и встроенный семплер. А вообще спасибо — питон и миди — это для меня ново.
                +9
                Установите Сонар или Кубейс.
                  +1
                  Или на крайняк фрукты
                    0
                    У меня небольшая домашняя студия, поэтому в софте для аудио я разбираюсь. Сонар и Кубейс это DAW. Я предложил дополнить пример возможностью написания VST-плагинов на Питоне Perl. Чтобы этот плагин использовать в любой DAW. Не совсем понимаю, какое отношение Ваш совет «использовать Сонар или Кубейс» имеет к моему комментарию.
                      0
                      Я написал к этому: «шестнадцатые и триоли».
                    +14
                    Это не питон. Это Perl.
                      0
                      Виноват, опечатался. Знаете, бывает такое — думаешь об одном, а пишешь другое, из того, о чем параллельно думаешь. «Опечатка по Фрейду».
                    –3
                    47 инструментов, одновременно может быть использовано 4.

                    У программистов есть 3 числа: 0, 1 и много.
                      +6
                      Мсье знает толк. Perl жив :)
                        +1
                        Вот честно, ждал этого комментария. =)
                        Несомненно Perl жив!
                        +1
                        Как человеку, который не работал с MIDI (да и выводом звука вообще), понравилось. ИМХО элегантно.
                          +1
                          Вот пример на руби с использованием одной из библиотек: github.com/bleything/midiator/blob/master/examples/drum_chords.rb

                          (только что поискал на гитхабе, наткнулся. работает только в MacOS, но довольно знатно работает)
                            +1
                            а забавно спидкор можно писать веселый :)))

                            Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

                            Самое читаемое