http://www.perlmonks.org?node_id=46346
Category: Sound
Author/Contact Info OeufMayo
Description:

Tired of those dull breakbeats, drumloops you listen all day long on the radio? Now is the time to make your own young man! With the Brand New BeatBox 2001(tm), this all-in-one script will bring you thousands of hours of fun, you'll be the amazment of your neighbourhood. So don't waist no more time and grab this one!

Major Update 2001-10-30: The BeatBox 2001™ now runs under strict (it was about time!), take its input from STDIN and write to STDOUT. I also got rid of the nasty/ugly evals. It should make this thing a bit more useful than it previously was. kudos to larsen for showing some interests to weird music stuff.

Halloween Update 2001-10-31: Changed the instrument names to be more like what you can find on regular drums tabs, added a -t tempo switch and more groovy patterns. Share & enjoy!

Halloween2 Update 2001-10-31: added a 'push',a comma and removed a '=', so you can now have several PLAY() lines in your tabs.

#!/usr/bin/perl -sw
# BeatBox2001
use strict;

#
# usage: BeatBox [-t=120] input.tab | timidity -
#     or BeatBox input.tab > output.mid
#
# The -t switch can be optionnaly be used to set the tempo
# (default 60)
#
# See the __DATA__ section for instructions on how to 
# write the input.tab files
#

use MIDI::Simple;
new_score;

$main::t ||= 60;
set_tempo( 100000 / ($main::t / 120) );

my %beatbox = process();
play_beat( \%beatbox );
write_score( \*STDOUT );

exit;

### Process the 'music sheet' ###
sub process {
    my ( %beatbox, $module_flag );
    while (<>) {
        next if /^#/;
        if (/^\s*PLAY\(([^)]+)\)/) {
            push @{ $beatbox{'PLAYLIST'} }, split ( /,/, $1 );
        }
        if (/^\s*\*(\w+)\*$/) { $module_flag = $1 }

        if (/^\s*(\w+)\s*:\s*([x|-]+)$/) {
            my ( $instr, $event ) = ( $1, $2 );
            @{ $beatbox{$module_flag}{$instr} } = split ( //, $event )
+;
        }
    }
    return %beatbox;
}

### Make some noise ###
sub play_beat {
    my %beatbox = %{ +shift };

    my $patches = load_patches();

    foreach my $segment ( @{ $beatbox{'PLAYLIST'} } ) {
        foreach my $beat ( 0 .. 15 ) {
            synch(map {
               $beatbox{$segment}{$_}[$beat] eq 'x' && exists $patches
+->{$_} ?
               $patches->{$_} : $patches->{'_silent_'};
              } keys %{ $beatbox{$segment}}
            );
        }
    }
}

### Instruments (ab)used by the processor ###
#
# the (n35, n44, n42, ...) are the notes of the percussions
# on channel 9.
sub load_patches {
    my $patches = {

        '_silent_' => sub { my $it = shift; $it->r },

        # Drums
        'C'  => sub { my $it = shift; $it->n('c9','ff','n35','qn')},
        'H'  => sub { my $it = shift; $it->n('c9','mf','n44','qn')},
        'Rd' => sub { my $it = shift; $it->n('c9','mf','n44','qn')},
        't'  => sub { my $it = shift; $it->n('c9','mf','n50','qn')},
        'T'  => sub { my $it = shift; $it->n('c9','mf','n48','qn')},
        'S'  => sub { my $it = shift; $it->n('c9','ff','n40','qn')},
        'S2' => sub { my $it = shift; $it->n('c9','ff','n38','qn')},
        'F'  => sub { my $it = shift; $it->n('c9','ff','n49','qn')},
        'F2' => sub { my $it = shift; $it->n('c9','ff','n47','qn')},
        'B'  => sub { my $it = shift; $it->n('c9','ff','n36','qn')},
        'Hf' => sub { my $it = shift; $it->n('c9','mf','n42','qn')},

    },
};

__END__
#
# Pretty straightforward format
#  *whateveryouwant* : name of the measure
#  instrumentname    : must be a delared sub in your code
#  '--x-x-' line     : is the 16 beats of a measure, put
#                      a 'x' if you want to make it sound.
#  PLAY(A1,A2,...)   : The playlist, will play all the pre
#                      declared measures in the given order
# (note that you have to put a colon between the
# instrument's name and the miserable excuse for a partition
#
# If you make some cool grooves send'em my way!
#
# C  : Cymbal
# H  : Hi-Hat
# Rd : Ride Cymbal
# t  : Small Tom
# T  : Medium Tom
# S  : Snare Drum
# F  : Floor Tom
# F2 : 2nd Floor Tom
# B  : Bass Drum
# Hf : Hi-Ha w/Foot
#

*R0*
S : ----x-------x---
B : x-x---x---x-----
H : x-x-x-x-x-x-x-x-

*R1*
S : ----x--x----x---
B : x-------x-x-----
H : x-x-x-x-x-x-x-x-

*R2*
S : ----x--x----xxxx
B : x---x---x---x---
H : x-xxx-x-x-x-xxx-

# from http://www.mxtabs.net/

*F1*
H : xxxx-xx-x-xx-x-x
S : ----x--x-x--x-x-
B : x-x-----x-xx----

*F1FILL*
t : --x-------------
T : -----------x----
S : --x---x----x---x
F : ------x--------x
B : x--xx--x-x--xx--

*HH1*
H : x-x-x-x-x-x-x-x-
S : ----x-------x---
B : x--x-xx--xx-----

*HH2*
H : x-x-x-x-x-x-x-x-
S : ----x-------x---
B : x--x--x--xx-----

*HH3*
H : x-x-x-x-x-x-x-x-
S : ----x-------x---
B : x-x--x-x--------

*X1*
C : x---------------
H : --x-x-x-x-x-x-x-
S : ----x--x----x---
B : x-x------xx--x-x

*X2*
C : x---------------
H : --x-x-x-x-x-x-x-
S : ----x--x-x--x---
B : xx-x--x-x--x-x-x

*X3*
C : x---------------
H : --x-x-x-x-x-x-x-
S : ----x--xx--xx--x
B : x-xx-x-x--x--x-x

*XF*
C : x-----------x---
H : --x-x---x-------
S : ----x-xx-x--x-x-
B : -x-x------x--x--

#PLAY(R0,R1,R0,R1,R2,R1,R0,R2,R1,R1,R1,R0,R2)
#PLAY(F1,F1,F1,F1FILL,F1,F1,F1,F1FILL)
#PLAY(HH3,HH1,HH2,HH1,HH2,HH1,HH1,HH2,HH3)
PLAY(X1,X2,X3,XF,X1,X2,X3,XF,X1,X2,X3)