use strict;

###########################################################################
##
## midi2mg - convert a midi file to midge text format
##
## usage: midi2mg [ options ] midi_file
##
##  `--help' switch gives a 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
##
###########################################################################

eval "use MIDI";
if ($@) {
    print <<EOF;
    You don't appear to have the MIDI modules installed.

Your Perl said:

$@

You can install them easily by typing `perl -MCPAN -e shell'
at your prompt (you will need to answer a few questions if
you haven't used CPAN before) and then typing `install MIDI'
at the cpan> prompt.

To RTFM first, type `perldoc CPAN' or visit www.cpan.org
EOF

    exit 1;
}

my $mg_file;
my $midi_file;

my @tokens;
my $last_event;
my $current_channel;
my $current_track = 0;
my $track_list;
my @track_list;
my $track_ignore_list;
my @track_ignore_list;
my $outfile_specified = 0;

my $progress_length = 30;

my $quiet = 0;
my $verbose = 0;
my $fix_rs = 0;
my $ctt_do_factorise = 1;
my $ignore_wrong_track = 0;
$| = 1;
$SIG{'PIPE'} = sub { 1; };

while (my $arg = shift) {
    if ($arg =~ /^(-o|--outfile)$/) {
        $mg_file = shift;
        $quiet = 1 if $mg_file eq '-' and not $verbose;
        die "missing output file after $arg\n" unless defined $mg_file;
        $outfile_specified = 1;
    }
    elsif ($arg =~ /^(-w|--ignore-wrong-track)$/) {
        $ignore_wrong_track = 1;
    }
    elsif ($arg =~ /^(-F|--no-factorise)$/) {
        $ctt_do_factorise = 0;
    }
    elsif ($arg =~ /^(-f|--fix-rs)$/) {
        $fix_rs = 1;
    }
    elsif ($arg =~ /^(-N|--exclude-tracks)$/) {
        if (defined $track_list) {
            die "Can't use both `tracks' and `ignore-tracks' together\n";
        }
        $track_ignore_list = shift;
        die "expected list of numbers after $arg\n"
            unless $track_ignore_list =~ /^(\d+,?)+$/;
        @track_ignore_list = split ',', $track_ignore_list;
    }
    elsif ($arg =~ /^(-n|--include-tracks)$/) {
        if (defined $track_ignore_list) {
            die "Can't use both `tracks' and `ignore-tracks' together\n";
        }
        $track_list = shift;
        die "expected list of numbers after $arg\n"
            unless $track_list =~ /^(\d+,?)+$/;
        @track_list = split ',', $track_list;
    }
    elsif ($arg =~ /^(-v|--verbose)$/) {
        die "can't be verbose AND quiet\n" if $quiet;
        $verbose = 1;
    }
    elsif ($arg =~ /^(-q|--quiet)$/) {
        die "can't be quiet AND verbose\n" if $verbose;
        $quiet = 1;
    }
    elsif ($arg =~ /^(-h|--help)$/) {
        print <<EOF;
usage: midi2mg [ options ] midi_file

options:
   -h or --help
       Display this help text
   -v or --verbose
       Print verbose messages to stdout
   -q or --quiet
       Quiet. No stdout.
   -o file or --outfile file
       Write output to `file'. Otherwise file.mid -> file.mg
       Outputs to stdout if filename is `-'. When outputting
       to stdout quiet mode is automatically set unless verbose
       mode is set earlier on the command line.
   -w or --ignore-wrong-track
       Ignore MIDI events on the wrong channel instead of exiting.
   -n or --include-tracks i[,j...]
       Only convert the tracks in the comma separated list, with
       track numbers starting from 1.
   -N or --exclude-tracks i[,j...]
       As `-n' but excludes the listed tracks
   -F or --no-factorise
       Do not factorise time values.
EOF
        exit 0;
    }
    elsif ($arg =~ /^-([a-zA-Z]{2})/) {
        unshift @ARGV, map($_ = "-$_", split(//, $1));
        }
    elsif ($arg =~ /^-/) {
        die "unknown option `$arg'\n";
    }
    else {
        die "too many arguments\n" if defined $midi_file;
        $midi_file = $arg;
    }
}

die "no midi file specified\n" unless defined $midi_file;

unless (defined $mg_file) {
    $mg_file = $midi_file;
    $mg_file =~ s/^.*\///;
    $mg_file =~ s/(\.midi?)?$/.mg/;
}

