midi2cfg-ng: new command syntax, support multiple MIDIs (yet to be tested)
[divverent/nexuiz.git] / misc / tools / midi2cfg-ng.pl
1 #!/usr/bin/perl
2
3 # converter from Type 1 MIDI files to CFG files that control bots with the Tuba and other weapons for percussion (requires g_weaponarena all)
4
5 use strict;
6 use warnings;
7 use MIDI;
8 use MIDI::Opus;
9 use Storable;
10
11 use constant MIDI_FIRST_NONCHANNEL => 17;
12 use constant MIDI_DRUMS_CHANNEL => 10;
13
14 die "Usage: $0 filename.conf timeoffset_preinit timeoffset_postinit timeoffset_predone timeoffset_postdone timeoffset_preintermission timeoffset_postintermission midifile1 transpose1 midifile2 transpose2 ..."
15         unless @ARGV > 7 and @ARGV % 2;
16 my ($config, $timeoffset_preinit, $timeoffset_postinit, $timeoffset_predone, $timeoffset_postdone, $timeoffset_preintermission, $timeoffset_postintermission, @midilist) = @ARGV;
17
18 sub unsort(@)
19 {
20         return map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } @_;
21 }
22
23 my $precommands = "";
24 my $commands = "";
25 my $busybots;
26 my @busybots_allocated;
27 my %notechannelbots;
28 my $transpose = 0;
29 my $notetime = undef;
30 my $lowestnotestart = undef;
31 sub botconfig_read($)
32 {
33         my ($fn) = @_;
34         my %bots = ();
35         open my $fh, "<", $fn
36                 or die "<$fn: $!";
37         
38         my $currentbot = undef;
39         my $appendref = undef;
40         my $super = undef;
41         while(<$fh>)
42         {
43                 chomp;
44                 s/\s*#.*//;
45                 next if /^$/;
46                 if(s/^\t\t//)
47                 {
48                         my @cmd = split /\s+/, $_;
49                         if($cmd[0] eq 'super')
50                         {
51                                 push @$appendref, @$super
52                                         if $super;
53                         }
54                         elsif($cmd[0] eq 'percussion') # simple import
55                         {
56                                 push @$appendref, @{$currentbot->{percussion}->{$cmd[1]}};
57                         }
58                         else
59                         {
60                                 push @$appendref, \@cmd;
61                         }
62                 }
63                 elsif(s/^\t//)
64                 {
65                         if(/^include (.*)/)
66                         {
67                                 my $base = $bots{$1};
68                                 for(keys %$base)
69                                 {
70                                         if(ref $base->{$_})
71                                         {
72                                                 $currentbot->{$_} = Storable::dclone $base->{$_}; # copy array items as new array
73                                         }
74                                         else
75                                         {
76                                                 $currentbot->{$_} = $base->{$_};
77                                         }
78                                 }
79                                 # better: do some merging TODO
80                         }
81                         elsif(/^count (\d+)/)
82                         {
83                                 $currentbot->{count} = $1;
84                         }
85                         elsif(/^transpose (\d+)/)
86                         {
87                                 $currentbot->{transpose} += $1;
88                         }
89                         elsif(/^channels (.*)/)
90                         {
91                                 $currentbot->{channels} = { map { $_ => 1 } split /\s+/, $1 };
92                         }
93                         elsif(/^init$/)
94                         {
95                                 $super = $currentbot->{init};
96                                 $currentbot->{init} = $appendref = [];
97                         }
98                         elsif(/^done$/)
99                         {
100                                 $super = $currentbot->{done};
101                                 $currentbot->{done} = $appendref = [];
102                         }
103                         elsif(/^note on (-?\d+)/)
104                         {
105                                 $super = $currentbot->{notes_on}->{$1};
106                                 $currentbot->{notes_on}->{$1} = $appendref = [];
107                         }
108                         elsif(/^note off (-?\d+)/)
109                         {
110                                 $super = $currentbot->{notes_off}->{$1};
111                                 $currentbot->{notes_off}->{$1} = $appendref = [];
112                         }
113                         elsif(/^percussion (\d+)/)
114                         {
115                                 $super = $currentbot->{percussion}->{$1};
116                                 $currentbot->{percussion}->{$1} = $appendref = [];
117                         }
118                         else
119                         {
120                                 print "unknown command: $_\n";
121                         }
122                 }
123                 elsif(/^bot (.*)/)
124                 {
125                         $currentbot = ($bots{$1} ||= {count => 0, transpose => 0});
126                 }
127                 elsif(/^raw (.*)/)
128                 {
129                         $precommands .= "$1\n";
130                 }
131                 else
132                 {
133                         print "unknown command: $_\n";
134                 }
135         }
136
137         for(values %bots)
138         {
139                 for(values %{$_->{notes_on}}, values %{$_->{percussion}})
140                 {
141                         my $t = $_->[0]->[0] eq 'time' ? $_->[0]->[1] : 0;
142                         $lowestnotestart = $t if not defined $lowestnotestart or $t < $lowestnotestart;
143                 }
144         }
145
146         return \%bots;
147 }
148 my $busybots_orig = botconfig_read $config;
149
150
151 sub busybot_cmd_bot_test($$@)
152 {
153         my ($bot, $time, @commands) = @_;
154
155         my $bottime = defined $bot->{timer} ? $bot->{timer} : -1;
156         my $botbusytime = defined $bot->{busytimer} ? $bot->{busytimer} : -1;
157
158         return 0
159                 if $time < $botbusytime;
160         
161         my $mintime = (@commands && ($commands[0]->[0] eq 'time')) ? $commands[0]->[1] : 0;
162
163         return 0
164                 if $time + $mintime < $bottime;
165         
166         return 1;
167 }
168
169 sub busybot_cmd_bot_execute($$@)
170 {
171         my ($bot, $time, @commands) = @_;
172
173         for(@commands)
174         {
175                 if($_->[0] eq 'time')
176                 {
177                         $commands .= sprintf "sv_cmd bot_cmd %d wait_until %f\n", $bot->{id}, $time + $_->[1];
178                         $bot->{timer} = $time + $_->[1];
179                 }
180                 elsif($_->[0] eq 'busy')
181                 {
182                         $bot->{busytimer} = $time + $_->[1];
183                 }
184                 elsif($_->[0] eq 'buttons')
185                 {
186                         my %buttons_release = %{$bot->{buttons} ||= {}};
187                         for(@{$_}[1..@$_-1])
188                         {
189                                 /(.*)\??/ or next;
190                                 delete $buttons_release{$1};
191                         }
192                         for(keys %buttons_release)
193                         {
194                                 $commands .= sprintf "sv_cmd bot_cmd %d releasekey %s\n", $bot->{id}, $_;
195                                 delete $bot->{buttons}->{$_};
196                         }
197                         for(@{$_}[1..@$_-1])
198                         {
199                                 /(.*)(\?)?/ or next;
200                                 defined $2 and next;
201                                 $commands .= sprintf "sv_cmd bot_cmd %d presskey %s\n", $bot->{id}, $_;
202                                 $bot->{buttons}->{$_} = 1;
203                         }
204                 }
205                 elsif($_->[0] eq 'cmd')
206                 {
207                         $commands .= sprintf "sv_cmd bot_cmd %d %s\n", $bot->{id}, join " ", @{$_}[1..@$_-1];
208                 }
209                 elsif($_->[0] eq 'barrier')
210                 {
211                         $commands .= sprintf "sv_cmd bot_cmd %d barrier\n", $bot->{id};
212                         $bot->{timer} = $bot->{busytimer} = 0;
213                 }
214                 elsif($_->[0] eq 'raw')
215                 {
216                         $commands .= sprintf "%s\n", join " ", @{$_}[1..@$_-1];
217                 }
218         }
219
220         return 1;
221 }
222
223 my $intermissions = 0;
224
225 sub busybot_intermission_bot($)
226 {
227         my ($bot) = @_;
228         busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preintermission];
229         busybot_cmd_bot_execute $bot, 0, ['barrier'];
230         if($bot->{intermission})
231         {
232                 busybot_cmd_bot_execute $bot, 0, @{$bot->{intermission}};
233         }
234         busybot_cmd_bot_execute $bot, 0, ['barrier'];
235         $notetime = $timeoffset_postintermission - $lowestnotestart;
236 }
237
238 sub busybot_note_off_bot($$$$)
239 {
240         my ($bot, $time, $channel, $note) = @_;
241         return 1
242                 if $channel == 10;
243         my $cmds = $bot->{notes_off}->{$note - $bot->{transpose} - $transpose};
244         return 1
245                 if not defined $cmds; # note off cannot fail
246         $bot->{busy} = 0;
247         busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds; 
248         return 1;
249 }
250
251 sub busybot_note_on_bot($$$$$)
252 {
253         my ($bot, $time, $channel, $note, $init) = @_;
254         return -1 # I won't play on this channel
255                 if defined $bot->{channels} and not $bot->{channels}->{$channel};
256         return 0
257                 if $bot->{busy};
258         my $cmds;
259         if($channel == 10)
260         {
261                 $cmds = $bot->{percussion}->{$note};
262         }
263         else
264         {
265                 $cmds = $bot->{notes_on}->{$note - $bot->{transpose} - $transpose};
266                 my $cmds_off = $bot->{notes_off}->{$note - $bot->{transpose} - $transpose};
267                 if(defined $cmds and defined $cmds_off)
268                 {
269                         $bot->{busy} = 1;
270                 }
271         }
272         return -1 # I won't play this note
273                 if not defined $cmds;
274         if($init)
275         {
276                 return 0
277                         if not busybot_cmd_bot_test $bot, $time + $notetime, @$cmds; 
278                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
279                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
280                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
281                         if @{$bot->{init}};
282                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
283                 for(1..$intermissions)
284                 {
285                         busybot_intermission_bot $bot;
286                 }
287                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds; 
288         }
289         else
290         {
291                 return 0
292                         if not busybot_cmd_bot_test $bot, $time + $notetime, @$cmds; 
293                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds; 
294         }
295         return 1;
296 }
297
298 sub busybots_reset()
299 {
300         $busybots = Storable::dclone $busybots_orig;
301         @busybots_allocated = ();
302         %notechannelbots = ();
303         $transpose = 0;
304         $notetime = $timeoffset_postinit - $lowestnotestart;
305 }
306
307 sub busybot_note_off($$$)
308 {
309         my ($time, $channel, $note) = @_;
310
311         return 0
312                 if $channel == 10;
313
314         if(my $bot = $notechannelbots{$channel}{$note})
315         {
316                 busybot_note_off_bot $bot, $time, $channel, $note;
317                 delete $notechannelbots{$channel}{$note};
318                 return 1;
319         }
320
321         return 0;
322 }
323
324 sub busybot_note_on($$$)
325 {
326         my ($time, $channel, $note) = @_;
327
328         if($notechannelbots{$channel}{$note})
329         {
330                 busybot_note_off $time, $channel, $note;
331         }
332
333         my $overflow = 0;
334
335         for(unsort @busybots_allocated)
336         {
337                 my $canplay = busybot_note_on_bot $_, $time, $channel, $note, 0;
338                 if($canplay > 0)
339                 {
340                         $notechannelbots{$channel}{$note} = $_;
341                         return 1;
342                 }
343                 $overflow = 1
344                         if $canplay == 0;
345                 # wrong
346         }
347
348         for(unsort keys %$busybots)
349         {
350                 next if $busybots->{$_}->{count} <= 0;
351                 my $bot = Storable::dclone $busybots->{$_};
352                 $bot->{id} = @busybots_allocated + 1;
353                 $bot->{classname} = $_;
354                 my $canplay = busybot_note_on_bot $bot, $time, $channel, $note, 1;
355                 if($canplay > 0)
356                 {
357                         --$busybots->{$_}->{count};
358                         $notechannelbots{$channel}{$note} = $bot;
359                         push @busybots_allocated, $bot;
360                         return 1;
361                 }
362                 $overflow = 1
363                         if $canplay == 0;
364         }
365
366         if($overflow)
367         {
368                 warn "Not enough bots to play this (when playing $channel:$note)";
369         }
370         else
371         {
372                 warn "Note $channel:$note cannot be played by any bot"
373         }
374
375         return 0;
376 }
377
378 sub Preallocate(@)
379 {
380         my (@preallocate) = @_;
381         busybots_reset();
382         for(@preallocate)
383         {
384                 die "Cannot preallocate any more $_ bots"
385                         if $busybots->{$_}->{count} <= 0;
386                 my $bot = Storable::dclone $busybots->{$_};
387                 $bot->{id} = @busybots_allocated + 1;
388                 $bot->{classname} = $_;
389                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
390                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
391                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
392                         if @{$bot->{init}};
393                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
394                 --$busybots->{$_}->{count};
395                 push @busybots_allocated, $bot;
396         }
397 }
398
399 sub ConvertMIDI($$)
400 {
401         my ($filename, $trans) = @_;
402         $transpose = $trans;
403
404         my $opus = MIDI::Opus->new({from_file => $filename});
405         my $ticksperquarter = $opus->ticks();
406         my $tracks = $opus->tracks_r();
407         my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
408         my $tick;
409
410         $tick = 0;
411         for($tracks->[0]->events())
412         {   
413                 $tick += $_->[1];
414                 if($_->[0] eq 'set_tempo')
415                 {   
416                         push @tempi, [$tick, $_->[2] * 0.000001 / $ticksperquarter];
417                 }
418         }
419         my $tick2sec = sub
420         {
421                 my ($tick) = @_;
422                 my $sec = 0;
423                 my $curtempo = [0, 0.5 / $ticksperquarter];
424                 for(@tempi)
425                 {
426                         if($_->[0] < $tick)
427                         {
428                                 # this event is in the past
429                                 # we add the full time since the last one then
430                                 $sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
431                         }   
432                         else
433                         {
434                                 # if this event is in the future, we break
435                                 last;
436                         }
437                         $curtempo = $_;
438                 }
439                 $sec += ($tick - $curtempo->[0]) * $curtempo->[1];
440                 return $sec;
441         };
442
443         # merge all to a single track
444         my @allmidievents = ();
445         my $sequence = 0;
446         for my $track(0..@$tracks-1)
447         {
448                 $tick = 0;
449                 for($tracks->[$track]->events())
450                 {
451                         my ($command, $delta, @data) = @$_;
452                         $command = 'note_off' if $command eq 'note_on' and $data[2] == 0;
453                         $tick += $delta;
454                         push @allmidievents, [$command, $tick, $sequence++, $track, @data];
455                 }
456         }
457         @allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
458
459         my %midinotes = ();
460         my $note_min = undef;
461         my $note_max = undef;
462         my $notes_stuck = 0;
463         my $t = 0;
464         for(@allmidievents)
465         {
466                 $t = $tick2sec->($_->[1]);
467                 my $track = $_->[3];
468                 if($_->[0] eq 'note_on')
469                 {
470                         my $chan = $_->[4] + 1;
471                         $note_min = $_->[5]
472                                 if not defined $note_min or $_->[5] < $note_min and $chan != 10;
473                         $note_max = $_->[5]
474                                 if not defined $note_max or $_->[5] > $note_max and $chan != 10;
475                         if($midinotes{$chan}{$_->[5]})
476                         {
477                                 --$notes_stuck;
478                                 busybot_note_off($t, $chan, $_->[5]);
479                         }
480                         busybot_note_on($t, $chan, $_->[5]);
481                         ++$notes_stuck;
482                         $midinotes{$chan}{$_->[5]} = 1;
483                 }
484                 elsif($_->[0] eq 'note_off')
485                 {
486                         my $chan = $_->[4] + 1;
487                         if($midinotes{$chan}{$_->[5]})
488                         {
489                                 --$notes_stuck;
490                                 busybot_note_off($t, $chan, $_->[5]);
491                         }
492                         $midinotes{$chan}{$_->[5]} = 0;
493                 }
494         }
495
496         print STDERR "For file $filename:\n";
497         print STDERR "  Range of notes: $note_min .. $note_max\n";
498         print STDERR "  Safe transpose range: @{[$note_max - 19]} .. @{[$note_min + 13]}\n";
499         print STDERR "  Unsafe transpose range: @{[$note_max - 27]} .. @{[$note_min + 18]}\n";
500         print STDERR "  Stuck notes: $notes_stuck\n";
501
502         while(my ($k1, $v1) = each %midinotes)
503         {
504                 while(my ($k2, $v2) = each %$v1)
505                 {
506                         busybot_note_off($t, $k1, $k2);
507                 }
508         }
509
510         for(@busybots_allocated)
511         {
512                 busybot_intermission_bot $_;
513         }
514         ++$intermissions;
515 }
516
517 sub Deallocate()
518 {
519         print STDERR "Bots allocated:\n";
520         for(@busybots_allocated)
521         {
522                 print STDERR "$_->{id} is a $_->{classname}\n";
523         }
524         for(@busybots_allocated)
525         {
526                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_predone];
527                 busybot_cmd_bot_execute $_, 0, ['barrier'];
528                 if($_->{done})
529                 {
530                         busybot_cmd_bot_execute $_, 0, @{$_->{done}};
531                 }
532                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_postdone];
533                 busybot_cmd_bot_execute $_, 0, ['barrier'];
534         }
535 }
536
537 my @preallocate = ();
538 for(;;)
539 {
540         $commands = "";
541         Preallocate(@preallocate);
542         my @l = @midilist;
543         while(@l)
544         {
545                 my $filename = shift @l;
546                 my $transpose = shift @l;
547                 ConvertMIDI($filename, $transpose);
548         }
549         Deallocate();
550         my @preallocate_new = map { $_->{classname} } @busybots_allocated;
551         last if @preallocate_new == @preallocate;
552         @preallocate = @preallocate_new;
553 }
554
555 print "$precommands$commands";