1. На проекте открылась регистрация только для продавцов. Для обычных пользователей будет открыта позже. Подробнее.
    P.S. Не надо скидывать ссылки на форумы, где у вас ноль сообщений. Подобные заявки будут отклонятся.
Скрыть объявление
Привет, Незнакомец! У тебя есть возможность Оставить комментарий в теме

Perl Драм-машина на Perl

Тема в разделе "PR0GRAMM1NG", создана пользователем ddd, 2 май 2011.

  1. ddd (•̪̀●́)=o/̵͇̿̿/'̿̿ ̿ ̿̿

    ddd
    TS
    Команда форума WebOwner WebVoice
    Регистрация:
    5 мар 2007
    Сообщения:
    2.898
    Симпатии:
    191
    ICQ:
    943084
    Попробуем написать простенькую драм-машину на перле используя MIDI и Tkx в качестве графического тулкита.

    [​IMG]

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

    Взято с хабра