if ($verbose) {
        print "Reading MIDI file $midi_file... ";
}

my $opus = MIDI::Opus->new({ 'from_file' => $midi_file })
    or die "$midi_file: $!\n";

die "\nCan't handle format 0 midi files\n" if $opus->format == 0;

print "done\n" if $verbose;

my $now = localtime;

my $resolution = $opus->ticks;
print "resolution = $resolution\n" if $verbose;

my $tempo;
my $time_sig;
my $key;
my $title;

# get a list of tracks
my @tracks = $opus->tracks;

if (defined $track_list) {
    my @newtracks;
    foreach my $index (@track_list) {
        $newtracks[@newtracks] = $tracks[$index - 1] unless $index > @tracks;
    }

    die "no valid tracks specified in include list\n" if @newtracks == 0;
    @tracks = @newtracks;
}
elsif (defined $track_ignore_list) {
    my @newtracks;
    for my $i (0..@tracks - 1) {
        $newtracks[@newtracks] = $tracks[$i]
            unless grep $_ == $i + 1, @track_ignore_list;
    }
    die "all valid tracks excluded\n" if @newtracks == 0;
    @tracks = @newtracks;
}

my $track_num = 0;
foreach my $track (@tracks) {
    $track_num++;
    printf("Track $track_num of %s:\n", scalar @tracks) if $verbose;
    my @track_tokens;
    my @events = $track->events;
    if (not $fix_rs) {
        if (grep $_->[0] eq 'note_on', @events
             and not grep $_->[0] eq 'note_off', @events) {

            print " looks like a running status file\n" if $verbose;
            $fix_rs = 1;
        }
    }

    $current_track++;
    undef $current_channel;
    my $instrument;
        my $track_name;
        my $count = 1;

    print " parsing events...\n" if $verbose;
    foreach my $event (@events) {
        if ($event->[0] eq 'instrument_name') {
            $instrument = $event->[2];
            next;
        }
        elsif ($event->[0] eq 'track_name') {
            $track_name = $event->[2];
            next;
        }

		my $tokens = &get_event_string($event);
		next unless defined $tokens;
        my @event_tokens = split ' ', $tokens;
        @track_tokens = (@track_tokens, @event_tokens)
            unless $event_tokens[0] eq '$ctrl' and
               $event_tokens[1] eq '121,0' and
               @track_tokens == 0;

        if ($verbose) {
            my $pg = int(($count * $progress_length) / @events);
            my $pg_pc = int(($count * 100) / @events);
            my $pg_msg = sprintf("  event: %d/%d [$pg_pc%%] <[",
                                 $count, scalar @events);

            $pg_msg .= '#' x $pg;
            $pg_msg .= '=' x ($progress_length - $pg);
            $pg_msg .= "]>";
            print "$pg_msg\r";
            $count++;
        }
    }

    if ($verbose) {
        print "\r";
        print " " x 79;
        print "\r";
        printf("  parsed %s events\n", scalar @events);
    }

    if ((not defined $current_channel) or
        (@events < 8 and not grep $_->[0] eq 'note_on', @events)) {

        my $i;
        my $keep = 0;

        for ($i=0; $i<@track_tokens; $i++) {
            if ($track_tokens[$i] eq '$tempo') {
#               if (defined $tempo) {
#                   $tempo = '';
#                   $keep = 1;
#                   last;
#               }
                $tempo = $track_tokens[$i+1] unless defined $tempo;
                $i++;
            }
            elsif ($track_tokens[$i] eq '$time_sig') {
#               if (defined $time_sig) {
#                   $time_sig = '';
#                   $keep = 1;
#                   last;
#               }
                $time_sig = $track_tokens[$i+1] unless defined $time_sig;
                $i++;
            }
            elsif ($track_tokens[$i] eq '$key') {
#               if (defined $key) {
#                   $key = '';
#                   $keep = 1;
#                   last;
#               }
                $key = $track_tokens[$i+1] unless defined $key;
                $i++;
            }
            elsif ($track_tokens[$i] eq '$marker') {
                $keep = 1;
                last;
            }
        }
                
        if (not defined $title) {
            if (defined $track_name) {
                $title = $track_name;
                print " ignoring instrument name\n" if defined $instrument;
            }
            elsif (defined $instrument) {
                $title = $instrument;
            }
            elsif ((my $event) = grep $_->[0] eq 'text_event', @events) {
                $title = $event->[2];
            }
        }

        my $tempos = grep /^\$tempo$/, @track_tokens;
        my $sigs = grep /^\$time_sig$/, @track_tokens;
        my $keys = grep /^\$key$/, @track_tokens;

        if ($tempos > 1 or $sigs > 1 or $keys > 1 or $keep) {
            $keep = 1;
            if (defined $instrument) {
                $instrument .= " (tempo track)";
            }
            else {
                $instrument = "tempo track";
            }

            if (defined $tempo and
                $track_tokens[0] eq '$tempo' and
                $track_tokens[1] eq $tempo) {
                @track_tokens = @track_tokens[2..@track_tokens-1];
            }

            if (defined $time_sig and
                $track_tokens[0] eq '$time_sig' and
                $track_tokens[1] eq $time_sig) {
                @track_tokens = @track_tokens[2..@track_tokens-1];
            }

            if (defined $key and
                $track_tokens[0] eq '$key' and
                $track_tokens[1] eq $key) {
                @track_tokens = @track_tokens[2..@track_tokens-1];
            }
        }

        if ($keep) {
            @track_tokens = (@track_tokens, '$track_type', 'tempo');
            $current_channel = 15;
        }
        else {
            print " removing track as no notes found (probably tempo track)\n"
                if $verbose;
            next;
        }
    }

    if (not defined $instrument) {
        $instrument = $track_name if defined $track_name;
    }

    if (defined $title) {
        $title =~ s/\"//g;
        $title = '"' . $title . '"';
    }

    if (defined $instrument) {
        $instrument =~ s/\"//g;
    }

    print " merging notes... " if $verbose;
    if ($fix_rs) {
        @track_tokens = @{&fix_running_status(\@track_tokens)};
    }
    else {
        @track_tokens = @{&merge_note_tokens(\@track_tokens)};
    }
    print "done\n simplifying note options... " if $verbose;
    @track_tokens = @{&simplify_note_options(\@track_tokens)};
    print "done\n" if $verbose;
    my @start = ('@channel', $current_channel+1);
    push @start, '"' . $instrument . '"' if defined $instrument;
    push @start, '{';
        
    @tokens = (@tokens, @start, @track_tokens, '}');
}

