#!/usr/bin/perl
use strict;

#############################################################################
##                                                                         ##
## midge - generate a midi file from text description of music             ##
##                                                                         ##
##  usage: midge [options] [infile]                                        ##
##                                                                         ##
##   see `--help' output or man page for list of options                   ##
##                                                                         ##
##  author: David Riley <dave@dmriley.demon.co.uk>                         ##
##                                                                         ##
#############################################################################
##                                                                         ##
## This program is free software; you can redistribute it and/or modify    ##
## it under the terms of the GNU General Public License as published by    ##
## the Free Software Foundation; either version 2 of the License, or       ##
## (at your option) any later version.                                     ##
##                                                                         ##
## This program is distributed in the hope that it will be useful,         ##
## but WITHOUT ANY WARRANTY; without even the implied warranty of          ##
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           ##
## GNU General Public License for more details.                            ##
##                                                                         ##
## You should have received a copy of the GNU General Public License       ##
## along with this program; if not, write to the Free Software             ##
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ##
##                                                                         ##
#############################################################################
##
## Setup global variables
##

# Version info
my $progname = "midge";
my $version = "0.2.41";
my $year = "1999-2006";
my $author = "David Riley";

# Midi codes
my $midi_header_tag = pack("CCCC", 0x4d, 0x54, 0x68, 0x64);
my $midi_track_tag = pack("CCCC", 0x4d, 0x54, 0x72, 0x6b);
my $midi_track_end = pack("CCC", 0xff, 0x2f, 0x00);
my $midi_time_sig = pack("CC", 0xff, 0x58);
my $midi_tempo = pack("CC", 0xff, 0x51);

# Program related variables
my @include_paths = qw( /usr/lib/midge /usr/share/midge
                        /usr/local/lib/midge /usr/local/share/midge
                        /opt/lib/midge /opt/share/midge );

@include_paths = grep -d $_, @include_paths;

my $sandbox;                  # sandbox for running eval code
my $seed;                     # seed for random number generator
my $unroll_loops = 0;         # whether loops should be unrolled
my $error_quote_level = 8;    # how many tokens to quote in an error message

# File related variables
my $infile;                   # input source file
my $outfile;                  # output midi file
my $source_outfile;           # source output file (if $unroll_loops is set)

# Command line option variables
my $unroll_save = 1;          # whether unrolled source should be saved to file
my $check_only = 0;           # whether midi output should not be written
my $verbose = 0;              # verbose output messages
my $debug = 0;                # debug output messages
my $quiet = 0;                # no output messages
my $unsafe = 0;               # whether to run eval code outside sandbox
my $do_reset = 1;             # whether to reset all controllers at track start

# Lookup hashes
my %patches;                  # list of patch name/number pairs
my %drums;                    # list of drum/note pairs
my %scales;                   # an array of intervals for each scale type
my $relative_majors;          # reference to hash to lookup relative majors

# Song related variables
my %header_info;              # hash of data for midi header + other meta data
my %tempo_track;              # array used to build tempo track
my @unroll;                   # which tracks need to be unrolled
my $end_of_channel;           # flag set when end of track is found
my %riffs;                    # hash of user defined riffs (note patterns)
my $strict_key = 0;           # whether sharps/flats are implied by the key
                              #  by default they must be explicitly notated
my $strict_bar = 0;           # whether bar lines must be consistent between
                              #  tracks (by default, bar lines are silently
                              #  ignored)

# Track related variables
my %pan_all;                  # hash of note => pan_value
my $last_pan = 64;            # value of last pan event
my $tempo;                    # tempo of track
my $current_track_length;     # current track length
my $current_track_type = 0;   # flag set for tempo tracks
my @current_track_bars;       # bar lines recorded in current track
my $current_channel;          # midi channel of current track
my $current_instrument;       # text name of current patch
my $unquantise;               # random offset used for each note
my $strum;                    # 0-127 strummimg speed for chords
my $bend_steps = 16;          # number of steps per quarter note
                              # for the simple bend syntax

my $repeat_start_rest;        # rest length at start of repeat block
                              #  needs to be global so all recursive
                              #  instances of get_repeat_bytes can use it

# Note related variables
my %old;                      # hash to hold old note related values;
my $transpose;                # number of semitones + or - to transpose by
my $shorten;                  # number of midi clicks to shorten notes by
                              #  used to leave space for note offsets

# Tuplet related variabbles
my @tuplets;                  # stack of tuplet values
my $tuplet = 1;               # current tuplet value
my $done_tuplet_warning = 0;  # to prevent the warning being repeated.

# Input token related variables
my @tokens;                   # array to hold the source code
my $current_token = -1;       # token number used to match with line number
my @line_refs;                # used for mapping of tokens to line numbers
my %riff_refs;                # holds the starting line number for each riff

# set initial %old values
$old{'rest_length'} = 0;      # accumulated rest length since last event
$old{'note_length'} = 0;      # length of previous note
$old{'octave'} = 0;           # octave of previous note

# Ignore SIGPIPE
$SIG{'PIPE'} = sub { 1; };

#############################################################################
##                        #                                                ##
## Run                    #                              ------------------##
##                        #                                    _='|        ##
                          #                              -----='--|----|---##
&get_options;             # parse command line args          |   _|    |   ##
&init_sandbox;            # prepare sandbox for eval     ----|--(@|---_|---##
&init_patch_list;         # set up patch list               _|       (_|   ##
&init_drum_list;          # set up drum list             --(@|-------------##
&init_scales;             # set up scale data                              ##
&get_tokens($infile);     # split input into tokens      ------------------##
                          #                                                ##
&init_rand;               # seed random generator if needed            _   ##
&pre_parse;               # check input and unroll loops if required  {:}  ##
&write_source_file        # write unrolled source file if required     H   ##
    if ($source_outfile); #                                            H   ##
                          #                                          _ H   ##
&make_midi_file;          # generate midi data and write to file    //\H/\ ##
                          #                                         \\ = / ##
##                        #                                         //f-f\ ##
## End                    #                                         \\_=_/ ##
##                        #                                                ##
#############################################################################

##########################################
##                                      ##
## @@@SECTION: Song related subroutines ##
##                                      ##
##########################################

##
## generate midi file
##

sub make_midi_file {

    my $data;        # midi data to write
    my $header_data; # header data without length
    my $header_size; # header size
    my $header;      # header including length
    my @tracks;      # data for each track
    my $channel;     # current channel
    my $counter;     # track counter
    my $i;           # loop counter
    my @bars;        # bar line positions for each track

    # make header
    if ($verbose) {
        print "making header\n";
    }

    $header_data = &make_header_content;
    $header_size = &get_data_size($header_data);
    $header = $midi_header_tag . $header_size . $header_data;

    # set initial tempo & time_sig in tempo track
    $tempo_track{'0'} = &get_tempo_bytes;
    if (defined $header_info{'time_sig'}) {
        $tempo_track{'0'} .= pack("C1", 0) . &get_time_sig_bytes;
    }

    # set key in tempo track if declared in head section
    if (defined($header_info{'key'})) {
        $tempo_track{'0'} .= pack("C1", 0)
            . &get_key_bytes($header_info{'key'});
    }
    elsif (defined($header_info{'key_strict'})) {
        $header_info{'key'} = $header_info{'key_strict'};
        $strict_key = 1;
        $tempo_track{'0'} .= pack("C1", 0)
            . &get_key_bytes($header_info{'key_strict'});
    }

    # set title in tempo track if defined
    if ($header_info{'title'}) {
        print "writing title $header_info{'title'}\n" if $debug;
        $tempo_track{'0'} .= pack("C3", 0, 0xFF, 0x03)
            . &get_data_size($header_info{'title'}, 1)
                . $header_info{'title'};
    }

    # make tracks
    if ($verbose) {
        print "making tracks\n";
    }
    &find_body;

    $counter = 0;
    while (1) {
        &find_next_channel;
        if ($current_channel == -1) {
            last;
        }
        else {
            if ($verbose) {
                my $tnum = 1 + $counter;
                print "making channel $current_channel track $tnum\n";
            }

            $end_of_channel = 0;
            $tracks[$counter] = &make_track_data;
            $bars[$counter] = [ @current_track_bars ];

            if ($current_track_type eq 'tempo') {
                @tracks = @tracks[0..$counter-1];
                $current_track_type = 0;
                next;
            }

            $counter++;
        }
    }

#    printf "DBG: got %s tracks\n", scalar @tracks;

    # check that bar lines are consistent across all tracks
    if ($strict_bar) {
        my $len = @{$bars[0]} / 2;
        
TRACK:
        for (my $i = 1; $i<=@tracks-1; $i++) {
            my $thislen = @{$bars[$i]} / 2;
            if ($thislen != $len) {

                my $msg = "track " . ($i + 1) . " has $thislen "
                          . "bar lines (track 1 has $len).\n";

                if ($header_info{bar_strict} eq 'error') {
                    die "Error: $msg";
                }
                else {
                    warn "Warning: $msg";
                }

                last;
            }
        
BAR: 
            for (my $j = 0; $j<=@{$bars[0]}-1; $j++) {
                if ($bars[$i]->[$j] ne $bars[0]->[$j]) {
                    my $k = int $j / 2;

                    my $msg = "bar line " . ($k + 1) . " in "
                              . "track " . ($i + 1) . " ($bars[$i]->[$k*2])"
                              . " is inconsistent.\n";

                    if ($header_info{bar_strict} eq 'error') {
                        die "Error: $msg";
                    }
                    else {
                        warn "Warning: $msg";
                    }

                    last TRACK;
                }
            }
        }
    }

    # add MTrk and length bytes to tracks
    for ($i=0; $i<=@tracks-1; $i++) {
        $tracks[$i] = $midi_track_tag
            . &get_data_size($tracks[$i]) . $tracks[$i];
    }

    # make tempo track
    my $tempo_track;
    my $pos = 0;

    foreach my $key (sort {$a <=> $b} keys(%tempo_track)) {
        $tempo_track .= &get_delta_time($key-$pos) . $tempo_track{$key};
        $pos = $key;
    }
    $tempo_track .= pack("C", 0) . $midi_track_end;
    $tempo_track = $midi_track_tag
        . &get_data_size($tempo_track) . $tempo_track;


    # put them together
    if ($verbose) {
        print "putting tracks together\n";
    }
    $data = $header . $tempo_track;
    foreach (@tracks) {$data .= $_;}

    # write file
    if ($check_only) {
        if (!$quiet) {
            print "input parses ok\n";
        }
    }
    else {
        if ($verbose) {
            print "opening output file $outfile\n";
        }
        open(OUTFILE, ">$outfile")
            || die "could not open $outfile for writing\n";
        binmode(OUTFILE);
        select(OUTFILE);
        print "$data";
        select(STDOUT);
        close(OUTFILE);
        print "midi output written to $outfile\n" unless $quiet;
    }
}

##
## make a track
##

sub make_track_data {
    my $data;   # data to return
    my $token;  # current token
    my $rpt;    # repeat count
    my $block;  # temp bytes for repeat

    # Reset variables
    $old{'rest_length'} = 0;
    $old{'note_length'} = 0;
    $old{'octave'} = 0;
    $old{'attack'} = 127;
    $old{'decay'} = 64;
    $tuplet = 1;
    undef %pan_all;
    $last_pan = 64;
    @current_track_bars = ();
    $current_track_length = 0;
    $shorten = 0;
    $unquantise = undef;

    # set instrument name if we have one
    if ($current_instrument) {
        $data .= pack("C3", 0, 0xff, 0x04) .
            &get_data_size($current_instrument, 1) .
                $current_instrument;
    }

    # insert a `reset all controllers' message
    $data .= pack("C4", 0, 0xaf + $current_channel, 121, 0) if $do_reset;

    # loop thru the tokens until end of channel
    while ($token = &get_next_token) {
#        print "DBG: token=$token\n";
#        print '@@@ERROR@@@' . " transpose=$transpose\n" if $transpose != 0;
        $transpose = 0; # FIXME: this must be broken!
        $data .= &get_token_bytes($token);
        last if $end_of_channel;
    }
    if ($debug) {
        print "returning track data\n";
    }

    $data .= pack("C", 0) . $midi_track_end;
    return $data;
}

##
## create the main header data
##

sub make_header_content {
    my $content; # data to return

    if ($debug) {
        print "make_header_content()\n";
    }

    &parse_header_info;
    $content = pack("CC", 0, 1); # format 1 midi file
    $content .= pack("CC", 0, $header_info{'num_tracks'});

    my $msb = int($header_info{'ticksperquarter'} / 256);
    my $lsb = int($header_info{'ticksperquarter'} % 256);

    $content .= pack("CC", $msb, $lsb);
    return $content;
}

##
## write the tokens array out to a new source file
##

sub write_source_file {
    unless ($unroll_save) {
        print 'not saving unrolled source', "\n" if $verbose;
        return;
    }

    my $line = 1;   # current line of src file
    my $col = 0;    # current column
    my $indent = 0; # current indent level
    my $i;          # loop counter
    my @tmp;        # temp array
    my $max = 60;   # max cols before a newline

    open(SRC, ">$source_outfile")
        || die "$source_outfile: $!\n";
    select(SRC);

    for ($i=0; $i<=@tokens-1; $i++) {
        if ($tokens[$i] eq '{') {
            print "{\n";
            $line_refs[$i] .= " ($line in unrolled source)";
            $line++; $col = 0;
            $indent++;
        }
        elsif ($tokens[$i] eq '}') {
            unless ($col == 0) {
                print "\n";
                $line++; $col = 0;
            }
            $indent-- unless ($indent == 0);
            if ($indent) {
                for (1..$indent) {
                    print "\t";
                    $col += 8;
                }
            }
            print "}\n";
            $line_refs[$i] .= " ($line in unrolled source)";
            $line++; $col = 0;
        }
        elsif ($tokens[$i] =~ /^@/) {
            unless ($col == 0) {
                print "\n";
                $line++; $col = 0;
            }
            if ($indent) {
                for (1..$indent) {
                    print "\t";
                    $col += 8;
                }
            }
            print "$tokens[$i] ";
            $line_refs[$i] .= " ($line in unrolled source)";
            $col += 1 + length $tokens[$i];
        }
        elsif ($tokens[$i] =~ /^\$/) {
            unless ($col == 0) {
                print "\n";
                $line++; $col = 0;
            }
            if ($indent) {
                for (1..$indent) {
                    print "\t";
                    $col += 8;
                }
            }
            print "$tokens[$i] ";
            $line_refs[$i] .= " ($line in unrolled source)";
            $i++;
            if ($tokens[$i] =~ /^\"/) {
                my ($j, $tmp);
                for ($j=$i; $j<=@tokens-1; $j++) {
                    if ($tokens[$j] =~ /\"$/) {
                        $tmp .= $tokens[$j];
                        $line_refs[$j] .= " ($line in unrolled source)";
                        $i = $j;
                        last;
                    }
                    else {
                        $tmp .= "$tokens[$j] ";
                        $line_refs[$j] .= " ($line in unrolled source)";
                    }
                }
                print "$tmp\n";
            }
            else {
                print "$tokens[$i]\n";
                $line_refs[$i] .= " ($line in unrolled source)";
            }
            $line++; $col = 0;
        }
        elsif ($tokens[$i] =~ /^\%/) {
            unless ($col == 0) {
                print "\n";
                $line++; $col = 0;
            }
            if ($indent) {
                for (1..$indent) {
                    print "\t";
                    $col += 8;
                }
            }
            print "$tokens[$i] ";
            $line_refs[$i] .= " ($line in unrolled source)";
            $col += 1 + length $tokens[$i];
        }
        elsif ($tokens[$i] eq '(') {
            unless ($col == 0) {
                print "\n";
                $line++; $col = 0;
            }
            if ($indent) {
                for (1..$indent) {
                    print "\t";
                    $col += 8;
                }
            }
            print "$tokens[$i] ";
            $line_refs[$i] .= " ($line in unrolled source)";
        }
        elsif ($tokens[$i] eq ')') {
            print ")\n";
            $line_refs[$i] .= " ($line in unrolled source)";
            $line++; $col = 0;
        }
        else {
            if ($col > $max) {
                print "\n";
                $line++; $col = 0;
            }
            if (($col == 0) && ($indent)) {
                for (1..$indent) {
                    print "\t";
                    $col += 8;
                }
            }
            print "$tokens[$i] ";
            $line_refs[$i] .= " ($line in unrolled source)";
            $col += 1 + length $tokens[$i];
        }
    }
    select(STDOUT);
    close(SRC);
    print "unrolled source written to $source_outfile\n" unless $quiet;
}       

###########################################
##                                       ##
## @@@SECTION: Track related subroutines ##
##                                       ##
###########################################

##
## save a riff as a string of tokens
## used by the %define keyword
##

sub define_riff {
    my $riff_name;   # name of riff to define
    my @tokens;      # array to hold tokens
    my $token;       # current token
    my $bracket = 0; # counts level of brackets


    $riff_name = &get_next_token
        || die "$line_refs[$current_token]: "
            . "missing riff name after \%define\n";

    $riff_refs{$riff_name} = $line_refs[$current_token];

    foreach (keys(%riffs)) {
        if ($_ eq $riff_name) {
            die "$line_refs[$current_token]: "
                . "duplicate riff name: $_\n";
        }
    }

    if ($verbose) {
        print "defining riff \`$riff_name'\n";
    }

    (&get_next_token eq '{')
        || die "$line_refs[$current_token]: "
            . "after \%define: expected '{' ; found $_\n";

    while (defined ($token = &get_next_token)) {
        if ($token eq '{') {
            @tokens = (@tokens, $token);
            $bracket++;
        }
        elsif ($token eq '}') {
            if ($bracket == 0) {
                last;
            }
            else {
                @tokens = (@tokens, $token);
                $bracket--;
            }
        }
        elsif ($token eq '%choose') {
            die "$line_refs[$current_token]: "
                . "cannot use \%choose within a define\n";
        }
        else {
            @tokens = (@tokens, $token);
        }
    }
    if ($debug) {
        print "define_riff() \@tokens = @tokens\n";
    }
    $riffs{$riff_name} = join(" ", @tokens);
}

##
## add the tokens for a predefined riff to the
## front of the tokens array
##

