120-line Perl drum machine

Let's try to write a simple drum machine on a pearl using MIDI and Tkx as a graphic toolkit.



Key features

1. 47 tools, 4 can be used simultaneously.
2. Keyboard control.
3. Volume control.
4. BPM regulator from 60 to 600 beats per minute.

In general, the idea of ​​the program was born by accident, at the moment when I came across an article about General MIDI. So, this specification provides a special channel at number 10 for percussion instruments.

The required note numbers can be found on this page .

We will need modules: Win32API :: MIDI and Tkx. The latter will already be installed if you use ActivePerl.

Let's move on to programming

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

Determine the hash, pair: instrument name => note number

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,
);

We set the default values ​​and the rhythmic pattern, as in the screenshot

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 (QWERASDFUIOPHJKL));

Create a Win32API :: MIDI Object

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

Create a widget for the program window, set the title, and disable the ability to resize

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');

We draw the interface, bindim hotkeys

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);

The main loop, we send a short message to the sequencer, we calculate depending on the BPM, the interval through which we call 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;

That's all. I built a build for Windows.

Links
Build source code
for Windows (also works under Wine)