my @head = ('@head', '{');

@head = (@head, '$tempo', $tempo) if $tempo;
@head = (@head, '$time_sig', $time_sig) if $time_sig;
@head = (@head, '$key', $key) if $key;
@head = (@head, '$title', $title) if defined $title;
@head = (@head, '$resolution', $resolution);

@tokens = (@head, '}', '@body', '{', @tokens, '}');

&write_mg_file;

########################## End of main() ##############################

##
## return a string of midge tokens from a single MIDI event
##

sub get_event_string {
    my $event = shift;

    if ($event->[0] eq 'note_on') {
        my (undef, $dtime, $channel, $note, $attack) = @$event;
        $current_channel = $channel unless defined $current_channel;
        unless ($channel == $current_channel) {
            die "got event for channel $channel in channel $current_channel\n"
                unless $ignore_wrong_track;
        }
        if ($dtime > 0) {
            my $length = &clicks_to_time($dtime);
            $note = &int_to_note($note);
            return "/l${length}/r +/a${attack}/${note}";
        }
        else {
            $note = &int_to_note($note);
            return "+/a${attack}/${note}";
        }
    }
    elsif ($event->[0] eq 'note_off') {
        my (undef, $dtime, $channel, $note, $decay) = @$event;
        $current_channel = $channel unless defined $current_channel;
        unless ($channel == $current_channel) {
            die "got event for channel $channel in channel $current_channel\n"
                unless $ignore_wrong_track;
        }
        if ($dtime > 0) {
            my $length = &clicks_to_time($dtime);
            $note = &int_to_note($note);
            return "/l${length}/r -/d${decay}/${note}";
        }
        else {
            $note = &int_to_note($note);
            return "-/d${decay}/${note}";
        }
    }
    elsif ($event->[0] eq 'patch_change') {
        my (undef, $dtime, $channel, $patch) = @$event;
        $current_channel = $channel unless defined $current_channel;
        unless ($channel == $current_channel) {
            die "got event for channel $channel in channel $current_channel\n"
                unless $ignore_wrong_track;
        }
        $patch++;
        if ($dtime > 0) {
            return sprintf "/l%s/r \$patch $patch", &clicks_to_time($dtime);
        }
        else {
            return "\$patch $patch";
        }
    }
    elsif ($event->[0] eq 'pitch_wheel_change') {
        my (undef, $dtime, $channel, $value) = @$event;
        $current_channel = $channel unless defined $current_channel;
        unless ($channel == $current_channel) {
            die "got event for channel $channel in channel $current_channel\n"
                unless $ignore_wrong_track;
        }
        $value++ if $value == 8191;
        $value = int((8192.5 + $value) / 128);
        if ($dtime > 0) {
            return sprintf "/l%s/r \$pitch $value", &clicks_to_time($dtime);
        }
        else {
            return "\$pitch $value";
        }
    }
    elsif ($event->[0] eq 'set_tempo') {
        my (undef, $dtime, $tempo) = @$event;
        if ($dtime > 0) {
            return sprintf "/l%s/r \$tempo %s",
                           &clicks_to_time($dtime), int(60000000 / $tempo);
        }
        else {
            return sprintf "\$tempo %s", int(60000000 / $tempo);
        }
    }
    elsif ($event->[0] eq 'time_signature') {
        my (undef, $dtime, $num, $den) = @$event;
        if ($dtime > 0) {
            return sprintf "/l%s/r \$time_sig $num/%s",
                           &clicks_to_time($dtime), $den * $den;
        }
        else {
            return sprintf "\$time_sig $num/%s", $den * $den;
        }
    }
    elsif ($event->[0] eq 'key_signature') {
        my (undef, $dtime, $sf, $mi) = @$event;
        my $key = &get_key($sf, $mi);

        if ($dtime > 0) {
            return sprintf "/l%s/r \$key $key", &clicks_to_time($dtime);
        }
        else {
            return "\$key $key";
        }
    }
    elsif ($event->[0] eq 'text_event') {
        my (undef, $dtime, $text) = @$event;
		return undef if length $text == 0;

        if ($dtime > 0) {
            return sprintf "/l%s/r \$text $text", &clicks_to_time($dtime);
        }
        else {
            return '$text "' . $text . '"';
        }
    }
    elsif ($event->[0] eq 'raw_meta_event') {
        my (undef, $dtime, $cmd, $data) = @$event;

        my @data = unpack "C*", $data;

        if ($dtime > 0) {
            return sprintf "/l%s/r ", &clicks_to_time($dtime)
                . "\%verbatim \{ ". join(' ', &get_delta_time($dtime))
                . " 0xff $cmd " . &get_length_bytes(scalar @data) . ' '
                    . join(' ', @data) . ' }';
        }
        else {
            return "\%verbatim \{ ". join(' ', &get_delta_time($dtime))
                . " 0xff $cmd " . &get_length_bytes(scalar @data) . ' '
                    . join(' ', @data) . ' }';
        }
    }
    elsif ($event->[0] =~ /^sysex_(f\d)$/) {
        my $type = $1;
        my (undef, $dtime, $data) = @$event;

        my @data = unpack "C*", $data;

        if ($dtime > 0) {
            return sprintf "/l%s/r ", &clicks_to_time($dtime)
                . "\%verbatim \{ " . join(' ', &get_delta_time($dtime))
                . " 0x$type " . &get_length_bytes(scalar @data) . ' '
                    . join(' ', @data) . ' }';
        }
        else {
            return "\%verbatim \{ " . join(' ', &get_delta_time($dtime))
                . " 0x$type " . &get_length_bytes(scalar @data) . ' '
                    . join(' ', @data) . ' }';
        }
    }
    elsif ($event->[0] eq 'control_change') {
        my (undef, $dtime, $channel, $ctrl, $value) = @$event;
        $current_channel = $channel unless defined $current_channel;
        unless ($channel == $current_channel) {
            die "got event for channel $channel in channel $current_channel\n"
                unless $ignore_wrong_track;
        }
        if ($dtime > 0) {
            return sprintf "/l%s/r \$ctrl $ctrl,$value",
                           &clicks_to_time($dtime);
        }
        else {
            return "\$ctrl $ctrl,$value";
        }
    }
    elsif ($event->[0] eq 'marker') {
        my (undef, $dtime, $text) = @$event;
		return undef if length $text == 0;

        if ($dtime > 0) {
            return sprintf "/l%s/r \$marker \"$text\"",
                           &clicks_to_time($dtime);
        }
        else {
            return "\$marker \"$text\"";
        }
    }
    else {
        if ($verbose) {
            print "\r";
            print " " x 79;
            print "\r ";
        }
        print " ignoring @$event\n" unless $quiet;
        return '';
    }
}