sub prepend_riff_tokens {
    my $name = shift;      # name of %defined riff
    my $transpose = shift; # number of semitones to transpose riff
    my @riff;              # temp array to store riff
    my $note;              # note name
    my $num;               # note number
    my $riff_name;         # name of nested riff
    my $riff_trans;        # transpose value of nested riff
    my $i;                 # loop counter

    if ($debug) {
        print "prepend_riff_tokens(): looking for $name\n";
    }

    if ($debug) {
        print "prepend_riff_tokens(): ";
        print " riff=$riffs{$name} \$transpose=$transpose\n";
    }

    die "$line_refs[$current_token]: riff `$name' has not been defined\n"
        unless defined $riffs{$name};

    @riff = split(/\s+/, $riffs{$name});

    # Fix the line_refs
    my @tmp_refs = @line_refs[0..$current_token];
    map $_ = $riff_refs{$name}, @tmp_refs[@tmp_refs..@tmp_refs + @riff - 1];
    push @tmp_refs, @line_refs[$current_token+1..@line_refs - 1];
    @line_refs = @tmp_refs;

    # transpose riff
    if (!($transpose == 0)) {
        for ($i=0; $i<=@riff - 1; $i++) {
            $note = $riff[$i];

            # transpose note
            if ($note =~ /^[-+]?(\/.+\/)?[a-g]([-+=])?([0-9])?$/) {
                $num = $transpose + &note_to_int($note);
                $_ = $note;
                $note = &int_to_note($num);
                s/([-+]?\/.+\/)?[a-g]([-+=])?([0-9])?/$1$note/;
                $riff[$i] = $_;
            }

            # add to transpose value of nested riff
            if ($note =~ /^(~[^\/]+)(\/(-)?([0-9]+)\/)?/) {
                $riff_name = $1;
                $riff_trans = $4;
                if ($3) {$riff_trans = 0 - $4;}
                if (!$2) {$riff_trans = 0;}
                $riff_trans += $transpose;
                if ($riff_trans == 0) {
                    $riff[$i] = $riff_name;
                }
                elsif ($riff_trans > 0) {
                    $riff[$i] = $riff_name . '/' . $riff_trans . '/';
                }
                else {
                    $riff_trans = 0 - $riff_trans;
                    $riff[$i] = $riff_name . '/-' . $riff_trans . '/';
                }
            }
        }
    }

    @tokens = (@riff, @tokens);
}

##
## parse a %pan_all block
##
sub parse_pan_all {
    my $value;
    my $flag = 0;

    $_ = &get_next_token;
    unless ($_ eq '{') {
        die "$line_refs[$current_token]: expected `{' found $_\n";
    }
    while (my $token = &get_next_token) {

        if ($token eq '}') {
            print 'PAN_ALL: got end of block\n' if $debug;
            $flag = 1;
            last;
        }

        if ($token eq '*') {$token = 'any';}

        $value = &get_next_token;
        unless (defined($value)) {
            die "$line_refs[$current_token]:"
                . " bad pan value $value after \%pan_all\n";
        }
        $pan_all{$token} = $value;
    }
    unless ($flag) {
        die "$line_refs[$current_token]:"
            . " unexpected eof looking for \`}' in pan_all block\n";
    }
}


##
## return bytes from a token
## ie could be note, rest, repeat, defined riff etc
##

sub get_token_bytes {
    my $token = shift; # token to process
    my $data;          # data to return
    my $chord;         # holds note tokens (space separated) for a chord
    my $num = 1;       # temp numerator of note length
    my $value;         # temp var for reading values
    my $transpose;     # used if we find a predefined riff

    undef $data;

    if ($debug) {
        print "get_token_bytes($token)\n";
    }

    if ($token eq '}') {
        if ($verbose) {
            print "got end of channel\n";
        }
        $end_of_channel = 1;
    }
    # set tempo
    elsif ($token eq '$tempo') {
        $token = &get_next_token
            || die "$line_refs[$current_token]: missing tempo after \$tempo\n";

        my $dtime = $current_track_length + $old{'rest_length'};

        $tempo_track{$dtime} .= pack("C*", 0)
            if (defined $tempo_track{$dtime});

        $tempo_track{$dtime} .= &get_tempo_bytes($token);
    }
    # set time signature
    elsif ($token eq '$time_sig') {
        $token = &get_next_token
            || die "$line_refs[$current_token]:"
                . " missing value after \$time_sig\n";

        my $dtime = $current_track_length + $old{'rest_length'};

        if (defined $tempo_track{$dtime}) {
            $tempo_track{$dtime} .= pack("C*", 0);
        }

        $tempo_track{$dtime} .= &get_time_sig_bytes($token);
    }
    # set key
    elsif ($token eq '$key') {
        $token = &get_next_token
            || die "$line_refs[$current_token]: missing key after \$key\n";

        my $dtime = $current_track_length + $old{'rest_length'};

        $tempo_track{$dtime} .= pack("C*", 0)
            if (defined $tempo_track{$dtime});

        $tempo_track{$dtime} .= &get_key_bytes($token);
    }
    # set default length
    elsif ($token eq '$length') {

        $token = &get_next_token;
        if ($token =~ /(([0-9]+):)?([0-9]+)/) {
            if ($2) {
                $num = $2;
            }
            $old{'note_length'} = (
                  4 * $num * $header_info{'ticksperquarter'}) / $3;
        }
        else {
            die "$line_refs[$current_token]: "
                . "bad length value `$token'\n";
        }
    }
    # shorten value (to leave space for note offsets)
    elsif ($token eq '$shorten') {
        $token = &get_next_token;
        if ($token =~ /^(\d+)$/) {
            $shorten = $1;
        }
        else {
            die "$line_refs[$current_token]: bad shorten value `$1'\n";
        }
    }   
    # unquantise value (to offset each note randomly)
    elsif ($token eq '$unquantise') {
        $token = &get_next_token;
        if ($token =~ /^[-+]?(\d+)\%?$/) {
            if ($1 == 0) {
                undef $unquantise;
                print "unquantise set to 0\n" if $debug;
            }
            else {
                $unquantise = $token;
                print "unquantise set to $token\n" if $debug;
            }
        }
        else {
            die "$line_refs[$current_token]: bad unquantise value `$1'\n";
        }
    }   
    # strum value (speed of strumming for chords 0-127)
    elsif ($token eq '$strum') {
        $token = &get_next_token;
        if ($token =~ /^(\d+)$/) {
            $strum = $1;
        }
        else {
            die "$line_refs[$current_token]: bad strum value `$1'\n";
        }
        if (($strum < 0) or ($strum > 127)) {
            die "$line_refs[$current_token]: bad strum value `$strum'\n";
        }
    }
    # set patch (and bank) Format: [[bank_lsb,]bank_msb,]patch
    elsif ($token eq '$patch') { # FIXME: this needs a separate subroutine
        my ($bank_msb, $bank_lsb);
        my $patch = &get_next_token
            || die "$line_refs[$current_token]:"
                . " missing number after \$patch\n";

        # check for bank number
        if ($patch =~ /^(((\d+),)?(\d+),)?(\S+)$/) {
            # lsb=3, msb=4, patch=5
            if (defined $1) { # bank included
                if (defined $2) { # bank_lsb included
                    $bank_lsb = $3;

                    if (($bank_lsb < 1) || ($bank_lsb > 128)) {
                        die "$line_refs[$current_token]: "
                            . "bad bank LSB: $bank_lsb\n";
                    }

                    $bank_lsb--;
                }

                $bank_msb = $4;

                if (($bank_msb < 1) || ($bank_msb > 128)) {
                    die "$line_refs[$current_token]: "
                        . "bad bank MSB: $bank_msb\n";
                }

                $bank_msb--;
            }

            $patch = $5;
        }
        if (!($patch =~ /^\d+$/)) {
            # patch specified by name
            if ($debug) {
                print "got patch name $patch\n";
            }
            $patch = $patches{$patch};
        }
        if (($patch < 1) || ($patch > 128)) {
            die "$line_refs[$current_token]: bad patch: $patch\n";
        }

        $patch--;

        if ($debug) {
            print "setting \$patch to "
                . "[bank_LSB=$bank_lsb ; bank_MSB=$bank_msb] patch=$patch\n";
        }

        if (defined $bank_msb) {
            $data .= &get_delta_time($old{'rest_length'});
            $data .= pack("C*", 0xb0 | ($current_channel - 1), 0, $bank_msb);
            
            if (defined $bank_lsb) {
                $data .= &get_delta_time(0);
                $data .= pack("C*", 0xb0 | ($current_channel - 1),
                              32, $bank_lsb);
            }

            $data .= &get_delta_time(0);
        }
        else {
            $data .= &get_delta_time($old{'rest_length'});
        }

        $data .= pack("CC", 0xbf + $current_channel, $patch);
        $current_track_length += $old{'rest_length'};
        $old{'rest_length'} = 0;
    }
    # bank only. Format [lsb,]msb
    elsif ($token eq '$bank') {
        my ($bank_msb, $bank_lsb);
        my $bank = &get_next_token || die "$line_refs[$current_token]:"
            . " missing bank number after \$bank\n";

        if ($bank =~ /^((\d+),)?(\d+)$/) {
            if (defined $1) {
                $bank_lsb = $2;

                if (($bank_lsb < 1) or ($bank_lsb > 128)) {
                    die "$line_refs[$current_token]:"
                        . " bad bank LSB value `$bank_msb'\n";
                }

                $bank_lsb--;
            }

            $bank_msb = $3;

            if (($bank_msb < 1) or ($bank_msb > 128)) {
                die "$line_refs[$current_token]:"
                    . " bad bank MSB value `$bank_msb'\n";
            }

            $bank_msb--;
        }
        else {
            die "line_refs[$current_token]: "
                . "Error in bank format `$bank': expected [LSB,]MSB\n";
        }

        if ($debug) {
            print "setting bank to LSB=$bank_lsb ; MSB=$bank_msb\n";
        }
        
        $data .= &get_delta_time($old{'rest_length'});
        $data .= pack("C*", 0xb0 | ($current_channel - 1), 0, $bank_msb);
        if (defined $bank_lsb) {
            $data .= pack("C*", 0, 0xb0 | ($current_channel - 1),
                          32, $bank_lsb);
        }
        $current_track_length += $old{'rest_length'};
        $old{'rest_length'} = 0;
    }
    # set default octave
    elsif ($token eq '$octave') {
        $old{'octave'} = &get_next_token;
        if (!(($old{'octave'} >= 0) && ($old{'octave'} <= 10))) {
            die "$line_refs[$current_token]: bad octave `$old{'octave'}'\n";
        }
    }
    # volume
    elsif ($token eq '$volume') {
        $value = &get_next_token
            || die "$line_refs[$current_token]:"
                . " missing volume value after \$volume\n";
        $value = &get_range_value($value);
        if (!(($value >= 0) && ($value <= 127))) {
            die "$line_refs[$current_token]: bad volume `$value'\n";
        }
        if ($debug) {
            print "setting volume to $value\n";
        }
        $data .= &get_delta_time($old{'rest_length'});
        $data .= pack("C*", 0xb0 | ($current_channel - 1), 7, $value);
        $current_track_length += $old{'rest_length'};
        $old{'rest_length'} = 0;
    }
    # note on velocity
    elsif ($token eq '$attack') {
        $value = &get_next_token;
        $value = &get_range_value($value);
        if (!(($value >= 0) && ($value <= 127))) {
            die "$line_refs[$current_token]: bad attack value `$value'\n";
        }
        if ($debug) {
            print "setting attack to $value\n";
        }
        $old{'attack'} = $value;
    }
    # note off velocity
    elsif ($token eq '$decay') {
        $value = &get_next_token;
        $value = &get_range_value($value);
        if (!(($value >= 0) && ($value <= 127))) {
            die "$line_refs[$current_token]: bad decay value `$value'\n";
        }
        if ($debug) {
            print "setting decay to $value\n";
        }
        $old{'decay'} = $value;
    }
    # chorus
    elsif ($token eq '$chorus') {
        $value = &get_next_token;
        $value = &get_range_value($value);
        if (!(($value >= 0) && ($value <= 127))) {
            die "$line_refs[$current_token]: bad chorus value `$value'\n";
        }
        if ($debug) {
            print "setting chorus to $value\n";
        }
        $data .= &get_delta_time($old{'rest_length'});
        $data .= pack("C*", 0xb0 + $current_channel - 1, 93, $value);
        $current_track_length += $old{'rest_length'};
        $old{'rest_length'} = 0;
    }
    # reverb
    elsif ($token eq '$reverb') {
        $value = &get_next_token;
        $value = &get_range_value($value);
        if (!(($value >= 0) && ($value <= 127))) {
            die "$line_refs[$current_token]: bad reverb value `$value'\n";
        }
        if ($debug) {
            print "setting reverb to $value\n";
        }
        $data .= &get_delta_time($old{'rest_length'});
        $data .= pack("C*", 0xb0 + $current_channel - 1, 91, $value);
        $current_track_length += $old{'rest_length'};
        $old{'rest_length'} = 0;
    }
    # chord
    elsif ($token eq '(') {
        if ($debug) {
            print "g_t_b(): found chord\n";
        }
        while ($token = &get_next_token) {
            if ($token eq ')') {
                print "found end of chord\n" if $debug;
                last;
            }
            else {
                print "CHORD: $token\n" if $debug;
                $chord .= "$token ";
            }
        }
        if ($debug) {
            print "g_t_b(): chord=$chord\n";
        }
        $data .= &get_chord_bytes($chord);
    }
    # tuplet
    elsif ($token eq '%tuplet') {
        $data .= &get_tuplet_bytes;
    }
    # pitch bend
    elsif ($token eq '%bend') {
        $data .= &get_bend_bytes;
    }
    # simple pitch wheel event
    elsif ($token eq '$pitch') {
        $data .= &get_pitch_bytes;
    }
    # pitch bend range
    elsif ($token eq '$bend_range') {
        $data .= &get_bend_range_bytes(&get_next_token);
    }
    # predefined riff transposed
    elsif ($token =~ /~(\S+)\/(-)?([0-9]+)\//) {
        if ($debug) {
            print "get_token_bytes($token)\n";
        }
        if ($2) {
            $transpose = 0 - $3;
        }
        else {
            $transpose = $3;
        }
        &prepend_riff_tokens($1, $transpose);
    }
    # predefined riff
    elsif ($token =~ /^~(\S+)/) {
        if ($debug) {
            print "get_token_bytes($token)\n";
        }
        &prepend_riff_tokens($1, 0);
    }
    # repeat block
    elsif ($token eq '%repeat') {
        $data .= &get_repeat_bytes;
    }
    # Marker
    elsif ($token eq '$marker') {
        my $dtime = $current_track_length + $old{'rest_length'};

        $tempo_track{$dtime} .= pack("C*", 0)
            if (defined $tempo_track{$dtime});

        $tempo_track{$dtime} .= &get_marker_bytes;
    }
    # Text event
    elsif ($token eq '$text') {
        $data .= &get_text_bytes;
    }
    # pan
    elsif ($token eq '$pan') {
        my $value = &get_next_token;
        $data .= &get_pan_bytes($value, 1);
    }
    # pan_all
    elsif ($token eq '%pan_all') {
        &parse_pan_all;
    }
    # controller event
    elsif ($token eq '$ctrl') {
        $data .= &get_ctrl_bytes;
    }
    # verbatim
    elsif ($token eq '%verbatim' or $token eq '%bytes') {
        $data .= &get_verbatim_bytes;
    }
    # rpn
    elsif ($token eq '$rpn') {
        $data .= &get_rpn_bytes;
    }
    # nrpn
    elsif ($token eq '$nrpn') {
        $data .= &get_nrpn_bytes;
    }
    # print
    elsif ($token eq '$print') {
        my $msg = &get_quoted_string;
        print "$msg\n";
    }
    # track type (used by midi2mg)
    elsif ($token eq '$track_type') {
        $current_track_type = &get_next_token;
    }
    # bar line
    elsif ($token =~ /^\|_?\d*$/) {
    my $dtime = $current_track_length + $old{'rest_length'};
    push @current_track_bars, ( $token, $dtime );
        if ($debug) {
            print "bar line: $token at $dtime\n";
        }
    }
    # note or rest
    else {
        # pan if note has a pan_all value
        my $tmp = $token;
        my $return_pan = 0;
        $tmp =~ s/^[-+]?.*\///;
        if (defined($pan_all{$tmp})) {
            $data .= &get_pan_bytes($pan_all{$tmp});
            $return_pan = 1;
        }
        elsif (defined($pan_all{'any'})) {
            $data .= &get_pan_bytes($pan_all{'any'});
            $return_pan = 1;
        }

        $data .= &get_note_bytes($token, 0);

        if ($return_pan) {$data .= &get_pan_bytes($last_pan);}
    }
    return $data;
}

##
## return a reference to an array of notes, given a scale type,
##  root note and number of octaves
##

sub get_scale {
    my ($type, $root, $range, $opts) = @_;

    die "$type: unknown scale\n" unless defined $scales{$type};
    die "$root: bad root note\n" unless $root =~ /^[a-g][-+]?\d+$/;

    $range = 1 unless ($range > 1);
    $root = $opts . $root if defined $opts;
    my @scale = ($root);

    my $note_num = &note_to_int($root);
    my $count = 0;

    if ($debug) {
        print "get_scale() starting loop for $type, $root, $range:\n";
    }

    {
        foreach (@{$scales{$type}}) {
            $count += $_;
            $note_num += $_;
            my $note = &int_to_note($note_num);
            $note = $opts . $note if defined $opts;
            push(@scale, $note);
            last if $count >= 12 * $range;
        }
        redo unless $count >= 12 * $range;
    }
    return \@scale;
}

##
## return a string of bytes representing a note
##

