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