More reformatting.

[ahxm.git] / midi2ahs.pl

#!/usr/bin/perl

#
# A MIDI file to Ann Hell Scripting converter
#
# (C) Angel Ortega 2006
#
# NOTE: this is by no means a general-purpose MIDI to Ann Hell Scripting
# Converter; it has been tuned to work on MIDI files converted from .mts
# files by MIDI Workshop / Master Tracks Pro. YMMV.
#
# This program mades the following assumptions:
#
# * A new track starts on patch_change messages.

use MIDI;
use strict;

# current position
my $time = 0;

# last event time
my $last_time = 0;

# last note on time (to detect chords)
my $last_note_on_time = -1;

# last octave set
my $last_octave = -1;

# the note array
my @notes = ();

# subtracks
my @subtracks = ();

# length of a whole note
my $whole = 480;

# last length set
my $last_length = undef;

sub note_length
{
        my $len = shift;
        my $ret = '';

        if($len > ($whole/2))
        {
                # set as a multiplier for the note
                $ret = "1*" . $len / $whole;
        }
        else
        {
                # set as the divisor
                $ret = int($whole / $len);
        }

        if($last_length eq $ret)
        {
                $ret = '';
        }
        else
        {
                $last_length = $ret;
        }

        return $ret;
}


sub print_note
{
        my $e = shift;
        my @letters = ( 'c', 'c#', 'd', 'd#', 'e', 'f', 'f#',
                        'g', 'g#', 'a', 'a#', 'b');
        my $ret = '';

        if($e->{'type'} eq 'rest')
        {
                # it's a rest
                $ret = 'r' . note_length($e->{'length'});
        }
        else
        {
                my $note_num = $e->{'note'} - 5;

                my $octave      = int($note_num / 12);
                my $note        = $letters[$note_num % 12];

                # if last octave is different, set it
                if($octave != $last_octave)
                {
                        $ret .= "o$octave ";
                        $last_octave = $octave;
                }

                $ret .= $note . note_length($e->{'length'});
        }

        return($ret);
}


sub flush_subtracks
{
        my $ret = undef;
        my @l = ();

        foreach my $t (@subtracks)
        {
                my $subret = '';

                # get last event
                my $e = $t->[-1];

                # if no length, there are still pending events; abort
                return(undef) if !$e->{'length'};

                foreach $e (@{$t})
                {
                        $subret .= print_note($e);
                }

                push(@l, $subret);
        }

        if(scalar(@subtracks) > 1)
        {
                $ret = '<' . join(';', @l) . ">\n";
        }
        else
        {
                $ret = $l[0];
        }

        @subtracks = ();

        return($ret);
}


sub find_subtrack
{
        my $subtrack = undef;

        # find a subtrack with closed events
        foreach my $t (@subtracks)
        {
                # get the last event
                my $e = $t->[-1];

                # is it closed?
                if($e->{'length'})
                {
                        $subtrack = $t;
                        last;
                }
        }

        # if there is no subtrack, alloc a new one
        unless($subtrack)
        {
                $subtrack = [];
                push(@subtracks, $subtrack);
        }

        return($subtrack);
}


sub note_on_event
{
        my ($dtime, $chan, $note, $vel) = @_;
        my $subtrack = undef;

        $subtrack = find_subtrack();

        # if this note has a delta, push some silence
        if($dtime)
        {
                push(@{$subtrack}, {
                        'type'          =>      'rest',
                        'time'          =>      $time,
                        'length'        =>      $dtime
                });

                if(my $ret = flush_subtracks())
                {
                        print $ret;
                        $subtrack = find_subtrack();
                }
        }

        # advance
        $time += $dtime;

        # create an event
        my $event = {
                'type'  =>      'note',
                'note'  =>      $note,
                'time'  =>      $time,
                'chan'  =>      $chan,
                'vel'   =>      $vel
        };

        push(@{$subtrack}, $event);

        # store it for easy access
        $notes[$note] = $event;
}


sub note_off_event
{
        my ($dtime, $chan, $note, $vel) = @_;
        my $e = $notes[$note];

        # advance
        $time += $dtime;

        # close the event
        $e->{'length'} = $time - $e->{'time'};

        if(my $ret = flush_subtracks())
        {
                print $ret;
        }
}


sub event_callback
{
        my $event = shift;

#       print "$event @_\n";

        if($event eq 'note_on')
        {
                note_on_event( @_ );
        }
        elsif($event eq 'note_off')
        {
                note_off_event( @_ );
        }
        elsif($event eq 'track_name')
        {
                print("/* $event @_ */\n");
        }
        elsif($event eq 'patch_change')
        {
                print("/* $event @_ */\n");

                # reset track
                $time = $last_time = 0;
                $last_octave = -1;
                $last_length = undef;

                @notes = ();
                @subtracks = ();
        }
}


##############################################

my $input = $ARGV[0] or die "Usage: $0 {midi file}";

MIDI::Opus->new( {
        "from_file" => $input,
        "exclusive_event_callback" => sub { &event_callback }
        }
);