#!/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)