sub get_note_bytes {
    my $token = shift; # input token representing note
    my $flag = shift;  # 0=normal
                       # other values used for chords
                       # 11=note on only
                       # 12=note on with specified dtime
                       # 21=note off
                       # 22=note off with specified dtime
    my $delta = shift; # for use with 12 and 22 above

    $delta = 0 unless $delta > 0;

    my $meta;             # meta info for note
    my $note;             # note value
    my $length;           # length of note
    my $real_length;      # set if above is changed by tuplet
    my $repeat = 1;       # number of times to play the note
    my $name;             # note name
    my $sharp;            # sharp or flat
    my $octave;           # octave note is in
    my $attack;           # note on velocity
    my $decay;            # note off velocity
    my $data;             # data bytes to return
    my $rest;             # flag set if note is a rest
    my $i;                # loop counter
    my $value;            # temp value
    my $offset = 0;       # note offset in midi clicks
    my $onoff = 0;        # flag for note on/off only events
    my $is_drum_name = 0; # Whether the note is specified as a drum name.

    if ($debug) {
        print "g_n_b(): getting note bytes for $token ; \$flag=$flag\n";
    }

    # note on/off only flag
    if ($token =~ /^([-+])(\S+)/) {
        if ($1 eq '+') {$onoff = 1;}
        else {$onoff = -1}
        $token = $2;
    }

    # deal with meta info
    if ($token =~ /^\/(\S+)\//) {
        $meta = $1;

        # Sanity check
        if ($meta !~ /^(([adr]|[zZ][-+]?)\d+|l(\d+:)?\d+)+$/) {
            die "$line_refs[$current_token]: error in note options `$meta'\n";
        }

        # repeat
        if ($meta =~ /r(\d*)/ and not $onoff) {
            $repeat = $1;
            print "note repeat = $repeat\n" if $debug;
        }
        # length specified
        if ($meta =~ /l((\d+(\.\d+)?):)?(\d+)/ and not $onoff) {
            my $num = 1;
            if (defined $2) {
                $num = $2;
            }
            $real_length = ($header_info{'ticksperquarter'} * 4 * $num) / $4;
        }
        # inherit old length
        else {
            $real_length = $old{'note_length'};
        }

        if ($tuplet != 1) {
            $length = $real_length / $tuplet;
            if (not $done_tuplet_warning and $length != int $length) {
                $done_tuplet_warning = 1;
                warn <<EOF;

Warning: lost some midi clicks due to tuplet.
your \$resolution value should be a multiple of each tuplet factor.

EOF
            }
        }
        else {
            $length = $real_length;
        }

        if ($debug) {
            print "length of note = $length ($real_length)\n";
        }

        # attack
        if ($meta =~ /a([0-9]+)/) {
            $attack = $1;
            print "note attack = $attack\n" if $debug;
        }
        # decay
        if ($meta =~ /d([0-9]+)/) {
            $decay = $1;
            print "note decay = $decay\n" if $debug;
        }
        # offset
        if ((defined $unquantise) and ($meta !~ /z/i)) {
            $meta =~ s/^/Z$unquantise/;
            print "note opts changed to $meta by unquantise\n" if $debug;
        }
        if ($meta =~ /(z)([-+])?(\d+)(\%)?/i) {
            my $type = $1;
            my $sign = $2;
            my $value = $3;
            my $unit = $4;

            # convert % values to midi clicks
            if ($unit eq '%') {
                $value = int(($length * $value) / 100);
            }

            # pick a value if using random type (Z)
            if ($type eq 'Z') {
                if (!(defined $sign)) {
                    $offset = int(rand(2 * $value) - $value);
                }
                elsif ($sign eq '+') {
                    $offset = int(rand($value));
                }
                else {
                    $offset = 0 - int(rand($value));
                }
            }
            else {
                if ((defined $sign) && ($sign eq '-')) {
                    $offset = 0 - $value;
                }
                else {
                    $offset = $value;
                }
            }
            if ($debug) {
                print "OFFSET: using $offset for $token\n";
            }
        }
    }
    elsif ($token =~ /(\S)?\//) {
        my $slash = (defined $1)? 'leading' : 'trailing';
        die "$line_refs[$current_token]: note options missing $slash slash\n";
    }

    # if there were no note options...
    if (!(defined $length)) {
        $real_length = $old{'note_length'};

        if ($tuplet != 1) {
            $length = $real_length / $tuplet;
            if (not $done_tuplet_warning and $length != int $length) {
                $done_tuplet_warning = 1;
                warn <<EOF;

Warning: lost some midi clicks due to tuplet.
your \$resolution value should be a multiple of each tuplet factor.

EOF
            }
        }
        else {
            $length = $real_length;
        }

        if ($debug) {
            print "length of note = $length ($real_length)\n";
        }
    }
    if (!$attack) {
        $attack = $old{'attack'};
    }
    if (!$decay) {
        $decay = $old{'decay'};
    }
    $token =~ s/.*\///;

    # find note pitch
    if (!($token =~ /^([a-gr])([-+=])?([0-9])?$/)) {

        # bad note? check if we have a drum name
        print "checking for drum name \`$token'\n" if $debug;
        if (defined($drums{$token})) {
            $token = $drums{$token};
            $is_drum_name = 2;
        }
        else {
            die "$line_refs[$current_token]:"
                . " bad note or drum name: $token\n";
        }
        print "found drum note: $token\n" if $debug;
    }

    if ($token =~ /^([a-gr])([-+=])?([0-9])?$/) {
        $name = $1;
        $sharp = $2;
        $octave = $3;
    }
    else {
        die "$line_refs[$current_token]: bad note token $token\n";
    }
    if ($debug) {
        print "name = $name ; sharp = $sharp ; octave = $octave\n";
    }

    # rest
    if ($name eq 'r') {
        $old{'rest_length'} += $length;
        $old{'note_length'} = $real_length;
        $rest = 1;
        if ($debug) {
            print "g_n_b() old_rest_length changed to $length by rest\n";
        }
    }
    # note
    else {
        $length -= $shorten;

        if (!$octave) {
            $octave = $old{'octave'};
        }

        $note = &note_to_int("$name$sharp$octave", $is_drum_name);
        $note += $transpose;

        # convert note data to bytes (first note)
        printf("rest carried over = %d\n", $old{'rest_length'}) if $debug;

        if ($onoff == 1) { # note on, inherited rest length
            $data = &get_delta_time($old{'rest_length'});
            $data .= pack("CCC", $current_channel + 0x8f, $note, $attack);
            $current_track_length += $old{'rest_length'};
        }
        elsif ($onoff == -1) { # note off, inherited rest length
            $data = &get_delta_time($old{'rest_length'});
            $data .= pack("CCC", $current_channel + 0x7f, $note, $decay);
            $current_track_length += $old{'rest_length'};
        }
        elsif (($flag == 0) || ($flag == 11)) { # note on

            if (($old{'rest_length'} + $offset) < 0) {
                my $bad = $offset;
                $offset = 0 - $old{'rest_length'};
                warn "$line_refs[$current_token]:"
                    . " cannot use offset $bad; using $offset\n";
            }
            if ($offset > $length) {
                die "$line_refs[$current_token]:"
                    . "offset $offset is greater than note length\n";
            }

            $old{'rest_length'} += $offset;
            $length -= $offset;

            $data = &get_delta_time($old{'rest_length'});
            $data .= pack("CCC", $current_channel + 0x8f, $note, $attack);
            $current_track_length += $old{'rest_length'};
        }
        elsif ($flag == 12) { # note on specified dtime
            $data = &get_delta_time($delta);
            $data .= pack("CCC", $current_channel + 0x8f, $note, $attack);
        }
        if (($flag == 0 and not $onoff) || ($flag == 21)) { # note off
            $data .= &get_delta_time($length);
            $data .= pack("CCC", $current_channel + 0x7f, $note, $decay);
            $current_track_length += $length;
        }
        elsif ($flag == 22) { # note off specified dtime
            $data .= &get_delta_time($delta);
            $data .= pack("CCC", $current_channel + 0x7f, $note, $decay);
            $current_track_length += $delta;
        }

        # save values in %old
        $old{'note_length'} = $real_length;
        $old{'note_pitch'} = $note;
        $old{'rest_length'} = 0 + $shorten;
        $old{'octave'} = $octave;
        $old{'attack'} = $attack;
        $old{'decay'} = $decay;
    }

    # add repeat notes if needed
    if ($repeat > 1) {
        for (2..$repeat) {
            if ($rest) {
                $old{'rest_length'} += $length;
            }
            else {
                $data .= &get_delta_time($old{'rest_length'} + $offset);
                $data .= pack("CCC", $current_channel + 0x8f, $note, $attack);
                $data .= &get_delta_time($length);
                $data .= pack("CCC", $current_channel + 0x7f, $note, $decay);
                $current_track_length += $length;
            }
        }
    }

    print "leaving get_note_bytes()\n" if $debug;

    return $data;
}

##
## return a string of bytes from a repeat block
## recursing if neccesary
##

