Crazydev
Raiting:
3

Drum Machine in Perl within 120 lines


image
Let us try to write a simple Drum Machine in Perl using MIDI and Tkx as a graphical toolkit.

Key Features

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

General MIDI provides a special channel under number 10 for the percussion instruments.

The required numbers of notes can be found on this webpage.

We need the modules: Win32API:: MIDI and Tkx. The last you have to be installed, if you are using ActivePerl.

Let us move on to the programming
#! / Usr / bin / perl
use strict;
use Tkx;
use Win32API:: MIDI;

Determine a hash, pair: the tool 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,
);

Let us set the default values, and a rhythmic pattern, as it is 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 an object Win32API:: MIDI
my $ mo = new Win32API:: MIDI:: Out () or die "Cannot create MIDI output";

Create a widget to the windows of program, set a header, and disable the ability to change the size
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');

Draw the interface and bind 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, let us send a short message to sequencer, calculate the interval according to the BPM over 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 (60 000 / $ bpm) => \ & drumloop);
}

Tkx:: after (1000 => \ & drumloop);
Tkx:: MainLoop;

That's it. We built for Windows.

References
Source code
Build for Windows (also it supports Wine)
Pirat 4 september 2011, 19:29
Vote for this post
Bring it to the Main Page
 

Comments

Leave a Reply

B
I
U
S
Help
Avaible tags
  • <b>...</b>highlighting important text on the page in bold
  • <i>..</i>highlighting important text on the page in italic
  • <u>...</u>allocated with tag <u> text shownas underlined
  • <s>...</s>allocated with tag <s> text shown as strikethrough
  • <sup>...</sup>, <sub>...</sub>text in the tag <sup> appears as a superscript, <sub> - subscript
  • <blockquote>...</blockquote>For  highlight citation, use the tag <blockquote>
  • <code lang="lang">...</code>highlighting the program code (supported by bash, cpp, cs, css, xml, html, java, javascript, lisp, lua, php, perl, python, ruby, sql, scala, text)
  • <a href="http://...">...</a>link, specify the desired Internet address in the href attribute
  • <img src="http://..." alt="text" />specify the full path of image in the src attribute