Perl Drum Machine 120 Strings

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



Main features

1. 47 instruments at the same time can be used 4.
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 chance, at that moment when I came across an article about General MIDI. So, this specification provides a special channel number 10 for percussion instruments.

The required note numbers can be found on this page .

We need modules: Win32API :: MIDI and Tkx. The latter will already be installed if you are using 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,
 );

Set default values ​​and rhythm patterns 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));

Creating a Win32API :: MIDI Object

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

Create a program window widget, 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 hot keys

 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 it 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. Build build under Windows.

Links
Source
Build under Windows (under Wine also works)