sub get_repeat_bytes {
    my $parent_got_start = shift;         # ref to parent's got_start flag

    my $parent_start_rest = $repeat_start_rest; # copy of s_r to pass back

    # $repeat_start_rest (global) stores any leading rests in the block.

    my $start_rest = 0; # how long to rest at start of repeat

    my $first_dtime;        # start dtime first time thru the block
    my $rpt_dtime;          # start dtime when repeating the block
    my $got_start = 0;      # flag set when leading rests are complete
    my $end_rest = 0;       # stores any trailing rests in the block
    my $rpt_count;          # number of times to repeat
    my $token;              # holds current token
    my $block;              # the block of bytes to repeat
    my $data;               # data to return
    my $rest;               # holds length of current rest
    my @tmp;                # temp variable used stripping first dtime
    my $tmp;                # temp var to hold block while stripping dtime
    my $dtime_stripped = 0; # flag
    my $num;                # numerator of length value

    $rpt_count = &get_next_token
        || die "$line_refs[$current_token]: "
            . "missing repeat count after \%repeat\n";
    if ($rpt_count < 1) {
        die "$line_refs[$current_token]: "
            . "bad repeat count: $rpt_count\n";
    }
    (&get_next_token eq '{')
        || die "$line_refs[$current_token]: "
            . "after \`\%repeat', expected {, found $_\n";
    
    # loop thru the block of tokens
    my $i = 0; # loop counter
    while (1) {
        $token = &get_next_token;

        # break out at end of block
        if ($token eq '}') {
            print "RPT: end of block\n" if $debug;
            last;
        }

        # recurse if a nested block is found
        if ($token eq '%repeat') {
            my $old_got_start = $got_start;
            print "RPT: recursing\n" if $debug;

            if (!$got_start) {
                $repeat_start_rest = $start_rest;
            }

            $block .= &get_repeat_bytes(\$got_start);

            $end_rest = $old{'rest_length'};
            $start_rest = $repeat_start_rest unless $old_got_start;

            if (($got_start) and (!$old_got_start)) {
                if (defined $parent_got_start) {
                    unless ($$parent_got_start) {
                        $parent_start_rest += $start_rest;
                        $$parent_got_start = 1;
                    }
                }
            }

            next;
        }
        # else add normal token to the block
        else {
            $block .= &get_token_bytes($token);
        }

        # add up the leading/trailing rests
        if ($token =~ /^(\/(l(([0-9]+):)?([0-9]+))?(r([0-9]+))?\/)?r$/) {
            if ($2) {
                if ($4) {$num = $4;}
                else {$num = 1;}
                $rest = ($header_info{'ticksperquarter'} * 4 * $num) / $5;
                print "num=$num den=$5\n" if $debug;
                print "RPT: got_start=$got_start\n" if $debug;
            }
            else {
                $rest = $old{'note_length'};
            }
            if ($7) {
                $rest *= $7;
                print "RPT: rest *= $7\n" if $debug;
            }

            # add rest length to start_rest
            if (!$got_start) {
                $start_rest += $rest;
                print "RPT: start_rest+=$rest [$token]\n" if $debug;
            }

            # add rest length to end_rest
            print "RPT: END+=$rest\n" if ($debug);
            $end_rest += $rest;
        }
        # chord
        elsif ($token eq '(') {
            if (!$got_start) {
                if (defined $parent_got_start) {
                    unless ($$parent_got_start) {
                        $parent_start_rest += $start_rest;
                        $$parent_got_start = 1;
                    }
                }
                $got_start = 1;
            }
            $end_rest = 0;
            print "RPT: end_rest=0 [$token]\n" if $debug;
        }
        # predefined riff or tempo track event
        elsif ($token =~ /^(~\S+|\$(tempo|time_sig|key|marker))/) {
            # do nothing
        }
        # else it's a note (or pan/chorus etc)
        # so reset the end_rest counter and set start flag
        else {
            if (!$got_start) {
                if (defined $parent_got_start) {
                    unless ($$parent_got_start) {
                        $parent_start_rest += $start_rest;
                        $$parent_got_start = 1;
                    }
                }
                $got_start = 1;
            }
            $end_rest = 0;
            print "RPT: end_rest=0 [$token]\n" if $debug;
        }
    }

    # add the block with original dtime to $data
    $data = $block;

    # set the repeat dtime
    if ($debug) {
        print "RPT: start_rest=$start_rest end_rest=$end_rest\n";
    }

    if ($block) {
        $rpt_dtime = &get_delta_time($start_rest + $end_rest);
    
        # remove the first dtime from the block
        @tmp = split(//, $block);
        for ($i=0; $i<=@tmp-1; $i++) {
            if ($dtime_stripped) {
                $tmp .= $tmp[$i];
            }
            elsif ((unpack("C", $tmp[$i])) < 0x80) {
                printf ("RPT: stripped %d bytes of dtime\n", $i+1) if $debug;
                $dtime_stripped = 1;
            }
        }
        print "RPT: replacing stripped dtime with $rpt_dtime\n" if $debug;
        $block = $rpt_dtime . $tmp;

        # add the ammended block the required number of times
        for (2..$rpt_count) {$data .= $block;}
        $old{'rest_length'} = $end_rest;
    }
    else {
        if ($start_rest != $end_rest) {
            warn "RPT: start_rest != end_rest in empty block\n";
        }
        $old{'rest_length'} += ($rpt_count - 1) * $start_rest;
    }

    # set the repeat_start_rest back to parent's value if needed
    if (defined $parent_got_start) {
        if ($$parent_got_start) {
            if ($debug) {
                print "RPT: returning original parent start rest"
                    . " $parent_start_rest\n";
            }
            $repeat_start_rest = $parent_start_rest;
        }
        else {
            $repeat_start_rest = $parent_start_rest;
            if ($block) {
                $repeat_start_rest += $end_rest;
            }
            else {
                $repeat_start_rest += $rpt_count * $start_rest;
            }
            if ($debug) {
                print "RPT: returning ammended start rest"
                    . " $repeat_start_rest to parent\n";
            }
        }
    }
    else {
        $repeat_start_rest = 0;
    }
    
    return $data;
}


##
## return a string of bytes representing a note with pitch bends
##

sub get_bend_bytes {
    my $values;                # value of pitch bend
    my $dtime;                 # dtime of pitch bend
    my $note;                  # start note
    my $token;                 # to store current token
    my $data;                  # data to return
    my $i;                     # loop counter
    my $num;                   # numerator of length values
    my ($current, $min, $max); # current, min and max values of bend
    my $lsb;                   # least significant byte of bend amount
    my $pre_bend;              # amount to pre bend if bending downwards
    my $bend_unit = 127;       # scale factor for bend value <=> semitone
    my $transpose;             # amount to transpose to cancel out pre_bend
    
    $token = &get_next_token;
    if ($token =~ /^[a-g]([-+=])?([0-9])?$/) {
        $note = $token;
    }
    else {
        die "$line_refs[$current_token]: unknown note $token\n";
    }

    # note on
    $data .= &get_note_bytes($note, 11);

    (&get_next_token eq '{') ||
        die "$line_refs[$current_token]: expected \`{' ; found $_\n";

    $i = 0;
    $current = 64;
    while ($token = &get_next_token) {
        if ($token eq '}') {
            last;
        }
        elsif ($token =~ /^(([0-9]+):)?([0-9]+)(\+|-)([0-9]+)$/) {
            if ($5 > 128) {
                die "$line_refs[$current_token]: "
                    . "bad bend value: $5\n";
            }
            if ($2) {
                $num = $2;
            }
            else {
                $num = 1;
            }
            if ($3 == 0) {
                $dtime = 0;
            }
            else {
                $dtime = ($header_info{'ticksperquarter'} * 4 * $num) / $3;
            }
            if ($4 eq '-') {
                $current -= $5;
            }
            else {
                $current += $5;
            }
            $data .= &get_delta_time($dtime);

            # use lsb if we need to reach the max value
            if ($current == 128) {
                $lsb = 127;
                $current = 127;
            }
            else {
                $lsb = 0;
            }

            # sanity check
            if (($current > 127) || ($current < 0)) {
                die "$line_refs[$current_token]: "
                    . "current bend amount $current is outside range 0-128\n";
            }
            $data .= pack("C*", 0xDF + $current_channel, $lsb, $current);
        }
        else {
            die "$line_refs[$current_token]: "
                . "bad token $token in \%bend block\n";
        }
        if ($debug) {
            print "BEND: dtime = $dtime ; value = $current\n";
        }
        $i++;
    }
    
    # note off (zero dtime)
    $data .= &get_note_bytes($note, 22);

    # reset pitch wheel if needed
    if ($current != 64) {
        $data .= pack("C*", 0, 0xDF + $current_channel, 0, 64);
    }
    return $data;
}

##
## return a string of bytes representing a chord
##

sub get_chord_bytes {
    my $tokens = shift;                 # chord string
    my @chord = split(/\s+/, $tokens);  # tokens representing the chord
    my $data;                           # data to return
    my $i;                              # loop counter

    if ($debug) {
        print "get_chord_bytes(): chord=@chord\n";
    }

    # Append octave to first note if unspecified
    unless ($chord[0] =~ /\d$/) {
        my $note = $chord[0];
        $note =~ s/^.*\///;
        unless (grep { $note =~ /^$_$/; } keys %drums) {
            print "appending octave $old{'octave'} to first note"
                . " $chord[0] in chord\n" if ($debug);
            $chord[0] .= $old{'octave'};
        }
    }

    $data = &get_note_bytes($chord[0], 11);
    my $length = $old{'note_length'};

    if ($strum * (scalar @chord) >= $length) {
        die "$line_refs[$current_token]:"
            . "strum value $strum too high for current chord\n";
    }

    for ($i=1; $i<=@chord-1; $i++) {
        $data .= &get_note_bytes($chord[$i], 12, $strum);
    }

    $data .= &get_note_bytes($chord[0], 22,
                             $length - ($strum * (@chord-1)) - $shorten);

    for ($i=1; $i<=@chord-1; $i++) {
        $data .= &get_note_bytes($chord[$i], 22, 0);
    }

    return $data;
}

##
## return a string of bytes representing a tuplet
##

sub get_tuplet_bytes {
    my $token;     # current token
    my $data;      # data to return
    
    $token = &get_next_token;
    if ($token =~ /^(\d+):(\d+)$/) {
        push @tuplets, $tuplet;
        $tuplet *= $1/$2;
        print "TUPLET: got value $token\n" if $debug;
    }
    else {
        die "$line_refs[$current_token]: bad tuplet time \`$token\'\n";
    }

    $token = &get_next_token;
    die "$line_refs[$current_token]: after \%tuplet,"
        . "expected \`{\'; found $token\n" unless $token eq '{';

    while ($token = &get_next_token) {
        if ($token eq '}') {
            $tuplet = pop @tuplets;
            print "TUPLET: got end of block;"
                . " retrieved old tuplet $tuplet\n" if $debug;
            last;
        }
        else {
            $data .= &get_token_bytes($token);
        }
    }
    return $data;
}

##
## return a string of bytes entered verbatim in hex or decimal
##

sub get_verbatim_bytes {
    my @bytes;

    my $token = &get_next_token;
    die "after \%verbatim, expected `{'; found $token"
        unless $token eq '{';

    print "GVB(): " if $debug;

    while (defined ($token = &get_next_token)) {
        print "$token " if $debug;
        last if $token eq '}';
        my $byte = $token;
        $byte = oct $byte if $byte =~ /^0/;
        die "bad byte value in verbatim: $token"
            unless $byte >= 0 and $byte < 256;
        push @bytes, $byte;
    }
    print "\n" if $debug;

    return pack "C*", @bytes;
}

################################################
##                                            ##
## @@@SECTION: MIDI event related subroutines ##
##                                            ##
################################################

##
## return a string of bytes representing a pitch bend sensitivity event
##

sub get_bend_range_bytes {
    my $token = shift; # token to process
    my $data;          # data to return

    if (!($token >= 0)) {
        die "$line_refs[$current_token]: bad pitch bend range: $token\n";
    }

    $data = &get_delta_time($old{'rest_length'});
    $data .= pack("C*", 0xaf + $current_channel, 100, 0);
    $data .= pack("C*", 0, 0xaf + $current_channel, 101, 0);
    $data .= pack("C*", 0, 0xaf + $current_channel, 6, $token);

    $current_track_length += $old{'rest_length'};
    $old{'rest_length'} = 0;

    return $data;
}

##
## Return a string of bytes representing an rpn controller adjustment
##

sub get_rpn_bytes {
    my $data; # data to return
    my ($ctrl_h, $ctrl_l, $val_h, $val_l);

    my $token = &get_next_token;
    if ($token =~ /^((\d+),)?(\d+),(\d+)(,(\d+))?$/) {
        ($ctrl_h, $ctrl_l, $val_h, $val_l) = ($2, $3, $5, $6);
        $ctrl_h = 0 unless defined $ctrl_h;
    }
    else {
        warn "$line_refs[$current_token]: error parsing rpn arguments\n";
        die "...expected [ctrl-msb,]ctrl-lsb,value-msb[,value-lsb])\n";
    }

    $data = &get_delta_time($old{'rest_length'});
    $data .= pack("C*", 0xaf + $current_channel, 100, $ctrl_l);
    $data .= pack("C*", 0, 0xaf + $current_channel, 101, $ctrl_h);
    $data .= pack("C*", 0, 0xaf + $current_channel, 6, $val_h);

    if (defined $val_l) {
        $data .= pack("C*", 0xaf + $current_channel, 100, $ctrl_l);
        $data .= pack("C*", 0, 0xaf + $current_channel, 101, $ctrl_h);
        $data .= pack("C*", 0, 0xaf + $current_channel, 38, $val_l);
    }

    $current_track_length += $old{'rest_length'};
    $old{'rest_length'} = 0;

    return $data;
}

##
## Return a string of bytes representing an nrpn controller adjustment
##

sub get_nrpn_bytes {
    my $data; # data to return
    my ($ctrl_h, $ctrl_l, $val_h, $val_l);

    my $token = &get_next_token;
    if ($token =~ /^((\d+),)?(\d+),(\d+)(,(\d+))?$/) {
        ($ctrl_h, $ctrl_l, $val_h, $val_l) = ($2, $3, $5, $6);
        $ctrl_h = 0 unless defined $ctrl_h;
    }
    else {
        warn "$line_refs[$current_token]: error parsing nrpn arguments\n";
        die "...expected [ctrl-msb,]ctrl-lsb,value-msb[,value-lsb])\n";
    }

    $data = &get_delta_time($old{'rest_length'});
    $data .= pack("C*", 0xaf + $current_channel, 98, $ctrl_l);
    $data .= pack("C*", 0, 0xaf + $current_channel, 99, $ctrl_h);
    $data .= pack("C*", 0, 0xaf + $current_channel, 6, $val_h);

    if (defined $val_l) {
        $data .= pack("C", 0);
        $data .= pack("C*", 0xaf + $current_channel, 98, $ctrl_l);
        $data .= pack("C*", 0, 0xaf + $current_channel, 99, $ctrl_h);
        $data .= pack("C*", 0, 0xaf + $current_channel, 38, $val_l);
    }

    $current_track_length += $old{'rest_length'};
    $old{'rest_length'} = 0;

    return $data;
}

##
## return a string of bytes representing a pitch wheel adjustment
##

sub get_pitch_bytes {
    my $value = &get_next_token;
    my $lsb = 0;
    my $data;

    die "$line_refs[$current_token]: bad \$pitch value `$value'\n"
        unless $value >= 0 and $value <= 128; 

    # use lsb if we need to reach the max value
    if ($value == 128) {
        $lsb = 127;
        $value = 127;
    }

    # sanity check
    if (($value > 127) || ($value < 0)) {
        die "$line_refs[$current_token]: "
            . "current bend amount $value is outside range 0-128\n";
    }
    $data = &get_delta_time($old{'rest_length'});
    $data .= pack("C*", 0xDF + $current_channel, $lsb, $value);

    $current_track_length += $old{'rest_length'};
    $old{'rest_length'} = 0;

    return $data;
}

##
## return a string of byte representing a key event
##

sub get_key_bytes {
    my $token = shift; # token to process
    my $note;          # note name of key
    my $sharp;         # sharp/flat character if present
    my $minor;         # `m' for minor if present
    my $sf;            # number of sharps/flats (defines key)
    my $mi;            # whether key is minor
    my $data;          # data to return

    if ($token =~ /^([a-g])(\+|-)?(m)?$/i) {
        $note = lc $1;
        $sharp = $2;
        $minor = $3;

        $header_info{'key'} = "$note$sharp$minor";
        my $key = $header_info{'key'}; # Temporary copy.

        # Fix for minor keys
        if ($key =~ s/m//) {
            $key = &relative_major("${key}m");
            ($note, $sharp) = split //, $key;
        }

        if ($note eq 'a') {
            if ($sharp eq '+') {
                warn "A sharp: no such key: using B flat\n"
                    unless defined $minor;

                $sf = -2;
            }
            elsif ($sharp eq '-') {
                $sf = -4;
            }
            else {
                $sf = 3;
            }
        }
        elsif ($note eq 'b') {
            if ($sharp eq '+') {
                warn "B sharp: no such key: using C\n"
                    unless defined $minor;

                $sf = 0;
            }
            elsif ($sharp eq '-') {
                $sf = -2;
            }
            else {
                $sf = 5;
            }
        }
        elsif ($note eq 'c') {
            if ($sharp eq '+') {
                $sf = 7;
            }
            elsif ($sharp eq '-') {
                $sf = -7;
            }
            else {
                $sf = 0;
            }
        }
        elsif ($note eq 'd') {
            if ($sharp eq '+') {
                warn "D sharp: no such key: using E flat\n"
                    unless defined $minor;

                $sf = -3;
            }
            elsif ($sharp eq '-') {
                $sf = -5;
            }
            else {
                $sf = 2;
            }
        }
        elsif ($note eq 'e') {
            if ($sharp eq '+') {
                warn "E sharp: no such key: using F\n"
                    unless defined $minor;

                $sf = -1;
            }
            elsif ($sharp eq '-') {
                $sf = -3;
            }
            else {
                $sf = 4;
            }
        }
        elsif ($note eq 'f') {
            if ($sharp eq '+') {
                $sf = -6;
            }
            elsif ($sharp eq '-') {
                warn "F flat: no such key: using E\n"
                    unless defined $minor;

                $sf = 4;
            }
            else {
                $sf = -1;
            }
        }
        elsif ($note eq 'g') {
            if ($sharp eq '+') {
                warn "G sharp: no such key: using A flat\n"
                    unless defined $minor;

                $sf = -4;
            }
            elsif ($sharp eq '-') {
                $sf = -6;
            }
            else {
                $sf = 1;
            }
        }
    }
    else {
        die "$line_refs[$current_token]: bad key: $token\n";
    }
    if (defined($minor)) {$mi = 1;}
    else {$mi = 0;}

    print "adding key \`$token' ($sf, $mi)\n" if $debug;

    $data = pack("C*", 0xFF, 0x59, 2, $sf, $mi);
    return $data;
}

##
## return bytes representing a text marker event (without delta time)
##

sub get_marker_bytes {
    my $data;  # data to return
    my $token; # current token
    my $text;  # marker text

    $token = &get_next_token;
    if ($token =~ /^\"[^\"]*$/) {
        $_ = $token;
        s/^.//;
        $text = $_;
        while ($token = &get_next_token) {
            if ($token =~ /\"/) {
                $_ = $token;
                s/\"$//;
                $text .= " $_";
                last;
            }
            $text .= " $token";
        }
    }
    else {
        $text = $token;
    }

    $data = pack("C2", 0xff, 0x06) . &get_data_size($text, 1) . $text;
    return $data;
}

##
## Return a string of bytes representing a text event.
##

sub get_text_bytes {
    my $text = &get_quoted_string;
    my $length = &get_data_size($text, 1);

    my $data = pack "C*", 0, 0xff, 1;
    $data .= $length . $text;

    return $data;
}

##
## return a string of bytes representing a pan event
## takes a range `n-m' or single value
##

sub get_pan_bytes {
    my $data; # data to return
    my ($token, $save) = @_;

    my $pan = &get_range_value($token); # pan value

    if (($pan > 127) || ($pan < 0)) {
        die "$line_refs[$current_token]: bad pan value $token\n";
    }

    $last_pan = $pan if $save;

    $data = &get_delta_time($old{'rest_length'});
    $data .= pack("C*", 0xb0 + $current_channel-1, 10, $pan);

    if ($debug) {
        print "PAN: data=$data";
    }

    $current_track_length += $old{'rest_length'};
    $old{'rest_length'} = 0;

    return $data;
}

##
## return a string of bytes representing a controller event
##

sub get_ctrl_bytes {
    my $data;
    my $token = &get_next_token;


    if ($token =~ /^(\d+),(\d+)$/) {
        my ($ctrl, $value) = ($1, $2);
        
        die "$line_refs[$current_token]: bad controller value $value\n"
            unless $value >= 0 and $value < 128;

        $data = &get_delta_time($old{'rest_length'});
        $data .= pack("C*", 0xb0 + $current_channel-1, $ctrl, $value);

        if ($debug) {
            print "CTRL: set ctrl $ctrl to $value\n";
        }

        $current_track_length += $old{'rest_length'};
        $old{'rest_length'} = 0;
        return $data;
    }
    else {
        die "$line_refs[$current_token]: "
            . "bad \$ctrl parameter $token (expected `ctrl#,value')\n";
    }
}

###########################################
##                                       ##
## @@@SECTION: Input related subroutines ##
##                                       ##
###########################################

##
## add tokens from a file or stdin to @tokens
##

sub get_tokens {
    my $input = shift;     # input file
    my $parent = shift;    # the file which included this one, if any
    my $bol_token = shift; # token number at beginning of line
    my @tmp_tokens;        # temporary array of tokens
    my $marker = 0;        # marks current line in source
    my $i;                 # loop counter
    my $unused;            # throwaway string
    my $num_tokens;        # number of tokens we already have
    my $tmp;               # temp var
    my $in_body = 0;       # flag set when in body section
    my $track_num = 0;     # keeps trck of track number

    $bol_token = 0 unless defined $bol_token;
    $parent = 0 unless defined $parent;

    if ($debug) {
        print "get_tokens($input)\n";
    }

    $num_tokens = @tokens;

    if ($input) {

        # Find the input file if it's an include file
        if ($parent) {
            my $infile = $input;
            my $i = 0;
            $input = "$include_paths[$i++]/$infile"
                while (not -e $input and $i < @include_paths);
            die "could not locate `$infile'"
                . " included from $parent" unless -e $input;
        }

        open(INFILE, $input) or die "could not open $input for input\n";

        while (<INFILE>) {
            $marker++;
            chomp();
            s/#.*//;
            s/^\s*//;
            s/\s*$//;
            if (/^$/) {next;}
            if (/\@channel/) {
                $track_num++;
            }
            elsif (/\%(choose|chain|eval)/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found \%choose or \%chain or \%eval:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif (/\b\d+-\d+\b/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found range value or pan_all:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif (/\$marker|\$shorten/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found marker or shorten:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif ((/\$(tempo|time_sig|key)/) && ($in_body)) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found tempo, time or key:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif ($_ =~ m@/.*Z.*/\S+|\$unquantise@i) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found note offset:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
        elsif (/\|_?\d*/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found bar line:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
        }
            elsif (/\@body/) {
                $in_body = 1;
            }
            elsif (/\%include\s+(\S+)/) {
                if ($debug) {
                    print "looking for include file $1\n";
                }
                close(INFILE);

                # read an include file
                &get_tokens($1, $input, $bol_token);

                $bol_token = @tokens;

                # re open previous file and skip to last position
                open(INFILE, $input)
                    || die "could not reopen $input for reading\n";
                for ($i=0; $i<$marker; $i++) {
                    $unused = <INFILE>;
                }
                next;
            }
            @tokens = (@tokens, split(/\s+/));
            for ($bol_token..@tokens - 1) {
                $line_refs[$_] = "$input:$marker";
            }
            $bol_token = @tokens;
        }
        close(INFILE)
    }
    else {
        while (<STDIN>) { # FIXME: This shouldn't be duplicated
            $marker++;
            chomp();
            s/#.*//;
            s/^\s*//;
            s/\s*$//;
            if (/^$/) {next;}
            if (/\@channel/) {
                $track_num++;
            }
            elsif (/\%(choose|chain|eval)/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found \%choose or \%chain or \%eval:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif (/\b\d+-\d+\b/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found range value or pan_all:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif (/\$marker|\$shorten/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found marker or shorten:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif ((/\$(tempo|time_sig|key)/) && ($in_body)) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found tempo, time or key:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
            elsif ($_ =~ m@/.*Z.*/\S+@i) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found note offset:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
            }
        elsif (/\|_?\d*/) {
                $unroll[$track_num] = 1;
                if (!$unroll_loops) {
                    if ($verbose) {
                        print "found bar line:"
                            . " setting unroll-loops option\n";
                    }
                    $unroll_loops = 1;
                    $source_outfile = $outfile;
                    $source_outfile =~ s/(\.mid)?$/.long.mg/;
                }
        }
            elsif (/\@body/) {
                $in_body = 1;
            }
            elsif (/\%include\s+(\S+)/) {
                if ($debug) {
                    print "looking for include file $1\n";
                }

                &get_tokens($1, 'STDIN', $bol_token);

                $bol_token = @tokens;

                next;
            }
            @tokens = (@tokens, split(/\s+/));
            for ($bol_token..@tokens - 1) {
                $line_refs[$_] = "STDIN:$marker";
            }
            $bol_token = @tokens;
        }
    }
    if ($verbose) {
        if ($input) {
            printf("found %d tokens in $input\n",
                    @tokens - $num_tokens);
        }
        else {
            printf("found %d tokens in <STDIN>\n",
                    @tokens - $num_tokens);
        }
    }
}

##
## check the source code for errors
##

sub pre_parse {
    my $bracket = 0;     # counter for {} brackets
    my $got_head = 0;    # flag set when @head section found
    my $got_body = 0;    # flag set when @body section found
    my $got_channel = 0; # flag set when @channel section found
    my $i;               # loop counter
    my $max;             # max value for counter
    my $tmp;             # tmp var

    $header_info{'num_tracks'} = 1;
    for ($i=0; $i<=@tokens-1; $i++) {
        $_ = $tokens[$i];
        if ($_ eq '@head') {
            if ($got_head) {
                die "$line_refs[$i]: found second \@head section\n";
            }
            else {
                $got_head = 1;
            }
        }
        elsif ($_ eq '@body') {
            if ($got_body) {
                die "$line_refs[$i]: found second \@body section\n";
            }
            else {
                $got_body = 1;
            }
        }
        elsif ($_ eq '{') {
            $bracket++;
        }
        elsif ($_ eq '}') {
            $bracket--;
            if ($bracket < 0) {
                die "$line_refs[$i]: mismatched parenthesis\n";
            }
        }
        elsif ($_ eq '@channel') {
            if ($bracket != 1) {
                die "$line_refs[$i]:"
                    . " parse error before \`$tokens[$i] $tokens[$i+1]\'\n";
            }
            $got_channel = 1;
            $header_info{'num_tracks'}++;
        }
        elsif ($_ eq '%define') {
            if ($bracket != 1) {
                die "$line_refs[$i]:"
                    . " parse error before \`$tokens[$i] $tokens[$i+1]\'\n";
            }
        }
        # convert L to l in note options
        elsif (/(\/\S*)L(\S+\/)/) {
            $tokens[$i] =~ s/L/l/;
        }
        # ignore tempo tracks
        if ($_ eq '$track_type' and $tokens[++$i] eq 'tempo') {
            $header_info{'num_tracks'}--;
        }
        # convert simple bend syntax
        elsif (/^\/(\S+)\/[a-g][-+=]?(\d+)?=>[a-g][-+=]?(\d+)?/) {
            my @bend_tokens = &get_bend_tokens($_, $i);
            @tokens = (@tokens[0..$i - 1],
                       @bend_tokens,
                       @tokens[$i + 1..@tokens]);

            # Fix the line_refs array
            my @bend_refs;
            for my $j (0..@bend_tokens) {
                $bend_refs[$j] = $line_refs[$i];
            }
            @line_refs = (@line_refs[0..$i], @bend_refs,
                          @line_refs[$i+1..@line_refs-1]);

            $i = $i + @bend_tokens - 1;
        }
    }
    if (!$got_head) {
        die "no \@head section found\n";
    }
    if (!$got_channel) {
        die "no \@channel sections found\n";
    }
    if ($bracket != 0) {
        die "unexpected EOF while searching for \`}'\n";
    }
    printf("found %d music tracks\n",
            $header_info{'num_tracks'} - 1) unless $quiet;

    # source is ok - unroll repeat blocks now if option is set
    if ($unroll_loops) {
        my @unroll_line_refs;
        $header_info{'ticksperquarter'} = 96; # tmp resolution value
        my $track_num = 0;
        $max = @tokens-1; $tmp = '';
        for ($i=0; $i<=$max; $i++) {
            if (($unroll_loops == 2 or $unroll[$track_num])
                and $tokens[$i] eq '%repeat') {

                my $newtokens = &get_repeat_tokens($i+1) . ' ';

                my $ref_count = 0;
                map {
                    $ref_count++;
                    push @unroll_line_refs, $line_refs[$i];
                } split /\s+/, $newtokens;

                $tmp .= $newtokens;
                $i = $current_token;
            }
            elsif ($tokens[$i] eq '%define') {
                my $newtokens = "$tokens[$i] $tokens[$i+1] ";
                $newtokens .= '{ ' . &unroll_define($i+2). ' } ';

                map { 
                    push @unroll_line_refs, $line_refs[$i];
                } split /\s+/, $newtokens;

                $tmp .= $newtokens;
                $i = $current_token;
            }
            elsif ($tokens[$i] eq '@channel') {
                $tmp .= "$tokens[$i] ";
                push @unroll_line_refs, $line_refs[$i];
                $track_num++;
            }
            else {
                $tmp .= $tokens[$i] . ' ';
                push @unroll_line_refs, $line_refs[$i];
            }
        }
        @tokens = split(/\s+/, $tmp);
        @line_refs = @unroll_line_refs;
        @unroll_line_refs = ();

        # run eval blocks
        $max = @tokens-1; $tmp = '';
        for ($i=0; $i<=$max; $i++) {
            if ($tokens[$i] eq '%eval') {
                if ($tokens[$i+1] eq '-') {
                    $i++;
                    &get_eval_tokens($i+1);
                }
                else {
                    my $newtokens = &get_eval_tokens($i+1) . " ";
                    map { 
                        push @unroll_line_refs, $line_refs[$i];
                    } split /\s+/, $newtokens;

                    $tmp .= $newtokens;
                }
                $i = $current_token;
            }
            else {
                $tmp .= "$tokens[$i] ";
                push @unroll_line_refs, $line_refs[$i];
            }
        }
        @tokens = split(/\s+/, $tmp);
        @line_refs = @unroll_line_refs;
        @unroll_line_refs = ();

        # handle any %choose or %chain blocks
        $max = @tokens-1; $tmp = '';
        for ($i=0; $i<=$max; $i++) {
            if ($tokens[$i] eq '%choose') {
                if ($tokens[$i+1] eq '{') {
                    my $newtokens = &get_choose_token($i+1);

                    map {
                        push @unroll_line_refs, $line_refs[$i];
                    } split /\s+/, $newtokens;

                    $tmp .= $newtokens . ' ';
                }
                else {
                    my $newtokens = &get_time_choose_tokens($i+1);

                    map {
                        push @unroll_line_refs, $line_refs[$i] if /\S/;
                    } split /\s+/, $newtokens;

                    $tmp .= $newtokens . ' ';
                }
                $i = $current_token;
            }
            elsif ($tokens[$i] eq '%chain') {
                print "found chain block\n" if ($debug);
                my $newtokens = &get_chain_tokens($i+1);

                map { 
                    push @unroll_line_refs, $line_refs[$i] if /\S/;
                } split /\s+/, $newtokens;

                $tmp .= $newtokens . ' ';
                $i = $current_token;
            }
            else {
                $tmp .= "$tokens[$i] ";
                push @unroll_line_refs, $line_refs[$i];
            }
        }
        @tokens = split(/\s+/, $tmp);
        @line_refs = @unroll_line_refs;
        @unroll_line_refs = ();
        $current_token = -1;
    }
}

##
## expand the simple bend syntax
##

sub get_bend_tokens {
    my ($token, $current_token) = @_;
    my @bend_tokens = ('%bend');         # tokens to return
    my $orig_token = $token;

    my @bend_notes = split '=>', $token;

    #print "first=$bend_notes[0]\n";
    if ($bend_notes[0] =~ /^\/.*l((\d+):)?(\d+).*\/([a-g][-+=]?\d+)$/) {
        my $num = (defined $1)? $2 : 1;
        my $denom = $3;
        my $note = $4;
        my $first_note = $4;
        @bend_tokens[1..2] = ($note, '{');

        my $divisions = ($bend_steps * 4 * $num) / $denom;
        $denom *= $divisions;
        my $range = 2;

        # find max bend amount before setting range
        foreach my $i (1..@bend_notes - 1) {
            my $last_note = $note;
            $note = $bend_notes[$i];
            #print "note=$note ; last_note=$last_note\n";
            my $amount = &note_to_int($note) - &note_to_int($last_note);
            $amount = 0 - $amount if $amount < 0;
            $range = $amount if $amount > $range;
        }

        #print "range=$range\n";
        $note = $first_note;

        @bend_tokens = ('$bend_range', $range, @bend_tokens);

        foreach my $i (1..@bend_notes - 1) {
            my $last_note = $note;
            $note = $bend_notes[$i];
            my $total = &note_to_int($note) - &note_to_int($last_note);
            $total = int(($total * 64) / $range);
            #print "total bend amount = $total\n";

            my $bent = 0;
            my $num_steps = int(int($divisions) / (@bend_notes - 1));

            #print "num_steps = $num_steps\n";
            for my $j (1..$divisions / (@bend_notes - 1)) {
                my $amount = int(($total - $bent) /
                                 (($num_steps) + 1 - $j));

                $bent += $amount;

                $amount = "+$amount" if $amount >= 0;
                #print "amount per step = $amount\n";
                push @bend_tokens, "$num:$denom" . $amount;
            }
        }

        @bend_tokens = (@bend_tokens, '}', '$bend_range', 2);
    }
    else {
        die "$line_refs[$current_token]: "
            . "error in first note of `$orig_token'\n";
    }

    #print "@bend_tokens\n"; exit;
    return @bend_tokens;
}


##
## unroll a repeat block
##

sub get_repeat_tokens {
    my $i = shift; # position counter
    my $tokens;    # string of tokens to return
    my $tmp;       # tmp var
    my $token;     # current token
    my $repeat;    # number of times to repeat
    my $count = 1; # to count {} brackets

    $repeat = $tokens[$i] ||
        die "$line_refs[$current_token]: missing number after \%repeat\n";
    $i++;
    ($tokens[$i] eq '{') || 
        die "$line_refs[$current_token]: missing { after \%repeat\n";
    $i++;
    while (1) {
        if ($tokens[$i] eq '%repeat') {
            $tokens .= &get_repeat_tokens($i+1) . " ";
            $i = $current_token;
        }
        elsif ($tokens[$i] eq '{') {
            $tokens .= " $tokens[$i]";
            $count++;
        }
        elsif ($tokens[$i] eq '}') {
            $count--;
            if ($count == 0) {
                for (1..$repeat) {
                    $tmp .= "$tokens ";
                }
                $tokens = $tmp;
                $current_token = $i;
                last;
            }
            else {
                $tokens .= " $tokens[$i]";
            }
        }
        else {
            $tokens .= " $tokens[$i]";
        }
        $i++;
    }
    return $tokens;
}

##
## unroll a define block
##

sub unroll_define {
    my $i = shift; # position counter
    my $tokens;    # string of tokens to return
    my $tmp;       # tmp var
    my $token;     # current token
    my $count = 1; # to count {} brackets

    ($tokens[$i] eq '{') || 
        die "$line_refs[$current_token]: missing `{'"
            . " after \%define $tokens[$i-1]\n";
    $i++;
    while (1) {
        if ($tokens[$i] eq '%repeat') {
            $tokens .= &get_repeat_tokens($i+1) . " ";
            $i = $current_token;
        }
        elsif ($tokens[$i] eq '{') {
            $tokens .= " $tokens[$i]";
            $count++;
        }
        elsif ($tokens[$i] eq '}') {
            $count--;
            if ($count == 0) {
                $current_token = $i;
                last;
            }
            else {
                $tokens .= " $tokens[$i]";
            }
        }
        else {
            $tokens .= " $tokens[$i]";
        }
        $i++;
    }
    return $tokens;
}

##
## Search for and parse the @head section
##

sub parse_header_info {
    my $line;     # current line
    my $token;    # current token

    if ($debug) {
        print "parse_header_info()\n";
    }

    while ($token = &get_next_token) {
        if ($token eq '@head') {
            if ($debug) {
                print "got \@head\n";
            }
            (&get_next_token eq '{')
                || die "$line_refs[$current_token]:"
                    . " after \@head: expected { ; found $_\n";
            last;
        }
    }

    while ($token = &get_next_token) {
        if ($token eq '}') {
            if ($debug) {
                print "parse_h_i() got }\n";
            }
            last;
        }
        else {
            $token =~ s/^\$//;
            if ($token eq 'title') {
                $token = &get_next_token;
                if ($token =~ /^\"[^\"]*$/) {
                    $_ = $token;
                    s/^.//;
                    $header_info{'title'} = $_;
                    while ($token = &get_next_token) {
                        if ($token =~ /\"/) {
                            $_ = $token;
                            s/\"$//;
                            $header_info{'title'} .= " $_";
                            last;
                        }
                        $header_info{'title'} .= " $token";
                    }
                }
                else {
                    $header_info{'title'} = $token;
                }
            }
            elsif ($token eq 'resolution') {
                $header_info{'ticksperquarter'} = &get_next_token;
            }
            else {
                $header_info{$token} = &get_next_token
                    || die "$line_refs[$current_token]:"
                        . " missing value for $token\n";
                if ($debug) {
                    print "got header value $token = $header_info{$token}\n";
                }
            }
        }
    }
    if ($tempo) {
        $header_info{'tempo'} = $tempo;
    }
    if (!$header_info{'tempo'}) {
        $header_info{'tempo'} = 80;
    }
    if (!$header_info{'ticksperquarter'}) {
        $header_info{'ticksperquarter'} = 96;
    }
    if ($header_info{'bar_strict'}) {
        $strict_bar = 1;
    }
}


##
## Find the @body section of source
##

sub find_body {
    my $token; # current token

    while ($token = &get_next_token) {
        if ($token eq '@body') {
            (&get_next_token eq '{')
                || die "$line_refs[$current_token]:"
                    . " after \@body: expected { ; found $token\n";
            last;
        }
    }
}

##
## Find and parse @channel and %define blocks until end of the @body section
##

sub find_next_channel {
    my $token;                 # current token
    undef $current_instrument; # text name of instrument

    while ($token = &get_next_token) {
#        print "DBG: token=$token\n";

        if ($debug) {
            print "find_next_channel(): token = $token\n";
        }

        if ($token eq '@channel') {
            $current_channel = &get_next_token
                || die "$line_refs[$current_token]:"
                    . " missing channel number after \@channel\n";
            if ($verbose) {
                print "found channel $current_channel\n";
            }

            $token = &get_next_token;
            if ($token eq '{') {
                last;
            }
            elsif ($token =~ /^\"[^\"]*$/) {
                $_ = $token;
                s/^\"//;
                $current_instrument = $_;
                while ($token = &get_next_token) {
                    if ($token =~ /\"/) {
                        $_ = $token;
                        s/\"$//;
                        $current_instrument .= " $_";
                        last;
                    }
                    else {
                        $current_instrument .= " $token";
                    }
                }
                (&get_next_token eq '{') ||
                    die "$line_refs[$current_token]:"
                        . " expected \`{' ; found $_\n";
                last;
            }
            else {
                $_ = $token;
                s/\"//g;
                $current_instrument = $_;
                (&get_next_token eq '{') ||
                    die "$line_refs[$current_token]:"
                        . " expected \`{' ; found $_\n";
                last;
            }
        }
        elsif ($token eq '%define') {
            &define_riff;
        }
        elsif ($token eq '}') {
            if ($verbose) {
                print "got end of body\n";
            }
            $current_channel = -1;
            last;
        }
        else {
            die "$line_refs[$current_token]: Error parsing `$token'\n";
        }
    }
    if (!$token) {
        $current_channel = -1;
    }
}

##
## return the next token
##

sub get_next_token {
    my $token; # next token to return

    ($token, @tokens) = @tokens;
    $current_token++;
    if ($debug) {
        print "current_token = $current_token ($token)\n";
    }
    return $token;
}

############################################
##                                        ##
## @@@SECTION: Random related subroutines ##
##                                        ##
############################################

##
## run eval code and return the output
##

sub get_eval_tokens {
    my $i = shift; # position counter
    my $tokens;    # string of tokens to return
    my $tmp;       # tmp var
    my $token;     # current token
    my $count = 1; # to count {} brackets

    unless ((defined $sandbox) or ($unsafe)) {
        die 'Can\'t run eval block without Safe.pm unless'
            . ' `--unsafe\' option is set.', "\n";
    }

    ($tokens[$i] eq '{') ||
        die "$line_refs[$current_token]: missing { after \%eval\n";
    $i++;
    while (1) {
        if ($tokens[$i] eq '{') {
            $tokens .= " $tokens[$i]";
            $count++;
        }
        elsif ($tokens[$i] eq '}') {
            $count--;
            if ($count == 0) {
                my $output;
                if (defined $sandbox) {
                    print 'running eval code in sandbox', "\n" if $debug;
                    $output = $sandbox->reval($tokens);
                    die "Error during sandbox eval: $@\n" if $@;
                }
                else {
                    print 'running eval code', "\n" if $debug;
                    $output = eval($tokens);
                    die "Error during eval: $@\n" if $@;
                }
                $tokens = ' ' . $output . ' ';
                $current_token = $i;
                last;
            }
            else {
                $tokens .= " $tokens[$i]";
            }
        }
        else {
            $tokens .= " $tokens[$i]";
        }
        $i++;
    }
    print "eval returned $tokens\n" if $debug;
    return $tokens;
}

##
## choose from a list of weighted riffs/notes
##

sub get_choose_token {
    my $pos = shift; # position counter
    my $token;       # holds current token
    my @choices;     # array of note/riff tokens to choose from
    my @weights;     # array of weightings corresponding to choices
    my $weight;      # total of weightings
    my $choice;      # chosen token
    my $i;           # loop counter
    my @tmp;         # tmp array to use in rand() call

    print "get_choose_token()\n" if $debug;

    ($tokens[$pos] eq '{')
        || die "error: after \%choose: expected \`{' ; found $_\n";

    $pos++;
    while (1) {
        if ($tokens[$pos] eq '}') {
            print "CHOOSE: got end of choose block\n" if $debug;
            $current_token = $pos;
            last;
        }
        else {
            if ($tokens[$pos] eq 'scale') {
                my $type = $tokens[$pos+1];
                my $range = $tokens[$pos+2];
                my $root;
                my $opts;

                if ($debug) {
                    print 'CHOOSE: found scale keyword', "\n";
                }

                if ($range =~ /^(\/\S+\/)?([a-g][-+]?)(\d+)(-(\d+))?$/) {
                    $opts = $1;
                    $root = $2;
                    if (defined $5) {
                        if ($3 > $5) {
                            $root .= $5;
                            $range = $3 - $5;
                        }
                        else {
                            $root .= $3;
                            $range = $5 - $3;
                        }
                    }
                    else {
                        $root .= $3;
                        $range = 1;
                    }
                }
                else {
                    die 'error in choose block near'
                        . " `@tokens[$pos..$pos+2]'\n";
                }
                $pos += 3;

                unless ((defined $opts) and ($opts =~ /l\d+/)) {
                    warn 'Warning: no length specified for scale in choose '
                        . 'block near ' . "`@tokens[$pos..$pos+2]'\n";
                }

                if ($debug) {
                    print 'SCALE: calling get_scale('
                        . "$type, $root, $range, $opts)\n";
                } 
                my $scale = &get_scale($type, $root, $range, $opts);

                if ($tokens[$pos] eq '[') {
                    if ($debug) {
                        print 'SCALE: parsing weight block', "\n";
                    }
                    while (!($tokens[++$pos] eq ']')) {
                        my $note = undef;
                        if (@{@$scale} == 0) {
                            die 'too many weighting values in choose block'
                                . ", after scale $root\n";
                        }
                        if ($tokens[$pos] =~ /^\d+$/) {
                            ($note, @$scale) = @$scale;
                            unless ($tokens[$pos] == 0) {
                                push(@choices, $note);
                                push(@weights, $tokens[$pos]);
                            }
                        }
                        else {
                            die "bad weighting value `$tokens[$pos]'"
                                . " in choose block after scale $root\n";
                        }
                    }
                    if ($debug) {
                        print 'SCALE: end of weighting block', "\n";
                    }
                    $pos++;
                }
                else {
                    push (@weights, 1) for (0..@{@$scale}-1);
                    @choices = (@choices, @$scale);

                    if ($debug) {
                        print 'SCALE: used default weight for each note', "\n";
                    }
                }    
            }
            else {
                if (!$tokens[$pos] =~ /^[0-9]+$/) {
                    die "bad weighting value in choose block: $tokens[$pos]\n";
                }
                @weights = (@weights, $tokens[$pos]);
                $pos++;
                if ($tokens[$pos] eq '}') {
                    die "error: missing last item in choose block\n";
                }
                @choices = (@choices, $tokens[$pos]);
                $pos++;
                if ($debug) {
                    print "CHOOSE: got choice: "
                        . "$weights[@weights-1] ; $choices[@choices-1]\n";
                }
            }
        }
    }

    for ($i=1; $i<=@weights-1; $i++) {
        $weights[$i] += $weights[$i-1];
    }
    $tmp[$weights[@weights-1]] = 1;

    $choice = int(rand(@tmp));
    for ($i=0; $i<=@weights-1; $i++) {
        if ($weights[$i] >= $choice) {
            $choice = $choices[$i];
            last;
        }
    }
    print "CHOOSE: returning $choice\n" if $debug;
    return $choice;
}           

##
## choose from a list of weighted riffs/notes
##

sub get_time_choose_tokens {
    my $pos = shift;    # position counter
    my $time;           # amount of time to play for
    my $time_count = 0; # amount of time played so far
    my $length;         # length of current note
    my $lastlength;     # saves length of previous note
    my $token;          # holds current token
    my @choices;        # array of note/riff tokens to choose from
    my @weights;        # array of weightings corresponding to choices
    my $weight;         # total of weightings
    my $choices;        # chosen tokens
    my $choice;         # temp var for current choice
    my $rejects;        # number of notes rejected as too long
    my $max_rejects;    # max rejects before we give up and use a rest
    my $i;              # loop counter
    my @tmp;            # tmp array to use in rand() call
    my $tmp;            # temp scalar

    print "get_time_choose_tokens()\n" if $debug;

    # read time value & translate to midi clicks
    if ($tokens[$pos] =~ /^0|-$/) {
        $time = 0;
    }
    elsif ($tokens[$pos] =~ /^\d+(:\d+)?$/) {
        $time = &time_to_clicks($tokens[$pos]);
    }
    else {
        die "bad time value in choose block "
            . "at \`\%choose $tokens[$pos]\n";
    }
    $pos++;

    ($tokens[$pos] eq '{')
        || die "error: after \%choose $time: expected \`{' ; found $_\n";
    $pos++;

    while (1) {
        if ($tokens[$pos] eq '}') {
            print "CHOOSE: got end of choose block\n" if $debug;
            $current_token = $pos;
            last;
        }
        elsif ($tokens[$pos] =~ /^(rhythm|times)$/) {
            ($tokens[++$pos] eq '{')
                || die "after $tokens[$pos-1]: expected \`{' ; found $_\n";
            print "CHOOSE: got start of rhythm block\n" if $debug;
            $pos++;
            last;
        }
        else {
            if ($tokens[$pos] eq 'scale') {
                my $type = $tokens[$pos+1];
                my $range = $tokens[$pos+2];
                my $root;
                my $opts;

                if ($debug) {
                    print 'CHOOSE: found scale keyword', "\n";
                }

                if ($range =~ /^(\/\S+\/)?([a-g][-+]?)(\d+)(-(\d+))?$/) {
                    $opts = $1;
                    $root = $2;
                    if (defined $5) {
                        if ($3 > $5) {
                            $root .= $5;
                            $range = $3 - $5;
                        }
                        else {
                            $root .= $3;
                            $range = $5 - $3;
                        }
                    }
                    else {
                        $root .= $3;
                        $range = 1;
                    }
                }
                else {
                    die 'error in choose block near'
                        . " \`@tokens[$pos..$pos+2]\'\n";
                }
                if ($time) {
                    unless ((defined $opts) and ($opts =~ /l\d+/)) { #FIXME
                        warn 'Warning: no length specified for scale in'
                            . " choose block near `@tokens[$pos..$pos+2]'\n";
                    }
                }

                $pos += 3;

                if ($debug) {
                    print 'SCALE: calling get_scale('
                        . "$type, $root, $range, $opts)\n";
                } 
                my $scale = &get_scale($type, $root, $range, $opts);

                if ($tokens[$pos] eq '[') {
                    if ($debug) {
                        print 'SCALE: parsing weight block', "\n";
                    }
                    while (!($tokens[++$pos] eq ']')) {
                        my $note = undef;
                        if (@{$scale}-1 == -1) {
                            die 'too many weighting values in choose block'
                                . ", after scale $root\n";
                        }
                        if ($tokens[$pos] =~ /^\d+$/) {
                            ($note, @$scale) = @$scale;
                            unless ($tokens[$pos] == 0) {
                                push(@choices, $note);
                                push(@weights, $tokens[$pos]);
                            }
                        }
                        else {
                            die "bad weighting value \`$tokens[$pos]\'"
                                . " in choose block after scale $root\n";
                        }
                    }
                    if ($debug) {
                        print 'SCALE: end of weighting block', "\n";
                    }
                    $pos++;
                }
                else {
                    push (@weights, 1) for (0..@$scale-1);
                    @choices = (@choices, @$scale);

                    if ($debug) {
                        print 'SCALE: used default weight for each note', "\n";
                    }
                }    
            }
            else {
                unless ($tokens[$pos] =~ /^[0-9]+$/) {
                    die "bad weighting value in choose block: $tokens[$pos]\n";
                }
                @weights = (@weights, $tokens[$pos]);
                $pos++;

                if ($tokens[$pos] eq '}') {
                    die "error: missing last item in choose block\n";
                }

                @choices = (@choices, $tokens[$pos]);
                $pos++;
                if ($debug) {
                    print "CHOOSE: got choice: "
                        . "$weights[@weights-1] ; $choices[@choices-1]\n";
                }
            }
        }
    }
    
    for ($i=1; $i<=@weights-1; $i++) {
        $weights[$i] += $weights[$i-1];
    }
    $tmp[$weights[@weights-1]] = 1;

    $max_rejects = (@weights-1) * 0.75;
    
    while (1) {
        # if not time limited get the next rhythm token
        if ($time == 0) {
            if ($tokens[$pos] eq '}') {
                print "CHOOSE: got end of rhythm block\n" if $debug;
                $pos++;
                last;
            }
            # pick a note if needed
            elsif ($tokens[$pos] =~ /^(\/\S+\/)?(\d+(:\d+)?)(x(\d+))?$/) {
                my $opts = $1;
                my $len = $2;
                my $rpt = $5;

                $opts = '//' unless (defined $opts);
                if ($opts =~ /l\d+/) {
                    warn "removing length from $tokens[$pos]"
                        . " in choose block\n";
                    $opts =~ s/l\d+(:\d+)?//;
                }

                $opts =~ s/^\//\/l$len/;

                $rpt = 1 unless ($rpt > 1);

                for (1..$rpt) {
                    $choice = -1;
                    my $rand = int(rand(@tmp));
                    for ($i=0; $i<=@weights-1; $i++) {
                        if ($weights[$i] >= $rand) {
                            $choices .= ' ' . $opts . $choices[$i];
                            last;
                        }
                    }
                }                   
                $pos++;
            }
            # otherwise pass the token through
            else {
                $tokens[$pos] =~ s/^_//;
                $choices .= ' ' . $tokens[$pos++];
            }
        }
        # else pick a note and check it fits withing the time limit
        else {
            $choice = -1;
            my $rand = int(rand(@tmp));
            for ($i=0; $i<=@weights-1; $i++) {
                if ($weights[$i] >= $rand) {
                    $choice = $choices[$i];
                    last;
                }
            }

            # make sure we picked a note
            next if ($choice == -1);
            
            # check if note fits within $time
            if ($choice =~ /\/l(([0-9]+:)?[0-9]+)/) {
                $length = &time_to_clicks($1);
            }
            else {
                die "in choose block, item \`$choice' has no length\n";
            }
            # remove the length value if the item is a predefined riff
            if ($choice =~ /\/\S+\/(~\S+)$/) {
                $choice = $1;
            }
            if ($debug) {
                print "TIMECHOOSE: count,length,time = "
                    . "$time_count ; $length ; $time\n";
            }
            if (($time_count + $length) <= $time) {
                print "TIMECHOOSE: chosen $choice\n" if $debug;
                $choices .= " $choice";
                $time_count += $length;
                if ($time_count == $time) {
                    last;
                }
            }
            else {
                print "TIMECHOOSE: rejected $choice\n" if $debug;
                $rejects++;
                if ($rejects >= $max_rejects) {
                    # fill remaining time with a rest & give up
                    $choice = &clicks_to_time($time - $time_count);
                    $choices .= " /l$choice/r";
                    last;
                }
                $weights[$i] = $weights[$i-1];
            }
        }
    }
    $current_token = $pos;
    return $choices;
}

##
## return a string of tokens from a %chain block
##

sub get_chain_tokens {
    my $pos = shift;       # position counter
    my $choices;           # tokens to return
    my $chain;             # reference to the chain structure
    my $chain_start;       # note to start from
    my $time;              # how long to play for if limited
    my $needlength;        # whether note length needs to be specified

    print "get_chain_tokens()\n" if $debug;

    # read time value & translate to midi clicks
    if ($tokens[$pos] =~ /^[-0]$/) {
        $time = 0;
    }
    elsif ($tokens[$pos] =~ /^(([0-9]+:)?[0-9]+)$/) {
        $time = &time_to_clicks($tokens[$pos]);
    }
    else {
        die "bad time value in chain block "
            . "at \`\%chain $tokens[$pos]\n";
    }
    $pos++;

    ($tokens[$pos] eq '{')
        || die "error: after \%chain $time: expected \`{' ; found $_\n";
    $pos++;

    print "CHAIN: parsing chain structure\n" if ($debug);
    while (1) {
        if (!(defined($tokens[$pos]))) {
            die "unexpected EOF in chain block\n";
        }
        elsif ($tokens[$pos] eq '}') {
            print "CHAIN: got end of chain block\n" if $debug;
            $current_token = $pos;
            last;
        }
        elsif ($tokens[$pos] =~ /^(rhythm|times)$/) {
            # parse the rhythm tokens
            $pos++;
            if ($time > 0) {
                ($choices, $pos) = &get_closed_chain_tokens($pos, $chain,
                                                            $time,
                                                            $chain_start);
            }
            else {
                ($choices, $pos) = &get_open_chain_tokens($pos, $chain, $time,
                                                          $chain_start);
            }
        }
        elsif ($tokens[$pos] eq 'start') {
            $pos++;
            $chain_start = $tokens[$pos];
            print "CHAIN: got start note $chain_start\n" if $debug;
            $pos++;
        }
        elsif ($tokens[$pos] eq 'scale') {
            if (scalar keys %{$$chain{'notes'}} > 0) {
                die "cannot add scale to existing chain\n";
            }
            else {
                ($chain, $pos, $needlength) = &get_scale_chain($pos, $time);
                $needlength = ($needlength != 0);
                die "error building chain structure\n"
                    unless (defined $$chain{'notes'});
            }
        }
        else {
            ($chain, $pos) = &get_chain($pos);
            die "error building chain structure\n"
                unless (defined $$chain{'notes'});
        }
    }
    return $choices;
}

##
## Build a chain structure from individual notes.
## Return the chain and current position.
##

sub get_chain {
    my $pos = shift;
    my %chain;

    my $start_note;

    while (1) {
        if (!(defined($tokens[$pos]))) {
            die "unexpected EOF in chain block\n";
        }
        if ($tokens[$pos] =~ /^(rhythm|times)$/) {
            print "CHAIN: got start of rhythm block\n" if $debug;
            last;
        }
        else {
            $start_note = $tokens[$pos];
            $pos++;
            ($tokens[$pos] eq '[')
                || die "in chain block, after \`$tokens[$pos-1]':"
                    . "expected \`[' ; found $tokens[$pos]\n";
            $pos++;
            my $lcount = 0;
            if ($debug) {
                print "CHAIN: looking for links for $start_note\n";
            }
            while (my $token = $tokens[$pos]) {
                my $weights;

                if ($token eq ']') {
                    if ($debug) {
                        print "CHAIN: got last link for $start_note\n";
                    }

                    $weights = \@{$chain{'notes'}{$start_note}{'weights'}};
                    for my $i (1..@$weights-1) {
                        $$weights[$i] += $$weights[$i-1];
                    }

                    $pos++;
                    last;
                }
                elsif ($token =~ /^\d+$/) {
                    $chain{'notes'}{$start_note}{'weights'}[$lcount] = $token;
                }
                else {
                    die "in chain block, bad weighting value \`$token'\n";
                }
                $pos++;

                # if we get a bad note here it will be picked
                # up in get_note_bytes()
                $chain{'notes'}{$start_note}{'links'}[$lcount] = $tokens[$pos];
                $lcount++;
                $pos++;
            }
        }
    }
    return (\%chain, $pos);
}

##
## Build a chain structure from a scale.
## Return the chain and current position.
##

sub get_scale_chain {
    my ($pos, $time) = @_;

    my $chain;          # structure to return
    my $got_length = 0; # whether the note length is specified

    my $type = $tokens[$pos+1];
    my $range = $tokens[$pos+2];
    my $root;
    my $opts;

    if ($range =~ /^(\/\S+\/)?([a-g][-+]?)(\d+)(-(\d+))?$/) {
        $opts = $1;
        $root = $2;
        if (defined $5) {
            if ($3 > $5) {
                $root .= $5;
                $range = $3 - $5;
            }
            else {
                $root .= $3;
                $range = $5 - $3;
            }
        }
        else {
            $root .= $3;
            $range = 1;
        }
    }
    else {
        die 'bad scale range in chain block near'
            . " `@tokens[$pos..$pos+2]'\n";
    }

    if ($time) {
        unless ((defined $opts) and ($opts =~ /l\d+/)) { #FIXME
            warn 'Warning: no length specified for scale in chain '
                . 'block near ' . "`@tokens[$pos..$pos+2]'\n";
        }
    }

    $pos += 3;
    
    if ($debug) {
        print 'CHAIN_SCALE: calling get_scale('
            . "$type, $root, $range, $opts)\n";
    } 
    my $scale = &get_scale($type, $root, $range, $opts);

    # Parse the weighting matrix
    ($tokens[$pos] eq '[')
        or die "in chain block, after scale @tokens[$pos-2..$pos-1],"
            . "expected `['; found $tokens[$pos]\n";

    $pos++;

    my $max = @{$scale}-1;

    my %chain;
    my @extras;

    for my $i (0..$max) {
        for my $j (0..$max) {
            my $value = $tokens[$pos++];
            die "bad weighting value $tokens[$pos-1]\n"
                unless ($value =~ /^\d+$/);

            if ($value > 0) {
                push @{$$chain{'notes'}{$$scale[$i]}{'links'}}, $$scale[$j];
                push @{$$chain{'notes'}{$$scale[$i]}{'weights'}}, $value;
            }
        }
    }
    
    ($tokens[$pos] eq ']')
        or die "in chain block, expected closing `]' of scale"
            . " weighting matrix; found $tokens[$pos]\n";

    $pos++;

    print "CHAIN_SCALE: got end of weighting matrix\n" if ($debug);

    # add any extra notes to the chain
    while (1) {
        if ($tokens[$pos] =~ /^(rhythm|times)$/) {
            print "CHAIN_SCALE: got start of rhythm block\n" if ($debug);
            last;
        }
        elsif ($tokens[$pos] =~ /^(\/\S+\/)?[a-gr][-+=]?(\d+)?$/) {
            my $note = $tokens[$pos++];

            # add links from new note to existing notes
            # link to new note itself is last.

            ($tokens[$pos] eq '[')
                or die "in chain block, after $note"
                    . " expected weighting block (`['); found $tokens[$pos]\n";

            $pos++;

            my $max = scalar keys %{$$chain{'notes'}};

            my $ns = @{$scale}-1;
            my $ne = $ns + scalar @extras;
            
            for my $i (0..$max) {
                my $value = $tokens[$pos++];
                die "bad weighting value $tokens[$pos-1]\n"
                    unless ($value =~ /^\d+$/);

                if ($value > 0) {
                    if ($i <= $ns) {
                        push @{$$chain{'notes'}{$note}{'links'}}, $$scale[$i];
                    }
                    elsif ($i <= $ne) {
                        push @{$$chain{'notes'}{$note}{'links'}}, $extras[$i];
                    }
                    else {
                        push @{$$chain{'notes'}{$note}{'links'}}, $note;
                    }
                    push @{$$chain{'notes'}{$note}{'weights'}}, $value;
                }
            }
            
            ($tokens[$pos] eq ']')
                or die "in chain block, after $note expected end of"
                    . " weighting block; found $tokens[$pos]\n";
            
            $pos++;

            # add links from existing notes to new note

            ($tokens[$pos] eq '[')
                or die "in chain block, after $note expected 2nd "
                    . "weighting block (`['); found $tokens[$pos]\n";

            $pos++;

            $max--; # one less link as -->self already known

            for my $i (0..$max) {
                my $value = $tokens[$pos++];
                die "bad weighting value $tokens[$pos-1]\n"
                    unless ($value =~ /^\d+$/);

                if ($value > 0) {
                    if ($i <= $ns) {
                        push @{$$chain{'notes'}{$$scale[$i]}{'links'}}, $note;
                    }
                    elsif ($i <= $ne) {
                        push @{$$chain{'notes'}{$$scale[$i]}{'links'}},
                              $extras[$i];
                    }
                    else {
                        die "tried to add too many backward links"
                            . "while adding `$note' to chain\n";
                    }
                    push @{$$chain{'notes'}{$$scale[$i]}{'weights'}}, $value;
                }
            }

            ($tokens[$pos] eq ']')
                or die "in chain block, after $note expected end of"
                    . " 2nd weighting block (`]'); found $tokens[$pos]\n";

            print "CHAIN_SCALE: added note $note to chain\n" if $debug;

            push @extras, $note;

            $pos++;
        }
        else {
            die "bad token `$tokens[$pos]' in chain block"
                . " (expected note or `rhythm')\n";
        }
    }

    # make the weightings cumulative
    foreach my $note (keys %{$$chain{'notes'}}) {
        my $weights = \@{$$chain{'notes'}{$note}{'weights'}};
        for my $i (1..@{$weights}-1) {
            $$weights[$i] += $$weights[$i-1];
        }
    }

#    use Data::Dumper;
#    my $d = Data::Dumper->new([$chain]);
#    $d->Purity(1)->Terse(1)->Deepcopy(1);
#    print $d->Dump;
#    exit;
    
    return ($chain, $pos, $got_length);
}

##
## Parse and run a time limited rhythm block
##

sub get_closed_chain_tokens {
    my ($pos, $chain, $time, $chain_start) = @_;

    my $start_note;
    my $rcount = 0;
    my $choices; # tokens to return
    my $time_count;
    my $sequential;
    my $rejects = 0;
    my $max_rejects;

    # parse the rhythm block
    if ($tokens[$pos] eq '{') {
        if ($debug) {
            print "CHAIN: found sequential rhythm section\n";
        }
        $sequential = 1;
        $pos++;
        while (my $token = $tokens[$pos]) {
            if ($token eq '}') {
                if ($debug) {
                    print "CHAIN: got end of rhythm block\n";
                }
                $pos++;
                last;
            }
            push @{$$chain{'rhythm'}}, $token;
            $pos++;
        }
    }
    elsif ($tokens[$pos] eq '[') {
        print "CHAIN: found random rhythm section\n" if $debug;
        $pos++;
        my $rlinks = \@{$$chain{'rhythm'}{'links'}};
        my $rweights = \@{$$chain{'rhythm'}{'weights'}};
        while (my $token = $tokens[$pos]) {
            if ($token eq ']') {
                if ($debug) {
                    print "CHAIN: got end of rhythm block\n";
                }
                    
                for my $i (1..@{$rweights}-1) {
                    $$rweights[$i] += $$rweights[$i-1];
                }
                $pos++;
                last;
            }
            elsif ($token =~ /^\d+$/) {
                $$rweights[$rcount] = $token;
            }
            else {
                die "in chain block, bad rhythm weighting:"
                    . " $token\n";
            }
            $pos++;
            $token = $tokens[$pos];
            if ($token =~ /^(\d+:)?\d+$/) {
                $$rlinks[$rcount] = $token;
            }
            else {
                die "in chain block, bad time value: $token\n";
            }
            
            $pos++;
            $rcount++;
        }
    }
    else {
        die "in chain block, expecting \`{' or \`['"
            . " ; found \`$tokens[$pos]'\n";
    }

    # sanity check on rhythm
    if (!$sequential) {
        if ((!defined($$chain{'rhythm'}{'links'}[0]))
            || (!defined($$chain{'rhythm'}{'weights'}[0]))) {
            die "in chain block, rhythm section missing or incomplete\n";
        }
    }
    else {
        if (!defined($$chain{'rhythm'}[0])) {
            die "in chain block, rhythm section missing or incomplete\n";
        }
    }       

    # choose a start note
    if (defined($chain_start)) {
        $start_note = $chain_start;
    }
    else {
        my @allnotes = keys(%{$$chain{'notes'}});
        $start_note = $allnotes[rand(@allnotes-1)];
    }
    print "CHAIN: starting loop from note `$start_note'\n" if $debug;

    # loop thru the chain
    while (1) {
        my $weights = \@{$$chain{'notes'}{$start_note}{'weights'}};
        my $links = \@{$$chain{'notes'}{$start_note}{'links'}};

        my $choice;
        my $rtoken;
        my $length;
        my $i;

        # sanity check
        if ((!defined($$links[0])) || (!defined($$weights[0]))) {
            die "in chain block, $start_note is a dead end\n";
        }

        # start from chain_start if defined
        if (defined($chain_start)) {
            $choice = $start_note;
            undef $chain_start;
        }
        # else pick a random start note
        else {
            $choice = -1;
            my $rand = int(rand($$weights[@{$weights}-1]+1));
            for $i (0..@{$weights}-1) {
                if ($$weights[$i] >= $rand) {
                    $choice = $$links[$i];
                    last;
                }
            }
        }

        # make sure we picked a note
        if ($choice == -1) {next;}
        elsif ($debug) {
            print "CHAIN: chose $choice, checking length\n";
        }

        # get length and check if it fits
        if ($sequential) {
            $rtoken = $$chain{'rhythm'}[$rcount];
        }
        else {
            my $rlinks = \@{$$chain{'rhythm'}{'links'}};
            my $rweights = \@{$$chain{'rhythm'}{'weights'}};

            my $rand = int(rand($$rweights[@{$rweights}-1]+1));
            for $i (0..@{$rweights}-1) {
                if ($$rweights[$i] >= $rand) {
                    $rtoken = $$rlinks[$i];
                    last;
                }
            }
        }
        $length = &time_to_clicks($rtoken);
        if ($debug) {
            print "CHAIN: count,rcount,length,time = "
                . "$time_count ; $rcount ; $length ; $time\n";
        }
        if (($time_count + $length) <= $time) {
            print "CHAIN: chosen $choice\n" if ($debug);
            $choices .= " /l$rtoken/$choice";
            $time_count += $length;
            if ($sequential) {
                $rcount++;
                $rcount = 0 if ($rcount > @{$$chain{'rhythm'}}-1);
            }
            $start_note = $choice;
            if ($time_count == $time) {
                last;
            }
        }
        else {
            print "CHAIN: rejected $choice\n" if ($debug);
            $rejects++;
            if ($rejects >= $max_rejects) {
                # fill remaining time with a rest & give up
                $choice = &clicks_to_time($time - $time_count);
                $choices .= " /l$choice/r";
                last;
            }
            $$weights[$i] = $$weights[$i-1];
        }
    }
    return ($choices, $pos);
}

##
## Parse and run a non time limited chain rhythm block
## Return the chosen tokens and current position
##

sub get_open_chain_tokens {
    my ($pos, $chain, $chain_start) = @_;

    my $start_note; # note to start on
    my $choice;     # current choice
    my $choices;    # tokens to return
    
    # parse the rhythm tokens
    $pos++;

    ($tokens[$pos] eq '{') || die "after $tokens[$pos-1]:"
        . " expected \`{' ; found $_\n";
    print "CHAIN-OPEN: start of rhythm block\n" if $debug;
    $pos++;

    # choose a start note
    if (defined($chain_start)) {
        $start_note = $chain_start;
    }
    else {
        my @allnotes = keys(%{$$chain{'notes'}});
        $start_note = $allnotes[rand(@allnotes-1)];
    }

    while (1) {

        my $weights = \@{$$chain{'notes'}{$start_note}{'weights'}};
        my $links = \@{$$chain{'notes'}{$start_note}{'links'}};
                
        # sanity check
        if ((!defined($$links[0])) || (!defined($$weights[0]))) {
            die "in chain block, $start_note is a dead end\n";
        }
                
        # start from chain_start if defined
        if (defined($chain_start)) {
            $choice = $start_note;
            undef $chain_start;
        }

        if ($tokens[$pos] eq '}') {
            print "CHAIN-OPEN: got end of rhythm block\n"
                if ($debug);
            $pos++;
            last;
        }
        # pick a note if needed
        elsif ($tokens[$pos] =~
               /^(\/\S+\/)?(\d+(:\d+)?)(x(\d+))?$/) {
            my $opts = $1;
            my $len = $2;
            my $rpt = $5;

            $opts = '//' unless (defined $opts);
            if ($opts =~ /l\d+/) {
                warn "removing length from $tokens[$pos]"
                    . " in chain block\n";
                $opts =~ s/l\d+(:\d+)?//;
            }
                    
            $opts =~ s/^\//\/l$len/;

            $rpt = 1 unless ($rpt > 1);
            
            for (1..$rpt) {
                $choice = -1;
                        
                my $rand = int(rand($$weights[@{$weights}-1]+1));
                for my $i (0..@{$weights}-1) {
                    if ($$weights[$i] >= $rand) {
                        $choice = $$links[$i];
                        $start_note = $choice;
                        $choices .= ' ' . $opts . $choice;
                        
                        $weights = \@{$$chain{'notes'}
                                      {$start_note}{'weights'}};
                        $links = \@{$$chain{'notes'}
                                    {$start_note}{'links'}};
                        
                        if ((!defined($$links[0])) ||
                            (!defined($$weights[0]))) {
                            die "in chain block, $start_note"
                                . " is a dead end\n";
                        }
                        
                        last;
                    }
                }
            }               
            $pos++;
        }
        # otherwise pass the token through
        else {
            $tokens[$pos] =~ s/^_//;
            $choices .= ' ' . $tokens[$pos++];
        }
    }
    return ($choices, $pos);
}    

##
## compose some serial(ish) music (unfinished)
##

sub get_serial_tokens {
    my $pos = shift;

    my $time;    # length of output

    if ($tokens[$pos] =~ /^[-0]$/) {
        $time = 0;
    }
    elsif ($tokens[$pos] =~ /^(\d+)(:(\d+))?$/) {
        $time = &time_to_clicks($tokens[$pos]);
    }
    else {
        die "bad time value `$tokens[$pos] after \%serial\n";
    }

    $pos++;

    my $root;  # root note
    my $range; # mumber of octaves

    if ($tokens[$pos++] =~ /^([a-g][-+]?)(\d+)(-(\d+))?$/) {
        if (defined $4) {
            if ($4 > $2) {
                $range = $4 - $2;
                $root = $1 . $2;
            }
            elsif ($2 > $4) {
                $range = $2 - $4;
                $root = $1 . $4;
            }
        }
        else {
            $root = $1 . $2;
            $range = 1;
        }
    }

    ($tokens[$pos] eq '{') ||
        die "after \%serial $tokens[$pos-2] $tokens[$pos-1]\n";

    my $scale = &get_scale('chromatic', $root, $range);
    pop(@$scale) ; # lose the last note
    my @flags;

    # { style rhythm block
    if ($time == 0) {
        # copy code from g_t_c_t()
    }
    # [ style rhythm block
    elsif ($tokens[$pos] eq '[') {
        # copy code from g_chain_t()
    }
    # no rhythm block
    else {
        # copy code from g_t_c_t()
    }

    return undef;
}

#####################################
##                                 ##
## @@@SECTION: Utility subroutines ##
##                                 ##
#####################################

##
## return the size of a section of data
##
## @param 1 - the data
## @param 2 - flag 1 = return a variable length quantity
##                 0 = return a number
##

sub get_data_size {

    if ($debug) {
        print "get_data_size()\n";
    }

    my $data = shift;   # data we want the length of
    my $varlen = shift; # wether we want $size as a variable length quantity
    my $size;           # data size to return
    my @temp;           # tmp array

    $size = length $data;

    if ($debug) {
        print "data:\n@temp\n";
        print "data_size = $size\n";
    }
    if ($varlen) {
        $size = &get_delta_time($size);
    }
    else {
        $size = &get_four_bytes($size);
    }
    return $size;
}

##
## return bytes from int (for dtime)
##

sub get_delta_time {
    my $dtime = shift;   # delta time as an int
    my @bytes;           # array to hold the bytes
    my $result = $dtime; # result of division
    my $remainder;       # remainder after division
    my $i = 0;           # counter
    my $data;            # data to return


    if ($debug) {
        print "dtime=$dtime\n";
    }

    if ($dtime < 128) {
        $data = pack("C", $dtime);
    }
    else {
        # will need to reverse bytes after
        while (1) {
            $dtime = $result; # makes sense second time around :)
            if ($result < 1) {
                last;
            }
            else {
                $result = $dtime / 128;
                $bytes[$i] = $dtime % 128;
                if ($debug) {
                    print "\nres=$result ; rem=$bytes[$i]\n";
                }
                if ($i > 0) {
                    $bytes[$i] |= 0x80;
                }
                $i++;
            }
        }
        for ($i=0; $i<=@bytes-1; $i++) {
            $data = pack("C", $bytes[$i]) . $data;
        }
    }
    return $data;
}

##
## get the midi style denominator for the time sig
##

sub get_time_denom {
    my $sig_denom = shift; # denominator as an int
    my $denom;             # encoded denominator to return

    if ($sig_denom == 4) {
        $denom = 2;
    }
    elsif ($sig_denom == 8) {
        $denom = 3;
    }
    elsif ($sig_denom == 16) {
        $denom = 4;
    }
    elsif ($sig_denom == 32) {
        $denom = 5;
    }
    elsif ($sig_denom == 64) {
        $denom = 6;
    }
    return $denom;
}

##
## return the tempo in bytes (without delta time)
##

sub get_tempo_bytes {
    my $tempo = shift; # tempo
    $tempo = $header_info{'tempo'} unless defined $tempo;
    $tempo = 60000000 / $tempo;

    if ($debug) {
        print "tempo is $tempo\n";
    }

    return $midi_tempo . pack("C", 3) . &get_three_bytes($tempo);
}

##
## return the time signature in bytes (without delta time)
##

sub get_time_sig_bytes {
    my $time = shift;
    $time = $header_info{'time_sig'} unless defined $time;

    my $data = $midi_time_sig;
    if ($time =~ /([0-9]+)\/([0-9]+)/) {
        $data .= pack("CCCCC", 4, $1, &get_time_denom($2), 24, 8);
    }
    else {
        die "bad \$time_sig: $time\n";
    }
    return $data;
}


##
## convert int to three bytes
##

sub get_three_bytes {
    my $data;           # data to return
    my $number = shift; # number to encode
    my @bytes;          # encoded bytes

    $bytes[0] = $number / 0x10000;
    $number %= 0x10000;
    $bytes[1] = $number / 0x100;
    $number %= 0x100;
    $bytes[2] = $number;
    $data = pack("CCC", $bytes[0], $bytes[1], $bytes[2]);
    return $data;
}

##
## convert 32 bit integer to four bytes
##

sub get_four_bytes {
    my $number = shift; # number to encode
    my @bytes;          # encoded bytes
    my $data;           # data to return

    $bytes[0] = $number / 0x1000000; #16777216
    $number %= 0x1000000;
    $bytes[1] = $number / 0x10000; #65536
    $number %= 0x10000;
    $bytes[2] = $number / 0x100; #256
    $number %= 0x100;
    $bytes[3] = $number;
    $data = pack("CCCC", $bytes[0], $bytes[1], $bytes[2], $bytes[3]);
    return $data;
}

sub get_quoted_string {
    my $string = &get_next_token;
    if ($string =~ /^\"/) {
        my $quote_start = $line_refs[$current_token];
        my $quote_first = $string;
        while ($string !~ /\"$/) {
            my $token = &get_next_token;
            unless (defined $token) {
                die 'hit EOF while looking for end of quote'
                    . " starting with $quote_first at $quote_start\n";
            }
            $string .= " $token";
        }
        $string =~ s/^.(.*).$/$1/;
    }
    return $string;
}

##
## return note number for a note string.
##
## @param 1: The note token.
## @param 2: Flag (0=normal, 2=no strict).
##

sub note_to_int {
    my ($note, $flag) = @_;   # note string
    my ($name, $sharp);       # note name and sharp/flat character if present
    my $octave = 0;           # note octave
    my $int;                  # note number to return

    return &note_to_int_strict($note, $flag)
        if $strict_key and not (defined $flag and $flag == 2);

    if ($note =~ /([a-g])(\+|-)?([0-9])?$/) {
        $name = $1;
        $sharp = $2;
        if ($3) {
            $octave = $3;
            $old{'octave'} = $3;
        }
    }
    else {
        die "$line_refs[$current_token]: "
            . "bad note: $note\n";
    }
    if (!$octave) {
        $octave = $old{'octave'};
    }
    
    $int = 12 * $octave;
    if ($name =~ /^a$/i) {$int += 9;}
    elsif ($name =~ /^b$/i) {$int += 11;}
    elsif ($name =~ /^d$/i) {$int += 2;}
    elsif ($name =~ /^e$/i) {$int += 4;}
    elsif ($name =~ /^f$/i) {$int += 5;}
    elsif ($name =~ /^g$/i) {$int += 7;}
    if ($sharp eq '+') {
        $int++;
    }
    elsif ($sharp eq '-') {
        $int--;
    }
    print "NTI(): $note ; $int\n" if $debug;
    return $int;
}

##
## return note number for a note string with sharps and flats implied
## by the key
##
## @param 1: The note token.
## @param 2: Flag (0=normal, 1=no recurse).
## @return: The MIDI note number.
##

sub note_to_int_strict {
    my ($note, $flag) = @_;         # note string
    my ($name, $sharp);             # note name and sharp/flat token
    my $octave = 0;                 # note octave
    my $int;                        # note number to return
    my $key = $header_info{'key'};  # temporary copy of the key

    if ($note =~ /([a-g])(\+|-|=)?([0-9])?$/) {
        $name = $1;
        $sharp = $2;
        if ($3) {
            $octave = $3;
            $old{'octave'} = $3;
        }
    }
    else {
        die "$line_refs[$current_token]: "
            . "bad note: $note\n";
    }
    if (!$octave) {
        $octave = $old{'octave'};
    }
    
    # Fix for minor keys
    if ($key =~ s/m//) {
        $key = &relative_major("${key}m");
        print "NTIS($note, $key)\n" if $debug;
    }

    $int = 12 * $octave;
    if ($name =~ /^a$/i) {
        $int += 9;
        if ($key =~ /[eadg]-/i) {
            $int-- unless $sharp eq '=';
            if ($sharp eq '+') {
                $int += 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($key =~ /^b$|f\+/i) {
            $int++ unless $sharp eq '=';
            if ($sharp eq '-') {
                $int -= 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($sharp eq '+') {
            $int++;
        }
        elsif ($sharp eq '-') {
            $int--;
        }
    }
    elsif ($name =~ /^b$/i) {
        $int += 11;
        if ($key =~ /^f$|[beadg]-/i) {
            $int-- unless $sharp eq '=';
            if ($sharp eq '+') {
                $int += 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($sharp eq '+') {
            $int++;
        }
        elsif ($sharp eq '-') {
            $int--;
        }
    }
    elsif ($name =~ /^c$/i) {
        if ($key =~ /^[daeb]$|f\+/i) {
            $int++ unless $sharp eq '=';
            if ($sharp eq '-') {
                $int -= 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($key =~ /^g-$/i) {
            $int-- unless $sharp eq '=';
            if ($sharp eq '+') {
                $int += 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($sharp eq '+') {
            $int++;
        }
        elsif ($sharp eq '-') {
            $int--;
        }
    }
    elsif ($name =~ /^d$/i) {
        $int += 2;
        if ($key =~ /^[eb]$|f\+/i) {
            $int++ unless $sharp eq '=';
            if ($sharp eq '-') {
                $int -= 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($key =~ /[adg]-/i) {
            $int-- unless $sharp eq '=';
            if ($sharp eq '+') {
                $int += 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($sharp eq '+') {
            $int++;
        }
        elsif ($sharp eq '-') {
            $int--;
        }
    }
    elsif ($name =~ /^e$/i) {
        $int += 4;
        if ($key =~ /[beadg]-/i) {
            $int-- unless $sharp eq '=';
            if ($sharp eq '+') {
                $int += 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($key =~ /f\+/) {
            $int++ unless $sharp eq '=';
            if ($sharp eq '-') {
                $int -= 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($sharp eq '+') {
            $int++;
        }
        elsif ($sharp eq '-') {
            $int--;
        }
    }
    elsif ($name =~ /^f$/i) {
        $int += 5;
        if ($key =~ /^[gdaeb]$|f\+/i) {
            $int++ unless $sharp eq '=';
            if ($sharp eq '-') {
                $int -= 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($sharp eq '+') {
            $int++;
        }
        elsif ($sharp eq '-') {
            $int--;
        }
    }
    elsif ($name =~ /^g$/i) {
        $int += 7;
        if ($key =~ /^[aeb]$|f\+/i) {
            $int++ unless $sharp eq '=';
            if ($sharp eq '-') {
                $int -= 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($key =~ /[dg]-/i) {
            $int-- unless $sharp eq '=';
            if ($sharp eq '+') {
                $int += 2;
                warn "Warning: $line_refs[$current_token]: "
                    . "$name$sharp specified in key $header_info{'key'}\n";
            }
        }
        elsif ($sharp eq '+') {
            $int++;
        }
        elsif ($sharp eq '-') {
            $int--;
        }
    }

    if ($key =~ /c-/i) {$int--;}
    elsif ($key =~ /c\+/) {$int++;}

    # Fix the octave
    unless (defined $flag and $flag == 1) {
        my $root_int = $header_info{'key'};
        $root_int =~ s/m//i;
        $root_int .= $octave;
        $root_int = &note_to_int($root_int, 1);

        $int += 12 if $root_int > $int and $int >= 12 * $octave;

        print "NTIS(): $note ; $int\n" if $debug;
    }

    return $int;
}

##
## return the relative major of the given minor key.
##

sub relative_major {
    my $key = shift;

    die "$line_refs[$current_token]: "
        . "major key $key passed to sub relative_major()\n" if $key !~ /m/;

    &init_relative_majors unless defined $relative_majors;

    $key = $relative_majors->{"$key"};
    die "$line_refs[$current_token]: "
        . "cannot find relative major for key $key\n" unless defined $key;

    return $key;
}

##
## return a note string from a note number
##

sub int_to_note {
    my ($orig_int, $no_strict) = @_; # number to convert to note string
    my ($name, $octave);             # name and octave of note
    my $note;                        # note string to return
    my $int = $orig_int;             # copy of int which gets changed in
                                     #  the calculation

    return &int_to_note_strict($orig_int) if $strict_key and not $no_strict;

    $octave = int($int / 12);
    $int = $int % 12;
    if ($int == 11) {$name = 'b';}
    elsif ($int == 10) {$name = 'a+';}
    elsif ($int == 9) {$name = 'a';}
    elsif ($int == 8) {$name = 'g+';}
    elsif ($int == 7) {$name = 'g';}
    elsif ($int == 6) {$name = 'f+';}
    elsif ($int == 5) {$name = 'f';}
    elsif ($int == 4) {$name = 'e';}
    elsif ($int == 3) {$name = 'd+';}
    elsif ($int == 2) {$name = 'd';}
    elsif ($int == 1) {$name = 'd-';}
    else {$name = 'c';}

    $note = "$name$octave";
    print "ITN(): $orig_int ; $note\n" if $debug;
    return $note;
}

##
## return a note string from a note number with sharps and flats implied
## by the key
##

sub int_to_note_strict {
    my $orig_int = shift; # number to convert to note string
    my ($name, $octave);  # name and octave of note
    my $note;             # note string to return
    my $int = $orig_int;  # copy of int which gets changed in the calculation

    $octave = int($int / 12);
    $int = $int % 12;
    if ($int == 11) {
        $name = 'b';
        if ($header_info{'key'} =~ /g-/i) {
            $name = 'c-';
        }
    }
    elsif ($int == 10) {
        $name = 'a+';
        if ($header_info{'key'} =~ /^f$|[beadg]-/i) {
            $name = 'b-';
        }
    }
    elsif ($int == 9) {
        $name = 'a';
    }
    elsif ($int == 8) {
        $name = 'g+';
        if ($header_info{'key'} =~ /[eadg]-/i) {
            $name = 'a-';
        }
    }
    elsif ($int == 7) {
        $name = 'g';
    }
    elsif ($int == 6) {
        $name = 'f+';
        if ($header_info{'key'} =~ /[gd]-/i) {
            $name = 'g-';
        }
    }
    elsif ($int == 5) {
        $name = 'f';
        if ($header_info{'key'} =~ /f\+/i) {
            $name = 'e+';
        }
    }
    elsif ($int == 4) {
        $name = 'e';
    }
    elsif ($int == 3) {
        $name = 'd+';
        if ($header_info{'key'} =~ /[beadg]-/i) {
            $name = 'e-';
        }
    }
    elsif ($int == 2) {
        $name = 'd';
    }
    elsif ($int == 1) {
        $name = 'c+';
        if ($header_info{'key'} =~ /[adg]-/i) {
            $name = 'd-';
        }
    }
    else {
        $name = 'c';
    }

    $note = "$name$octave";
    print "ITNS(): $orig_int ; $note\n" if $debug;
    return $note;
}

##
## return time in midi clicks given n:d
##

sub time_to_clicks {
    my $time = shift; # time in n:d
    my $clicks;       # No. of clicks, to return
    my $tmp;          # temp var

    if ($debug) {
        print "time_to_clicks($time)\n";
    }

    if ($time =~ /((\d+(\.\d+)?):)?([0-9]+)/) {
        if ($1) {
            $tmp = $2;
        }
        else {
            $tmp = 1;
        }
        $clicks = ($header_info{'ticksperquarter'} * 4 * $tmp) / $4;
    }
    else {
        print "TIME2CLICKS: error\n" if $debug;
        $clicks = -1;
    }
    print "time_to_clicks: returning $clicks\n" if $debug;
    return $clicks;
}

##
## return an `n:d' format time from a number of clicks
##

sub clicks_to_time {
    my $clicks = shift; # time in clicks
    my $time;           # n:d value to return
    my $res = 256;      # resolution to work to (256 => 1/256th note)

    $time = ($clicks * ($res / 4)) / $header_info{'ticksperquarter'};
    if ($res / $time == int($res / $time)) {
        $time = $res / $time;
    }
    else {
        foreach my $i (2, 3, 5, 7, 11, 13, 17, 19) {
            while (($time / $i == int($time / $i))
                and ($res / $i == int($res / $i))) {

                $time /= $i;
                $res /= $i;
            }
        }
        $time = "$time:$res";
    }
    return $time;
}

##
## return a random value from a range string `n-m'
## or return unchanged arg if it is a single value
##

sub get_range_value {
    $_ = shift;

    if (/^(\d+)-(\d+)$/) {
        my $val = $1 + int(rand($2-$1));
        return $val;
    }
    return $_;
}

##
## Print an error message with appropriate line reference and qoute,
## exiting unless the caller signals that this is only a warning.
##
## Not used and won't work without changes to other line_refs code.
##
## @param 1: The error message.
## @param 2: True if this is only a warning, otherwise we exit.
##

sub midge_error {
    my $point = $current_token;
    my $line_ref = undef;
    my @real_quote;
    my @gen_quote;

    while (1) {
        last if $point < 0;
        last if defined $line_ref and @real_quote >= $error_quote_level;

        if (defined $line_refs[$point]) {
            $line_ref = $line_refs[$point] unless defined $line_ref;
            push @real_quote, $tokens[$line_ref];
        }
        else {
            push @gen_quote, $tokens[$point]
                if @gen_quote < $error_quote_level;
        }

        $point--;
    }

    my $real_quote = undef;
    $real_quote = join ' ', @real_quote if @real_quote;

    my $gen_quote = undef;
    $gen_quote = join ' ', @gen_quote if @gen_quote;

    my $msg = undef;
    if (defined $line_ref) {
        $msg = "$line_ref: $_[0]\nnear ";

        if (defined $gen_quote) {
            $msg .= "`$gen_quote' \ngenerated from `$real_quote'";
        }
        elsif (defined $real_quote) {
            $msg .= "`$real_quote'";
        }
        else {
            $msg .= '(unable to find source)';
        }
    }
    else {
        $msg = "Error: $_[0]\n(unable to find source)";
    }

    warn $msg if defined $_[1] and $_[1];
    die $msg;
}

##########################################
##                                      ##
## @@@SECTION: Initialising subroutines ##
##                                      ##
##########################################

##
## seed the random number generator if needed
##

sub init_rand {
    if (defined $seed) {
        srand $seed;
    }
    elsif ($] < 5.004) {
        srand;
    }
}

##
## try to load Safe.pm
##

sub init_sandbox {
    unless ($unsafe) {
        eval " use Safe; ";
        unless ($@) {
            $sandbox = Safe->new;
            $sandbox->permit_only(qw(:base_core :base_math :base_mem));
        }
    }
}

##
## set up scale data
##

sub init_scales {
    %scales = (
               major => [2,2,1,2,2,2,1],
               minor => [2,1,2,2,1,2,2],
               minor_harmonic => [2,1,2,2,1,3,1],
               minor_jazz => [2,1,2,2,2,2,1],      # =ascending melodic minor
               bebop => [2,2,1,2,1,1,2,1],
               bebop_dorian => [2,1,1,1,2,2,1,2],
               bebop_mixolydian => [2,2,1,2,2,1,1,1],
               ionian => [2,2,1,2,2,2,1],          # =major
               dorian => [2,1,2,2,2,1,2],
               phrygian => [1,2,2,2,1,2,2],
               lydian => [2,2,2,1,2,2,1],
               mixolydian => [2,2,1,2,2,1,2],
               aeolian => [2,1,2,2,1,2,2],
               locrian => [1,2,2,1,2,2,2],
               minor_pentatonic => [3,2,2,3,2],
               major_pentatonic => [2,2,3,2,3],
               chromatic => [1,1,1,1,1,1,1,1,1,1,1,1],
               whole_tone => [2,2,2,2,2,2],
               arabian => [2,2,1,1,2,2,2],
               spanish => [1,3,1,2,1,2,2],
               gypsy => [1,3,1,2,1,3,1],
               );
}

##
## set up patch list
##

sub init_patch_list {
    $patches{'piano_grand_ac'} = 1;
    $patches{'piano_br'} = 2;
    $patches{'piano_grand_el'} = 3;
    $patches{'piano_ht'} = 4;
    $patches{'piano_el_1'} = 5;
    $patches{'piano_el_2'} = 6;
    $patches{'harpsichord'} = 7;
    $patches{'clavinet'} = 8;
    $patches{'celesta'} = 9;
    $patches{'glockenspiel'} = 10;
    $patches{'music_box'} = 11;
    $patches{'vibraphone'} = 12;
    $patches{'marimba'} = 13;
    $patches{'xylophone'} = 14;
    $patches{'tubular_bells'} = 15;
    $patches{'dulcimer'} = 16;
    $patches{'organ_dbar'} = 17;
    $patches{'organ_perc'} = 18;
    $patches{'organ_rock'} = 19;
    $patches{'organ_church'} = 20;
    $patches{'organ_reed'} = 21;
    $patches{'accordian'} = 22;
    $patches{'harmonica'} = 23;
    $patches{'accordian_tango'} = 24;
    $patches{'guitar_nylon'} = 25;
    $patches{'guitar_steel'} = 26;
    $patches{'guitar_jazz'} = 27;
    $patches{'guitar_clean'} = 28;
    $patches{'guitar_muted'} = 29;
    $patches{'guitar_od'} = 30;
    $patches{'guitar_dist'} = 31;
    $patches{'guitar_harm'} = 32;
    $patches{'bass_ac'} = 33;
    $patches{'bass_fg'} = 34;
    $patches{'bass_pick'} = 35;
    $patches{'bass_fless'} = 36;
    $patches{'bass_slap_1'} = 37;
    $patches{'bass_slap_2'} = 38;
    $patches{'bass_syn_1'} = 39;
    $patches{'bass_syn_2'} = 40;
    $patches{'violin'} = 41;
    $patches{'viola'} = 42;
    $patches{'cello'} = 43;
    $patches{'contrabass'} = 44;
    $patches{'str_trem'} = 45;
    $patches{'str_pizz'} = 46;
    $patches{'str_orch'} = 47;
    $patches{'timpani'} = 48;
    $patches{'str_ens_1'} = 49;
    $patches{'str_ens_2'} = 50;
    $patches{'str_syn_1'} = 51;
    $patches{'str_syn_2'} = 52;
    $patches{'choir_aahs'} = 53;
    $patches{'voice_oohs'} = 54;
    $patches{'voice_syn'} = 55;
    $patches{'orch_hit'} = 56;
    $patches{'trumpet'} = 57;
    $patches{'trombone'} = 58;
    $patches{'tuba'} = 59;
    $patches{'trumpet_muted'} = 60;
    $patches{'horn_fr'} = 61;
    $patches{'brass'} = 62;
    $patches{'brass_syn_1'} = 63;
    $patches{'brass_syn_2'} = 64;
    $patches{'sax_sop'} = 65;
    $patches{'sax_alt'} = 66;
    $patches{'sax_ten'} = 67;
    $patches{'sax_bar'} = 68;
    $patches{'oboe'} = 69;
    $patches{'horn_en'} = 70;
    $patches{'bassoon'} = 71;
    $patches{'clarinet'} = 72;
    $patches{'piccolo'} = 73;
    $patches{'flute'} = 74;
    $patches{'recorder'} = 75;
    $patches{'flute_pan'} = 76;
    $patches{'bottle'} = 77;
    $patches{'skakuhachi'} = 78;
    $patches{'whistle'} = 79;
    $patches{'ocarina'} = 80;
    $patches{'lead_sq'} = 81;
    $patches{'lead_saw'} = 82;
    $patches{'lead_calliope'} = 83;
    $patches{'lead_chiff'} = 84;
    $patches{'lead_charang'} = 85;
    $patches{'lead_voice'} = 86;
    $patches{'lead_fifth'} = 87;
    $patches{'lead_basslead'} = 88;
    $patches{'pad_new_age'} = 89;
    $patches{'pad_warm'} = 90;
    $patches{'polysynth'} = 91;
    $patches{'pad_choir'} = 92;
    $patches{'pad_bowed'} = 93;
    $patches{'pad_metal'} = 94;
    $patches{'pad_halo'} = 95;
    $patches{'pad_sweep'} = 96;
    $patches{'fx_rain'} = 97;
    $patches{'fx_strack'} = 98;
    $patches{'fx_crystal'} = 99;
    $patches{'fx_atmos'} = 100;
    $patches{'fx_bright'} = 101;
    $patches{'fx_goblin'} = 102;
    $patches{'fx_echo'} = 103;
    $patches{'fx_scifi'} = 104;
    $patches{'sitar'} = 105;
    $patches{'banjo'} = 106;
    $patches{'shamisen'} = 107;
    $patches{'koto'} = 108;
    $patches{'kalimba'} = 109;
    $patches{'bagpipe'} = 110;
    $patches{'fiddle'} = 111;
    $patches{'shanai'} = 112;
    $patches{'bell_tinkle'} = 113;
    $patches{'agogo'} = 114;
    $patches{'drum_steel'} = 115;
    $patches{'woodblock'} = 116;
    $patches{'drum_taiko'} = 117;
    $patches{'tom_melodic'} = 118;
    $patches{'drum_syn'} = 119;
    $patches{'cymbal_rev'} = 120;
    $patches{'fx_fret'} = 121;
    $patches{'fx_breath'} = 122;
    $patches{'fx_sea'} = 123;
    $patches{'fx_tweet'} = 124;
    $patches{'fx_phone'} = 125;
    $patches{'fx_copter'} = 126;
    $patches{'fx_gun'} = 128;
}

##
## set up drum list
##

sub init_drum_list {
    $drums{'bd_ac'} = "b2";
    $drums{'bd'} = "c3";
    $drums{'stick'} = "c+3";
    $drums{'sd_ac'} = "d3";
    $drums{'clap'} = "d+3";
    $drums{'sd_el'} = "e3";
    $drums{'ftom_l'} = "f3";
    $drums{'hh_c'} = "f+3";
    $drums{'ftom_h'} = "g3";
    $drums{'hh_p'} = "g+3";
    $drums{'tom_l'} = "a3";
    $drums{'hh_o'} = "a+3";
    $drums{'tom_lm'} = "b3";
    $drums{'tom_hm'} = "c4";
    $drums{'cym_crash'} = "c+4";
    $drums{'tom_h'} = "d4";
    $drums{'cym_ride'} = "d+4";
    $drums{'cym_chinese'} = "e4";
    $drums{'ride_bell'} = "f4";
    $drums{'tamb'} = "f+4";
    $drums{'cym_splash'} = "g4";
    $drums{'cowbell'} = "g+4";
    $drums{'cym_crash_2'} = "a4";
    $drums{'vibraslap'} = "a+4";
    $drums{'cym_ride_2'} = "b4";
    $drums{'bongo_h'} = "c5";
    $drums{'bongo_l'} = "c+5";
    $drums{'conga_h_mute'} = "d5";
    $drums{'conga_h_open'} = "d+5";
    $drums{'conga_l'} = "e5";
    $drums{'timbale_h'} = "f5";
    $drums{'timbale_l'} = "f+5";
    $drums{'agogo_h'} = "g5";
    $drums{'agogo_l'} = "g+5";
    $drums{'cabasa'} = "a5";
    $drums{'maracas'} = "a+5";
    $drums{'whistle_sh'} = "b5";
    $drums{'whistle_lg'} = "c6";
    $drums{'guiro_sh'} = "c+6";
    $drums{'guiro_lg'} = "d6";
    $drums{'claves'} = "d+6";
    $drums{'wood_h'} = "e6";
    $drums{'wood_l'} = "f6";
    $drums{'cuica_mute'} = "f+6";
    $drums{'cuica_open'} = "g6";
    $drums{'tri_mute'} = "g+6";
    $drums{'tri_open'} = "a6";
}

##
## Setup the hash used to lookup relative majors.
##

sub init_relative_majors {
    $relative_majors = { 'am' => 'c',
                         'em' => 'g',
                         'bm' => 'd',
                         'fm' => 'a-',
                         'cm' => 'e-',
                         'gm' => 'b-',
                         'dm' => 'f',
                         'f+m' => 'a',
                         'g+m' => 'c-',
                         'd+m' => 'g-',
                         'a+m' => 'c+',
                         'b+m' => 'd+',
                         'c+m' => 'e',
                         'e+m' => 'g+',
                         'd-m' => 'e',
                         'a-m' => 'b',
                         'e-m' => 'f+',
                         'b-m' => 'd-',
                         'c-m' => 'd',
                         'f-m' => 'g',
                         'g-m' => 'a',
                     };
}

###################################################
##                                               ##
## @@@SECTION: Option / Info related subroutines ##
##                                               ##
###################################################

##
## parse the command line options
##

sub get_options {

    my $i = 0;

    while ($i <= @ARGV-1) {
        if ($ARGV[$i] =~ /^--(version|warranty|about)$/) {
            &print_prog_info;
            exit;
        }
        elsif ($ARGV[$i] =~ /^(-h|--help)$/) {
            &print_help_info;
            exit;
        }
        elsif ($ARGV[$i] =~ /^(-v|--verbose)$/) {
            $verbose = 1;
        }
        elsif ($ARGV[$i] =~ /^(-d|--debug)$/) {
            $debug = 1;
        }
        elsif ($ARGV[$i] =~ /^(-q|--quiet)$/) {
            $quiet = 1;
        }
        elsif ($ARGV[$i] =~ /^(-t|--tempo)$/) {
            $tempo = $ARGV[$i+1]
                || die "missing tempo value after `$ARGV[$i]'\n";
            $i++;
        }
        elsif ($ARGV[$i] =~ /^(-b|--bend-steps)$/) {
            $bend_steps = $ARGV[++$i];
            die "bend-steps must be an integer > 0\n"
                unless $bend_steps =~ /^\d+$/ and $bend_steps > 0;
        }
        elsif ($ARGV[$i] =~ /^(-c|--check)$/) {
            $check_only = 1;
        }
        elsif ($ARGV[$i] eq '--unsafe') {
            $unsafe = 1;
        }
        elsif ($ARGV[$i] =~ /^(-u|--unroll-loops)$/) {
            $unroll_loops = 2;
        }
        elsif ($ARGV[$i] =~ /^(-U|--no-unroll-save)$/) {
            $unroll_save = 0;
        }
        elsif ($ARGV[$i] =~ /^(-R|--no-reset)$/) {
            $do_reset = 0;
        }
        elsif ($ARGV[$i] =~ /^(-o|--outfile)$/) {
            $outfile = $ARGV[$i+1]
                || die "missing filename after `$ARGV[$i]'\n";
            $i++;
        }
        elsif ($ARGV[$i] =~ /^(-s|--seed)$/) {
            $seed = $ARGV[$i+1]
                || die "missing number after `$ARGV[$i]'\n";
            $i++;
        }
        elsif ($ARGV[$i] =~ /^(-S|--show-scale)$/) {
            &init_scales;
            &show_scale(@ARGV[$i+1,$i+2]);
            exit;
        }
        elsif ($ARGV[$i] =~ /^(-I|--include)$/) {
            unshift @include_paths, split /[,:]/, $ARGV[$i+1];
            $i++;
        }
        elsif ($ARGV[$i] =~ /^-([a-zA-Z]{2})/) {
            @ARGV = (@ARGV[0..$i],
                     map($_ = "-$_", split(//, $1)),
                     @ARGV[$i+1..@ARGV-1]);
        }
        elsif ($ARGV[$i] =~ /^-/) {
            die "$ARGV[$i]: unknown option, use --help for help\n";
        }
        elsif (defined $infile) {
            die "too many arguments, use --help for help\n";
        }
        else {
            $infile = $ARGV[$i];
        }
        $i++;
    }
    
    if ($quiet) {
        if (($verbose) || ($debug)) {
            die "`-q' doesn't make sense with `-v' or `-d'\n";
        }
    }
    if ($debug) {
        $verbose = 1;
    }
    if (!$outfile) {
        if (defined $infile) {
            $_ = $infile;
            s/.*\///;
            s/(\.mg)?$/.mid/;
            $outfile = $_;
        }
        else {
            $outfile = "a.out.mid";
        }
    }
    if ($unroll_loops) {
        $_ = $outfile;
        s/(\.mid)?$/.long.mg/;
        $source_outfile = $_;
    }
    if ($debug) {
        print "options:";
        if ($verbose) {
            print " verbose";
        }
        if ($debug) {
            print " debug";
        }
        if ($quiet) {
            print " quiet";
        }
        if ($unroll_loops) {
            print " unroll-loops";
        }
        if ($tempo) {
            print " tempo=$tempo";
        }
        if (defined $infile) {
            print " in=$infile";
        }
        else {
            print " in=stdin";
        }
        print " out=$outfile\n";
    }
}

##
## print information about the program
##

sub print_prog_info {
    print "$progname version $version Copyright (C) $year $author\n";
    print "$progname comes with ABSOLUTELY NO WARRANTY\n";
    print "This is free software, and you are welcome to redistribute\n";
    print "it under the terms of the GNU General Public License\n";
}

##
## print out a help message
##

sub print_help_info {
    print <<EOF
usage: midge [options] [infile] 
                                
options:
   -h or --help
       Display this help text.
   --version or --warranty or --about
       Show version/license info.
   -q or --quiet                
       Suppress output.  
   -v or --verbose              
       Produce verbose output.
   -d or --debug                
       Produce debugging output.
   -o file or --outfile file    
       Direct output to file.
   -c or --check
       Check input only; no midi output.
   -u or --unroll-loops
       Unroll repeat blocks before parsing and save the unrolled
       source to a new file. Should be set automatically if needed.
   -U or --no-unroll-save
       Do not save unrolled source to file.
   -R or --no-reset
       Do not insert `reset all controllers' events at start of tracks.
   -t bpm or --tempo bpm
       Set tempo to bpm beats per minute, overriding value in inupt file.
   -b steps or --bend-steps steps
       Set the number of steps per quarter note for the simple bend syntax.
   --unsafe
       Do not use Safe.pm to run Perl code from %eval blocks.
   -s number or --seed number
       Use `number' as random seed.
   -S [scale [root]] or --show-scale [scale [root]]
       List notes in scale starting from root. If root is omitted c4 is
       used. If scale is omitted, a list of suported scales is shown.
   -I path or --include path
       Prepend `path' to include paths. Can be specified multiple times
       or `path' can be a list separated by colons or commas.
   infile                       
       Read input from `infile'.

   See the man page and examples for details of the input language
EOF
}

##
## show scale notes or list supported scales
##

sub show_scale {
    my ($type, $root) = @_;

    if (defined $type) {
        $root = 'c4' unless (defined $root);
        $root .= '4' unless ($root =~ /\d+$/);
        my $scale = &get_scale($type, $root);

        local $, = ' ';
        printf "$root $type has %d notes:\n", scalar @$scale;
        print @$scale, "\n";
    }
    else {
        print "supported scales:\n";
        my $col = 0;
        foreach (sort(keys(%scales))) {
            print ', ' unless ($col == 0);
            $col += length($_) + 2;
            print;
            if ($col > 64) {
                print ",\n";
                $col = 0;
            }
        }
        print "\n";
    }
}
