add_note_event() now uses add_song_ev(); everything is broken now.
[ahxm.git] / midi2ahs.pl
blob726d25210660fe826568bc29a7860fbd9443126d
1 #!/usr/bin/perl
4 # A MIDI file to Ann Hell Scripting converter
6 # (C) Angel Ortega 2006
8 # NOTE: this is by no means a general-purpose MIDI to Ann Hell Scripting
9 # Converter; it has been tuned to work on MIDI files converted from .mts
10 # files by MIDI Workshop / Master Tracks Pro. YMMV.
12 # This program mades the following assumptions:
14 # * A new track starts on patch_change messages.
16 use MIDI;
17 use strict;
19 # current position
20 my $time = 0;
22 # last event time
23 my $last_time = 0;
25 # last note on time (to detect chords)
26 my $last_note_on_time = -1;
28 # last octave set
29 my $last_octave = -1;
31 # the note array
32 my @notes = ();
34 # subtracks
35 my @subtracks = ();
37 # length of a whole note
38 my $whole = 480;
40 # last length set
41 my $last_length = undef;
43 sub note_length
45 my $len = shift;
46 my $ret = '';
48 if($len > ($whole/2))
50 # set as a multiplier for the note
51 $ret = "1*" . $len / $whole;
53 else
55 # set as the divisor
56 $ret = int($whole / $len);
59 if($last_length eq $ret)
61 $ret = '';
63 else
65 $last_length = $ret;
68 return $ret;
72 sub print_note
74 my $e = shift;
75 my @letters = ( 'c', 'c#', 'd', 'd#', 'e', 'f', 'f#',
76 'g', 'g#', 'a', 'a#', 'b');
77 my $ret = '';
79 if($e->{'type'} eq 'rest')
81 # it's a rest
82 $ret = 'r' . note_length($e->{'length'});
84 else
86 my $note_num = $e->{'note'} - 5;
88 my $octave = int($note_num / 12);
89 my $note = $letters[$note_num % 12];
91 # if last octave is different, set it
92 if($octave != $last_octave)
94 $ret .= "o$octave ";
95 $last_octave = $octave;
98 $ret .= $note . note_length($e->{'length'});
101 return($ret);
105 sub flush_subtracks
107 my $ret = undef;
108 my @l = ();
110 foreach my $t (@subtracks)
112 my $subret = '';
114 # get last event
115 my $e = $t->[-1];
117 # if no length, there are still pending events; abort
118 return(undef) if !$e->{'length'};
120 foreach $e (@{$t})
122 $subret .= print_note($e);
125 push(@l, $subret);
128 if(scalar(@subtracks) > 1)
130 $ret = '<' . join(';', @l) . ">\n";
132 else
134 $ret = $l[0];
137 @subtracks = ();
139 return($ret);
143 sub find_subtrack
145 my $subtrack = undef;
147 # find a subtrack with closed events
148 foreach my $t (@subtracks)
150 # get the last event
151 my $e = $t->[-1];
153 # is it closed?
154 if($e->{'length'})
156 $subtrack = $t;
157 last;
161 # if there is no subtrack, alloc a new one
162 unless($subtrack)
164 $subtrack = [];
165 push(@subtracks, $subtrack);
168 return($subtrack);
172 sub note_on_event
174 my ($dtime, $chan, $note, $vel) = @_;
175 my $subtrack = undef;
177 $subtrack = find_subtrack();
179 # if this note has a delta, push some silence
180 if($dtime)
182 push(@{$subtrack}, {
183 'type' => 'rest',
184 'time' => $time,
185 'length' => $dtime
188 if(my $ret = flush_subtracks())
190 print $ret;
191 $subtrack = find_subtrack();
195 # advance
196 $time += $dtime;
198 # create an event
199 my $event = {
200 'type' => 'note',
201 'note' => $note,
202 'time' => $time,
203 'chan' => $chan,
204 'vel' => $vel
207 push(@{$subtrack}, $event);
209 # store it for easy access
210 $notes[$note] = $event;
214 sub note_off_event
216 my ($dtime, $chan, $note, $vel) = @_;
217 my $e = $notes[$note];
219 # advance
220 $time += $dtime;
222 # close the event
223 $e->{'length'} = $time - $e->{'time'};
225 if(my $ret = flush_subtracks())
227 print $ret;
232 sub event_callback
234 my $event = shift;
236 # print "$event @_\n";
238 if($event eq 'note_on')
240 note_on_event( @_ );
242 elsif($event eq 'note_off')
244 note_off_event( @_ );
246 elsif($event eq 'track_name')
248 print("/* $event @_ */\n");
250 elsif($event eq 'patch_change')
252 print("/* $event @_ */\n");
254 # reset track
255 $time = $last_time = 0;
256 $last_octave = -1;
257 $last_length = undef;
259 @notes = ();
260 @subtracks = ();
265 ##############################################
267 my $input = $ARGV[0] or die "Usage: $0 {midi file}";
269 MIDI::Opus->new( {
270 "from_file" => $input,
271 "exclusive_event_callback" => sub { &event_callback }