##
## Try to merge groups of `note_on rest note_off' into simple notes
##

sub merge_note_tokens {
    my $tokens = shift;
    my @newtokens;

    my $i;
    for ($i=0; $i<@$tokens; $i++) {
        if ($tokens->[$i] =~ /^\+(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) {
            my $on_opts = $2;
            my $on_note = $3;

            if (defined $tokens->[$i+1]
                and $tokens->[$i+1] =~ /^\/(\S+)\/r$/) {
                my $length = $1;

                if (defined $tokens->[$i+2] and $tokens->[$i+2] =~
                    /^-(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) {

                    my $off_opts = $2;
                    my $off_note = $3;

                    if ($off_note eq $on_note) {
                        push @newtokens,
                        "/$length$on_opts$off_opts/$on_note";
                        $i += 2;
                        next;
                    }
                }
            }
        }
        push @newtokens, $tokens->[$i];
    }

    return \@newtokens;
}

##
## repair broken handling of running status
##

sub fix_running_status {
    my $tokens = shift;
    my @newtokens;
    my %last;

    my $i;
    for ($i=0; $i<@$tokens; $i++) {
        if ($tokens->[$i] =~ /^\+(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) {
            my $on_opts = $2;
            my $on_note = $3;

            if (defined $last{$on_note} and $last{$on_note}) {
                my $token = $tokens->[$i];
                $token =~ s/^./-/;
                $token =~ s/^(-\/[^\/]*)a/$1d/;
                push @newtokens, $token;
                undef $last{$on_note};
                next;
            }
            elsif (defined $tokens->[$i+1]
                   and $tokens->[$i+1] =~ /^\/(\S+)\/r$/) {
                my $length = $1;

                if (defined $tokens->[$i+2] and $tokens->[$i+2] =~
                    /^\+(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) {

                    my $off_opts = $2;
                    my $off_note = $3;

                    if ($off_note eq $on_note) {
                        $off_opts =~ s/a/d/;
                        push @newtokens,
                        "/$length$on_opts$off_opts/$on_note";
                        $i += 2;
                        next;
                    }
                }
            }
            $last{$on_note} = 1;
        }
        push @newtokens, $tokens->[$i];
    }
    return \@newtokens;
}

##
## Try to remove unnecessary note options and replace them with a default
##

sub simplify_note_options {
    my $tokens = shift;
    my @newtokens;
    my $last_length;
    my $last_octave;
    my %attack;
    my %decay;

    my $i;
    for ($i=0; $i<@$tokens; $i++) {
        if ($tokens->[$i] =~
            /^([-+])?\/(l\d+(\.\d+)?(:\d+)?)?(a\d+)?(d\d+)?\/([a-gr][-+]?)(\d+)?$/) {

            my $onoff = '';
            $onoff = $1 if defined $1;
            my $note = $7;
            my ($length, $attack, $decay, $octave) = ('', '', '', '');
            if (defined $5) {
                $attack{$5}++;
                $attack = $5;
            }
            if (defined $6) {
                $decay{$6}++;
                $decay = $6;
            }
            $length = $2 if defined $2;
            $octave = $8 if defined $8;

            my $saved_length = $length if $length;
            my $saved_octave = $octave if $octave;

            $length = '' if defined $last_length and $last_length eq $length;
            $octave = '' if defined $last_octave and $last_octave eq $octave;

            $newtokens[$i] = "$onoff/$length$attack$decay/$note$octave";
            $newtokens[$i] = "$onoff$note$octave"
                if $newtokens[$i] =~ /^[-+]?\/\//;

            $last_length = $saved_length if defined $saved_length;
            $last_octave = $saved_octave if defined $saved_octave;
        }
        else {
            $newtokens[$i] = $tokens->[$i];
        }
    }

    my $attack;
    my $max = 0;
    foreach my $key (keys %attack) {
        if ($attack{$key} > $max) {
            $max = $attack{$key};
            $attack = $key;
        }
    }

    my $decay;
    $max = 0;
    foreach my $key (keys %decay) {
        if ($decay{$key} > $max) {
            $max = $decay{$key};
            $decay = $key;
        }
    }

    if (defined $decay) {
        $decay =~ s/^d//;
        @newtokens = ('$decay', $decay, @newtokens);

        for ($i=0; $i<@newtokens; $i++) {
            if ($newtokens[$i] =~
                /^([-+])?\/([^d]*)(d(\d+))?([^\/]*)\/(([a-gr][-+]?)(\d+)?)$/) {

                my $onoff = '';
                $onoff = $1 if defined $1;
                my $first = $2;
                my $last = $5;
                my $note = $6;
                my $dec = '';
                $dec = $4 if defined $4;
                $dec = '' if $dec =~ /^\d+$/ and $dec == $decay;
                $dec = "d$dec" if $dec =~ /^\d+$/;

                $newtokens[$i] = "$onoff/$first$dec$last/$note";
                $newtokens[$i] = "$onoff$note"
                    if $newtokens[$i] =~ /^[-+]?\/\//;
            }
        }
    }
    
    if (defined $attack) {
        $attack =~ s/^a//;
        @newtokens = ('$attack', $attack, @newtokens);

        for ($i=0; $i<@newtokens; $i++) {
            if ($newtokens[$i] =~
                /^([-+])?\/([^a]*)(a(\d+))?([^\/]*)\/(([a-gr][-+]?)(\d+)?)$/) {

                my $onoff = '';
                $onoff = $1 if defined $1;
                my $first = $2;
                my $last = $5;
                my $note = $6;
                my $att = '';
                $att = $4 if defined $4;
                $att = '' if $att =~ /^\d+$/ and $att == $attack;
                $att = "a$att" if $att =~ /^\d+$/;

                $newtokens[$i] = "$onoff/$first$att$last/$note";
                $newtokens[$i] = "$onoff$note"
                    if $newtokens[$i] =~ /^[-+]?\/\//;
            }
        }
    }
    
    return \@newtokens;
}

##
## Try to move tempo/time_sig/key etc info into the @head section,
## remove empty tempo track
##

sub final_parse {
    my $tokens = shift;
    my @newtokens;
    my $tempo;
    my $time_sig;
    my $key;
    my $ct = 0; # current track

    @$tokens = ('@body', '{', @$tokens, '}');

    print " pass 1 of 2... " if $verbose;

    my $i;
    for ($i=0; $i<@$tokens; $i++) {
        if ($tokens->[$i] eq '$tempo') {
            $tempo = $tokens->[$i+1] unless defined $tempo;
            $tempo = '' unless $tempo == $tokens->[$i+1];
            $i++;
        }
        elsif ($tokens->[$i] eq '$time_sig') {
            $time_sig = $tokens->[$i+1] unless defined $time_sig;
            $time_sig = '' unless $time_sig eq $tokens->[$i+1];
            $i++;
        }
        elsif ($tokens->[$i] eq '$key') {
            $key = $tokens->[$i+1] unless defined $key;
            $key = '' unless $key eq $tokens->[$i+1];
            $i++;
        }
        elsif ($tokens->[$i] eq '@channel') {
            $ct++;
            print "  track $ct\n" if $verbose;
        }
    }

    print "done\n" if $verbose;

    $tempo = '' unless defined $tempo;
    $time_sig = '' unless defined $time_sig;
    $key = '' unless defined $key;

    $ct = 0; # current track
    print " pass 2 of 2:\n" if $verbose;

    for ($i=0; $i<@$tokens; $i++) {
        if ($tokens->[$i] eq '$tempo') {
            if ($tempo and ($tokens->[$i+1] == $tempo)) {
                $i++;
                next;
            }
        }
        elsif ($tokens->[$i] eq '$time_sig') {
            if ($time_sig and ($tokens->[$i+1] eq $time_sig)) {
                $i++;
                next;
            }
        }
        elsif ($tokens->[$i] eq '$key') {
            if ($key and ($tokens->[$i+1] eq $key)) {
                $i++;
                next;
            }
        }
        elsif ($tokens->[$i] eq '@channel') {
            $ct++;
            if ($tokens->[$i+1] eq '0') {
                print "  removing empty track #$ct\n" if $verbose;
                    $i += 2;
                while (not $tokens->[$i] eq '}') {
                    $i++;
                }
                next;
            }
            else {
                print "  track $ct\n" if $verbose;
                @newtokens = (@newtokens, $tokens->[$i]);
            }
        }
        else {
            @newtokens = (@newtokens, $tokens->[$i]);
        }
    }

    my @head = ('@head', '{');

    @head = (@head, '$tempo', $tempo) if $tempo;
    @head = (@head, '$time_sig', $time_sig) if $time_sig;
    @head = (@head, '$key', $key) if $key;
    @head = (@head, '$title', $title) if defined $title;

    @newtokens = (@head, '}', @newtokens);

    return \@newtokens;
}

##
## return the key from MIDI sf and mi values
##

sub get_key {
    my ($sf, $mi) = @_;
    my $key;

    my @sharps = qw/ c g d a e b f+ c+ /;
    my @flats = qw/ c f b- e- a- d- g- c- /;

    if ($sf =~ /^-(\d)/) {
        my $idx = $1;
        if ($mi) {
            $idx -= 3;
            $idx += 8 if $idx < 0;
        }

        $key = $flats[$idx];
    }
    else {
        my $idx = $1;
        if ($mi) {
            $idx -= 3;
            $idx += 8 if $idx < 0;
        }

        $key = $sharps[$sf];
    }
    $key .= 'm' if $mi;
    return $key;
}

##
## 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 $i = 0;           # counter


    if ($dtime < 128) {
        return $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 ($i > 0) {
                    $bytes[$i] |= 0x80;
                }
                $i++;
            }
        }
    }
    return reverse @bytes;
}

sub get_length_bytes {
    my $length = shift;

    my @bytes = ($length % 128);
    while ($length > 127) {
        @bytes = (80 + $length % 128, @bytes);
    }
    return join ' ', @bytes;
}

############### Subs copied from midge ##################

##
## write the tokens array out to the .mg file
##

sub write_mg_file {
    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

    unless ($mg_file =~ '-') {
        open MG, ">$mg_file" or die "$mg_file: $!\n";
        select MG;
    }

    print "# Converted from $midi_file\n# by $0 on $now\n\n";

    for ($i=0; $i<=$#tokens; $i++) {
        if ($tokens[$i] eq '{') {
            print "{\n";
            $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++; $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] ";

            $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] ";

            $i++;
            if ($tokens[$i] =~ /^\"/) {
                my ($j, $tmp);
                for ($j=$i; $j<=$#tokens; $j++) {
                    if ($tokens[$j] =~ /\"$/) {
                        $tmp .= $tokens[$j];

                        $i = $j;
                        last;
                    }
                    else {
                        $tmp .= "$tokens[$j] ";

                    }
                }
                print "$tmp\n";
            }
            else {
                print "$tokens[$i]\n";

            }
            $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] ";

            $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] ";

        }
        elsif ($tokens[$i] eq ')') {
            print ")\n";

            $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] ";

            $col += 1 + length $tokens[$i];
        }
    }
    unless ($mg_file eq '-') {
        select STDOUT;
        close MG;
        print "midge source written to $mg_file\n" unless ($quiet);
    }
}

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

sub int_to_note {
    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';}
    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 = 'c+';}
    else {$name = 'c';}

    $note = "$name$octave";
    return $note;
}

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

sub clicks_to_time {
    my $clicks = $_[0]; # time in clicks

    my $whole = 4 * $resolution;
	my $hcf = &get_hcf($clicks, $whole);

	$clicks /= $hcf;
	$whole /= $hcf;

	return ($clicks == 1)? $whole : "$clicks:$whole";
}

##
## Return the highest common factor of the two integer arguments.
##

sub get_hcf {
	my ($v1, $v2) = @_;

	die "Error: get_hcf(): both arguments must be integers"
		unless $v1 == int $v1 and $v2 == int $v2;
	
	my $f1 = &get_factors($v1);
	my $f2 = &get_factors($v2);

	my $hcf = 1;
	my @fa;
	
	foreach my $f (@$f1) {
		shift @$f2 while @$f2 > 0 and $f2->[0] < $f;

		if (@$f2 > 0 and $f2->[0] == $f) {
			$hcf *= $f;
			shift @$f2
		}
	}

	return $hcf;
}

##
## Return the prime factors of the integer argument.
##

sub get_factors {
	my $v = shift;
	die "Error: get_factors(): argument must be an integer\n"
		unless $v == int $v;

	my @factors;

	for my $prime (qw(2 3 5 7 11 13 17 19 23 29 31)) {
		last if $v == 1;

		while ($v / $prime == int($v / $prime)) {
			last if $v == 1;
			$v /= $prime;
			push @factors, $prime;
		}
	}

	push @factors, $v unless $v == 1;
	return \@factors;
}
