]> git.xonotic.org Git - xonotic/xonotic.git/blob - misc/tools/midi2cfg-ng.pl
c2c3f47f09b50182676ff27d034cf53acc0ee713
[xonotic/xonotic.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 # workaround for possible refire time problems
12 use constant SYS_TICRATE => 0.033333;
13 #use constant SYS_TICRATE => 0;
14
15 use constant MIDI_FIRST_NONCHANNEL => 17;
16 use constant MIDI_DRUMS_CHANNEL => 10;
17
18 die "Usage: $0 filename.conf midifile1 transpose1 midifile2 transpose2 ..."
19         unless @ARGV > 1 and @ARGV % 2;
20
21 my $timeoffset_preinit = 2;
22 my $timeoffset_postinit = 2;
23 my $timeoffset_predone = 2;
24 my $timeoffset_postdone = 2;
25 my $timeoffset_preintermission = 2;
26 my $timeoffset_postintermission = 2;
27 my $time_forgetfulness = 1.5;
28
29 my ($config, @midilist) = @ARGV;
30
31 sub unsort(@)
32 {
33         return map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } @_;
34 }
35
36 sub override($$);
37 sub override($$)
38 {
39         my ($dest, $src) = @_;
40         if(ref $src eq 'HASH')
41         {
42                 $dest = {}
43                         if not defined $dest;
44                 for(keys %$src)
45                 {
46                         $dest->{$_} = override $dest->{$_}, $src->{$_};
47                 }
48         }
49         elsif(ref $src eq 'ARRAY')
50         {
51                 $dest = []
52                         if not defined $dest;
53                 for(@$src)
54                 {
55                         push @$dest, override undef, $_;
56                 }
57         }
58         elsif(ref $src)
59         {
60                 $dest = Storable::dclone $src;
61         }
62         else
63         {
64                 $dest = $src;
65         }
66         return $dest;
67 }
68
69 my $precommands = "";
70 my $commands = "";
71 my $busybots;
72 my @busybots_allocated;
73 my %notechannelbots;
74 my $transpose = 0;
75 my $notetime = undef;
76 my $lowestnotestart = undef;
77 my $noalloc = 0;
78 sub botconfig_read($)
79 {
80         my ($fn) = @_;
81         my %bots = ();
82         open my $fh, "<", $fn
83                 or die "<$fn: $!";
84         
85         my $currentbot = undef;
86         my $appendref = undef;
87         my $super = undef;
88         while(<$fh>)
89         {
90                 chomp;
91                 s/\s*#.*//;
92                 next if /^$/;
93                 if(s/^\t\t//)
94                 {
95                         my @cmd = split /\s+/, $_;
96                         if($cmd[0] eq 'super')
97                         {
98                                 push @$appendref, @$super
99                                         if $super;
100                         }
101                         elsif($cmd[0] eq 'percussion') # simple import
102                         {
103                                 push @$appendref, @{$currentbot->{percussion}->{$cmd[1]}};
104                         }
105                         else
106                         {
107                                 push @$appendref, \@cmd;
108                         }
109                 }
110                 elsif(s/^\t//)
111                 {
112                         if(/^include (.*)/)
113                         {
114                                 my $base = $bots{$1};
115                                 $currentbot = override $currentbot, $base;
116                         }
117                         elsif(/^count (\d+)/)
118                         {
119                                 $currentbot->{count} = $1;
120                         }
121                         elsif(/^transpose (\d+)/)
122                         {
123                                 $currentbot->{transpose} ||= 0;
124                                 $currentbot->{transpose} += $1;
125                         }
126                         elsif(/^channels (.*)/)
127                         {
128                                 $currentbot->{channels} = { map { $_ => 1 } split /\s+/, $1 };
129                         }
130                         elsif(/^programs (.*)/)
131                         {
132                                 $currentbot->{programs} = { map { $_ => 1 } split /\s+/, $1 };
133                         }
134                         elsif(/^init$/)
135                         {
136                                 $super = $currentbot->{init};
137                                 $currentbot->{init} = $appendref = [];
138                         }
139                         elsif(/^intermission$/)
140                         {
141                                 $super = $currentbot->{intermission};
142                                 $currentbot->{intermission} = $appendref = [];
143                         }
144                         elsif(/^done$/)
145                         {
146                                 $super = $currentbot->{done};
147                                 $currentbot->{done} = $appendref = [];
148                         }
149                         elsif(/^note on (-?\d+)/)
150                         {
151                                 $super = $currentbot->{notes_on}->{$1};
152                                 $currentbot->{notes_on}->{$1} = $appendref = [];
153                         }
154                         elsif(/^note off (-?\d+)/)
155                         {
156                                 $super = $currentbot->{notes_off}->{$1};
157                                 $currentbot->{notes_off}->{$1} = $appendref = [];
158                         }
159                         elsif(/^percussion (\d+)/)
160                         {
161                                 $super = $currentbot->{percussion}->{$1};
162                                 $currentbot->{percussion}->{$1} = $appendref = [];
163                         }
164                         elsif(/^vocals$/)
165                         {
166                                 $super = $currentbot->{vocals};
167                                 $currentbot->{vocals} = $appendref = [];
168                         }
169                         else
170                         {
171                                 print "unknown command: $_\n";
172                         }
173                 }
174                 elsif(/^bot (.*)/)
175                 {
176                         $currentbot = ($bots{$1} ||= {count => 0});
177                 }
178                 elsif(/^raw (.*)/)
179                 {
180                         $precommands .= "$1\n";
181                 }
182                 elsif(/^timeoffset_preinit (.*)/)
183                 {
184                         $timeoffset_preinit = $1;
185                 }
186                 elsif(/^timeoffset_postinit (.*)/)
187                 {
188                         $timeoffset_postinit = $1;
189                 }
190                 elsif(/^timeoffset_predone (.*)/)
191                 {
192                         $timeoffset_predone = $1;
193                 }
194                 elsif(/^timeoffset_postdone (.*)/)
195                 {
196                         $timeoffset_postdone = $1;
197                 }
198                 elsif(/^timeoffset_preintermission (.*)/)
199                 {
200                         $timeoffset_preintermission = $1;
201                 }
202                 elsif(/^timeoffset_postintermission (.*)/)
203                 {
204                         $timeoffset_postintermission = $1;
205                 }
206                 elsif(/^time_forgetfulness (.*)/)
207                 {
208                         $time_forgetfulness = $1;
209                 }
210                 else
211                 {
212                         print "unknown command: $_\n";
213                 }
214         }
215
216         for(values %bots)
217         {
218                 for(values %{$_->{notes_on}}, values %{$_->{percussion}})
219                 {
220                         my $t = $_->[0]->[0] eq 'time' ? $_->[0]->[1] : 0;
221                         $lowestnotestart = $t if not defined $lowestnotestart or $t < $lowestnotestart;
222                 }
223         }
224
225         return \%bots;
226 }
227 my $busybots_orig = botconfig_read $config;
228
229
230 # returns: ($mintime, $maxtime, $busytime)
231 sub busybot_cmd_bot_cmdinfo(@)
232 {
233         my (@commands) = @_;
234
235         my $mintime = undef;
236         my $maxtime = undef;
237         my $busytime = undef;
238
239         for(@commands)
240         {
241                 if($_->[0] eq 'time')
242                 {
243                         $mintime = $_->[1]
244                                 if not defined $mintime or $_->[1] < $mintime;
245                         $maxtime = $_->[1] + SYS_TICRATE
246                                 if not defined $maxtime or $_->[1] + SYS_TICRATE > $maxtime;
247                 }
248                 elsif($_->[0] eq 'busy')
249                 {
250                         $busytime = $_->[1] + SYS_TICRATE;
251                 }
252         }
253
254         return ($mintime, $maxtime, $busytime);
255 }
256
257 sub busybot_cmd_bot_matchtime($$$@)
258 {
259         my ($bot, $targettime, $targetbusytime, @commands) = @_;
260
261         # I want to execute @commands so that I am free on $targettime and $targetbusytime
262         # when do I execute it then?
263
264         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
265
266         my $tstart_max = defined $maxtime ? $targettime - $maxtime : $targettime;
267         my $tstart_busy = defined $busytime ? $targetbusytime - $busytime : $targettime;
268
269         return $tstart_max < $tstart_busy ? $tstart_max : $tstart_busy;
270 }
271
272 # TODO function to find out whether, and when, to insert a command before another command to make it possible
273 # (note-off before note-on)
274
275 sub busybot_cmd_bot_test($$$@)
276 {
277         my ($bot, $time, $force, @commands) = @_;
278
279         my $bottime = defined $bot->{timer} ? $bot->{timer} : -1;
280         my $botbusytime = defined $bot->{busytimer} ? $bot->{busytimer} : -1;
281
282         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
283
284         if($time < $botbusytime)
285         {
286                 warn "FORCE: $time < $botbusytime"
287                         if $force;
288                 return $force;
289         }
290         
291         if(defined $mintime and $time + $mintime < $bottime)
292         {
293                 warn "FORCE: $time + $mintime < $bottime"
294                         if $force;
295                 return $force;
296         }
297         
298         return 1;
299 }
300
301 sub busybot_cmd_bot_execute($$@)
302 {
303         my ($bot, $time, @commands) = @_;
304
305         for(@commands)
306         {
307                 if($_->[0] eq 'time')
308                 {
309                         $commands .= sprintf "sv_cmd bot_cmd %d wait_until %f\n", $bot->{id}, $time + $_->[1];
310                         if($bot->{timer} > $time + $_->[1] + SYS_TICRATE)
311                         {
312                                 #use Carp; carp "Negative wait: $bot->{timer} <= @{[$time + $_->[1] + SYS_TICRATE]}";
313                         }
314                         $bot->{timer} = $time + $_->[1] + SYS_TICRATE;
315                 }
316                 elsif($_->[0] eq 'busy')
317                 {
318                         $bot->{busytimer} = $time + $_->[1] + SYS_TICRATE;
319                 }
320                 elsif($_->[0] eq 'buttons')
321                 {
322                         my %buttons_release = %{$bot->{buttons} ||= {}};
323                         for(@{$_}[1..@$_-1])
324                         {
325                                 /(.*)\??/ or next;
326                                 delete $buttons_release{$1};
327                         }
328                         for(keys %buttons_release)
329                         {
330                                 $commands .= sprintf "sv_cmd bot_cmd %d releasekey %s\n", $bot->{id}, $_;
331                                 delete $bot->{buttons}->{$_};
332                         }
333                         for(@{$_}[1..@$_-1])
334                         {
335                                 /(.*)(\?)?/ or next;
336                                 defined $2 and next;
337                                 $commands .= sprintf "sv_cmd bot_cmd %d presskey %s\n", $bot->{id}, $_;
338                                 $bot->{buttons}->{$_} = 1;
339                         }
340                 }
341                 elsif($_->[0] eq 'cmd')
342                 {
343                         $commands .= sprintf "sv_cmd bot_cmd %d %s\n", $bot->{id}, join " ", @{$_}[1..@$_-1];
344                 }
345                 elsif($_->[0] eq 'aim_random')
346                 {
347                         $commands .= sprintf "sv_cmd bot_cmd %d aim %f 0 %f\n", $bot->{id}, $_->[1] + rand($_->[2] - $_->[1]), $_->[3];
348                 }
349                 elsif($_->[0] eq 'barrier')
350                 {
351                         $commands .= sprintf "sv_cmd bot_cmd %d barrier\n", $bot->{id};
352                         $bot->{timer} = $bot->{busytimer} = 0;
353                         undef $bot->{lastuse};
354                 }
355                 elsif($_->[0] eq 'raw')
356                 {
357                         $commands .= sprintf "%s\n", join " ", @{$_}[1..@$_-1];
358                 }
359         }
360
361         return 1;
362 }
363
364 my $intermissions = 0;
365
366 sub busybot_intermission_bot($)
367 {
368         my ($bot) = @_;
369         busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preintermission];
370         busybot_cmd_bot_execute $bot, 0, ['barrier'];
371         if($bot->{intermission})
372         {
373                 busybot_cmd_bot_execute $bot, 0, @{$bot->{intermission}};
374         }
375         busybot_cmd_bot_execute $bot, 0, ['barrier'];
376         $notetime = $timeoffset_postintermission - $lowestnotestart;
377 }
378
379 #my $busy = 0;
380 sub busybot_note_off_bot($$$$)
381 {
382         my ($bot, $time, $channel, $note) = @_;
383         #print STDERR "note off $bot:$time:$channel:$note\n";
384         my ($busychannel, $busynote, $cmds) = @{$bot->{busy}};
385         return 1
386                 if not defined $cmds; # note off cannot fail
387         die "Wrong note-off?!?"
388                 if $busychannel != $channel || $busynote ne $note;
389         $bot->{busy} = undef;
390
391         my $t = $time + $notetime;
392         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
393
394         # perform note-off "as soon as we can"
395         $t = $bot->{busytimer}
396                 if $t < $bot->{busytimer};
397         $t = $bot->{timer} - $mintime
398                 if $t < $bot->{timer} - $mintime;
399
400         busybot_cmd_bot_execute $bot, $t, @$cmds; 
401         return 1;
402 }
403
404 sub busybot_get_cmds_bot($$$)
405 {
406         my ($bot, $channel, $note) = @_;
407         my ($k0, $k1, $cmds, $cmds_off) = (undef, undef, undef, undef);
408         if($channel <= 0)
409         {
410                 # vocals
411                 $cmds = $bot->{vocals};
412                 if(defined $cmds)
413                 {
414                         $cmds = [ map { [ map { $_ eq '%s' ? $note : $_ } @$_ ] } @$cmds ];
415                 }
416                 $k0 = "vocals";
417                 $k1 = $channel;
418         }
419         elsif($channel == 10)
420         {
421                 # percussion
422                 $cmds = $bot->{percussion}->{$note};
423                 $k0 = "percussion";
424                 $k1 = $note;
425         }
426         else
427         {
428                 # music
429                 $cmds = $bot->{notes_on}->{$note - ($bot->{transpose} || 0) - $transpose};
430                 $cmds_off = $bot->{notes_off}->{$note - ($bot->{transpose} || 0) - $transpose};
431                 $k0 = "note";
432                 $k1 = $note - ($bot->{transpose} || 0) - $transpose;
433         }
434         return ($cmds, $cmds_off, $k0, $k1);
435 }
436
437 sub busybot_note_on_bot($$$$$$$)
438 {
439         my ($bot, $time, $channel, $program, $note, $init, $force) = @_;
440         return -1 # I won't play on this channel
441                 if defined $bot->{channels} and not $bot->{channels}->{$channel};
442         return -1 # I won't play this program
443                 if defined $bot->{programs} and not $bot->{programs}->{$program};
444
445         my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot($bot, $channel, $note);
446
447         return -1 # I won't play this note
448                 if not defined $cmds;
449         return 0
450                 if $bot->{busy};
451         #print STDERR "note on $bot:$time:$channel:$note\n";
452         if($init)
453         {
454                 return 0
455                         if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds; 
456                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
457                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
458                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
459                         if @{$bot->{init}};
460                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
461                 for(1..$intermissions)
462                 {
463                         busybot_intermission_bot $bot;
464                 }
465                 # we always did a barrier, so we know this works
466                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds; 
467         }
468         else
469         {
470                 return 0
471                         if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds; 
472                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds; 
473         }
474         if(defined $cmds and defined $cmds_off)
475         {
476                 $bot->{busy} = [$channel, $note, $cmds_off];
477         }
478         ++$bot->{seen}{$k0}{$k1};
479
480         if(($bot->{lastuse} // -666) >= $time - $time_forgetfulness && $channel == $bot->{lastchannel})
481         {
482                 $bot->{lastchannelsequence} += 1;
483         }
484         else
485         {
486                 $bot->{lastchannelsequence} = 1;
487         }
488         $bot->{lastuse} = $time;
489         $bot->{lastchannel} = $channel;
490
491 #       print STDERR "$time $bot->{id} $channel:$note\n"
492 #               if $channel == 11;
493
494         return 1;
495 }
496
497 sub busybots_reset()
498 {
499         $busybots = Storable::dclone $busybots_orig;
500         @busybots_allocated = ();
501         %notechannelbots = ();
502         $transpose = 0;
503         $notetime = $timeoffset_postinit - $lowestnotestart;
504 }
505
506 sub busybot_note_off($$$)
507 {
508         my ($time, $channel, $note) = @_;
509
510 #       print STDERR "note off $time:$channel:$note\n";
511
512         return 0
513                 if $channel <= 0;
514         return 0
515                 if $channel == 10;
516
517         if(my $bot = $notechannelbots{$channel}{$note})
518         {
519                 busybot_note_off_bot $bot, $time, $channel, $note;
520                 delete $notechannelbots{$channel}{$note};
521                 return 1;
522         }
523
524         return 0;
525 }
526
527 sub botsort($$$$@)
528 {
529         my ($time, $channel, $program, $note, @bots) = @_;
530         return
531                 map
532                 {
533                         $_->[0]
534                 }
535                 sort
536                 {
537                         $b->[1] <=> $a->[1]
538                         or
539                         ($a->[0]->{lastuse} // -666) <=> ($b->[0]->{lastuse} // -666)
540                         or
541                         $a->[2] <=> $b->[2]
542                 }
543                 map
544                 {
545                         my $q = 0;
546                         if($channel != 10) # percussion just should do round robin
547                         {
548                                 if(($_->{lastuse} // -666) >= $time - $time_forgetfulness)
549                                 {
550                                         if($channel == $_->{lastchannel})
551                                         {
552                                                 $q += $_->{lastchannelsequence};
553                                         }
554                                         else
555                                         {
556                                                 # better leave this one alone
557                                                 $q -= $_->{lastchannelsequence};
558                                         }
559                                 }
560                         }
561                         [$_, $q, rand]
562                 }
563                 @bots;
564 }
565
566 sub busybot_note_on($$$$)
567 {
568         my ($time, $channel, $program, $note) = @_;
569
570         if($notechannelbots{$channel}{$note})
571         {
572                 busybot_note_off $time, $channel, $note;
573         }
574
575 #       print STDERR "note on $time:$channel:$note\n";
576
577         my $overflow = 0;
578
579         my @epicfailbots = ();
580
581         for(botsort $time, $channel, $program, $note, @busybots_allocated)
582         {
583                 my $canplay = busybot_note_on_bot $_, $time, $channel, $program, $note, 0, 0;
584                 if($canplay > 0)
585                 {
586                         $notechannelbots{$channel}{$note} = $_;
587                         return 1;
588                 }
589                 push @epicfailbots, $_
590                         if $canplay == 0;
591                 # wrong
592         }
593
594         my $needalloc = 0;
595
596         for(unsort keys %$busybots)
597         {
598                 next if $busybots->{$_}->{count} <= 0;
599                 my $bot = Storable::dclone $busybots->{$_};
600                 $bot->{id} = @busybots_allocated + 1;
601                 $bot->{classname} = $_;
602                 my $canplay = busybot_note_on_bot $bot, $time, $channel, $program, $note, 1, 0;
603                 if($canplay > 0)
604                 {
605                         if($noalloc)
606                         {
607                                 $needalloc = 1;
608                         }
609                         else
610                         {
611                                 --$busybots->{$_}->{count};
612                                 $notechannelbots{$channel}{$note} = $bot;
613                                 push @busybots_allocated, $bot;
614                                 return 1;
615                         }
616                 }
617                 die "Fresh bot cannot play stuff"
618                         if $canplay == 0;
619         }
620
621         if(@epicfailbots)
622         {
623                 # we cannot add a new bot to play this
624                 # we could try finding a bot that could play this, and force him to stop the note!
625
626                 my @candidates = (); # contains: [$bot, $score, $offtime]
627
628                 # put in all currently busy bots that COULD play this, if they did a note-off first
629                 for my $bot(@epicfailbots)
630                 {
631                         next
632                                 if $busybots->{$bot->{classname}}->{count} != 0;
633                         next
634                                 unless $bot->{busy};
635                         my ($busy_chan, $busy_note, $busy_cmds_off) = @{$bot->{busy}};
636                         next
637                                 unless $busy_cmds_off;
638                         my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot $bot, $channel, $note;
639                         next
640                                 unless $cmds;
641                         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
642                         my ($mintime_off, $maxtime_off, $busytime_off) = busybot_cmd_bot_cmdinfo @$busy_cmds_off;
643
644                         my $noteofftime = busybot_cmd_bot_matchtime $bot, $time + $notetime + $mintime, $time + $notetime, @$busy_cmds_off;
645                         next
646                                 if $noteofftime < $bot->{busytimer};
647                         next
648                                 if $noteofftime + $mintime_off < $bot->{timer};
649
650                         my $score = 0;
651                         # prefer turning off long notes
652                         $score +=  100 * ($noteofftime - $bot->{timer});
653                         # prefer turning off low notes
654                         $score +=    1 * (-$note);
655                         # prefer turning off notes that already play on another channel
656                         $score += 1000 * (grep { $_ != $busy_chan && $notechannelbots{$_}{$busy_note} && $notechannelbots{$_}{$busy_note}{busy} } keys %notechannelbots);
657
658                         push @candidates, [$bot, $score, $noteofftime];
659                 }
660
661                 # we found one?
662
663                 if(@candidates)
664                 {
665                         @candidates = sort { $a->[1] <=> $b->[1] } @candidates;
666                         my ($bot, $score, $offtime) = @{(pop @candidates)};
667                         my $oldchan = $bot->{busy}->[0];
668                         my $oldnote = $bot->{busy}->[1];
669                         busybot_note_off $offtime - $notetime, $oldchan, $oldnote;
670                         my $canplay = busybot_note_on_bot $bot, $time, $channel, $program, $note, 0, 1;
671                         die "Canplay but not?"
672                                 if $canplay <= 0;
673                         warn "Made $channel:$note play by stopping $oldchan:$oldnote";
674                         $notechannelbots{$channel}{$note} = $bot;
675                         return 1;
676                 }
677         }
678
679         die "noalloc\n"
680                 if $needalloc;
681
682         if(@epicfailbots)
683         {
684                 warn "Not enough bots to play this (when playing $channel:$note)";
685 #               for(@epicfailbots)
686 #               {
687 #                       my $b = $_->{busy};
688 #                       warn "$_->{classname} -> @{[$b ? qq{$b->[0]:$b->[1]} : 'none']} @{[$_->{timer} - $notetime]} ($time)\n";
689 #               }
690         }
691         else
692         {
693                 warn "Note $channel:$note cannot be played by any bot";
694         }
695
696         return 0;
697 }
698
699 sub Preallocate(@)
700 {
701         my (@preallocate) = @_;
702         busybots_reset();
703         for(@preallocate)
704         {
705                 die "Cannot preallocate any more $_ bots"
706                         if $busybots->{$_}->{count} <= 0;
707                 my $bot = Storable::dclone $busybots->{$_};
708                 $bot->{id} = @busybots_allocated + 1;
709                 $bot->{classname} = $_;
710                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
711                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
712                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
713                         if @{$bot->{init}};
714                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
715                 --$busybots->{$_}->{count};
716                 push @busybots_allocated, $bot;
717         }
718 }
719
720 sub ConvertMIDI($$)
721 {
722         my ($filename, $trans) = @_;
723         $transpose = $trans;
724
725         my $opus = MIDI::Opus->new({from_file => $filename});
726         my $ticksperquarter = $opus->ticks();
727         my $tracks = $opus->tracks_r();
728         my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
729         my $tick;
730
731         $tick = 0;
732         for($tracks->[0]->events())
733         {   
734                 $tick += $_->[1];
735                 if($_->[0] eq 'set_tempo')
736                 {   
737                         push @tempi, [$tick, $_->[2] * 0.000001 / $ticksperquarter];
738                 }
739         }
740         my $tick2sec = sub
741         {
742                 my ($tick) = @_;
743                 my $sec = 0;
744                 my $curtempo = [0, 0.5 / $ticksperquarter];
745                 for(@tempi)
746                 {
747                         if($_->[0] < $tick)
748                         {
749                                 # this event is in the past
750                                 # we add the full time since the last one then
751                                 $sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
752                         }   
753                         else
754                         {
755                                 # if this event is in the future, we break
756                                 last;
757                         }
758                         $curtempo = $_;
759                 }
760                 $sec += ($tick - $curtempo->[0]) * $curtempo->[1];
761                 return $sec;
762         };
763
764         # merge all to a single track
765         my @allmidievents = ();
766         my $sequence = 0;
767         for my $track(0..@$tracks-1)
768         {
769                 $tick = 0;
770                 for($tracks->[$track]->events())
771                 {
772                         my ($command, $delta, @data) = @$_;
773                         $command = 'note_off' if $command eq 'note_on' and $data[2] == 0;
774                         $tick += $delta;
775                         push @allmidievents, [$command, $tick, $sequence++, $track, @data];
776                 }
777         }
778
779         if(open my $fh, "$filename.vocals")
780         {
781                 my $scale = 1;
782                 my $shift = 0;
783                 for(<$fh>)
784                 {
785                         chomp;
786                         my ($tick, $file) = split /\s+/, $_;
787                         if($tick eq 'scale')
788                         {
789                                 $scale = $file;
790                         }
791                         elsif($tick eq 'shift')
792                         {
793                                 $shift = $file;
794                         }
795                         else
796                         {
797                                 push @allmidievents, ['note_on', $tick * $scale + $shift, $sequence++, -1, -1, $file];
798                                 push @allmidievents, ['note_off', $tick * $scale + $shift, $sequence++, -1, -1, $file];
799                         }
800                 }
801         }
802
803         @allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
804
805         my %midinotes = ();
806         my $notes_stuck = 0;
807         my %notes_seen = ();
808         my %programs = ();
809         my $t = 0;
810         my %sustain = ();
811
812         my $note_on = sub
813         {
814                 my ($ev) = @_;
815                 my $chan = $ev->[4] + 1;
816                 ++$notes_seen{$chan}{($programs{$chan} || 1)}{$ev->[5]};
817                 if($midinotes{$chan}{$ev->[5]})
818                 {
819                         --$notes_stuck;
820                         busybot_note_off($t - SYS_TICRATE - 0.001, $chan, $ev->[5]);
821                 }
822                 busybot_note_on($t, $chan, $programs{$chan} || 1, $ev->[5]);
823                 ++$notes_stuck;
824                 $midinotes{$chan}{$ev->[5]} = 1;
825         };
826
827         my $note_off = sub
828         {
829                 my ($ev) = @_;
830                 my $chan = $ev->[4] + 1;
831                 if(exists $sustain{$chan})
832                 {
833                         push @{$sustain{$chan}}, $ev;
834                         return;
835                 }
836                 if($midinotes{$chan}{$ev->[5]})
837                 {
838                         --$notes_stuck;
839                         busybot_note_off($t - SYS_TICRATE - 0.001, $chan, $ev->[5]);
840                 }
841                 $midinotes{$chan}{$ev->[5]} = 0;
842         };
843
844         my $patch_change = sub
845         {
846                 my ($ev) = @_;
847                 my $chan = $ev->[4] + 1;
848                 my $program = $ev->[5] + 1;
849                 $programs{$chan} = $program;
850         };
851
852         my $sustain_change = sub
853         {
854                 my ($ev) = @_;
855                 my $chan = $ev->[4] + 1;
856                 if($ev->[6] == 0)
857                 {
858                         # release all currently not pressed notes
859                         my $s = $sustain{$chan};
860                         delete $sustain{$chan};
861                         for(@{($s || [])})
862                         {
863                                 $note_off->($_);
864                         }
865                 }
866                 else
867                 {
868                         # no more note-off
869                         $sustain{$chan} = [];
870                 }
871         };
872
873         for(@allmidievents)
874         {
875                 $t = $tick2sec->($_->[1]);
876                 # my $track = $_->[3];
877                 if($_->[0] eq 'note_on')
878                 {
879                         $note_on->($_);
880                 }
881                 elsif($_->[0] eq 'note_off')
882                 {
883                         $note_off->($_);
884                 }
885                 elsif($_->[0] eq 'patch_change')
886                 {
887                         $patch_change->($_);
888                 }
889                 elsif($_->[0] eq 'control_change' && $_->[5] == 64) # sustain pedal
890                 {
891                         $sustain_change->($_);
892                 }
893         }
894
895         # fake events for releasing pedal
896         for(keys %sustain)
897         {
898                 $sustain_change->(['control_change', $t, undef, undef, $_ - 1, 64, 0]);
899         }
900
901         print STDERR "For file $filename:\n";
902         print STDERR "  Stuck notes: $notes_stuck\n";
903
904         for my $testtranspose(-127..127)
905         {
906                 my $toohigh = 0;
907                 my $toolow = 0;
908                 my $good = 0;
909                 for my $channel(sort keys %notes_seen)
910                 {
911                         next if $channel == 10 or $channel < 0;
912                         for my $program(sort keys %{$notes_seen{$channel}})
913                         {
914                                 for my $note(sort keys %{$notes_seen{$channel}{$program}})
915                                 {
916                                         my $cnt = $notes_seen{$channel}{$program}{$note};
917                                         my $votehigh = 0;
918                                         my $votelow = 0;
919                                         my $votegood = 0;
920                                         for(@busybots_allocated, grep { $_->{count} > 0 } values %$busybots)
921                                         {
922                                                 next # I won't play on this channel
923                                                         if defined $_->{channels} and not $_->{channels}->{$channel};
924                                                 next # I won't play this program
925                                                         if defined $_->{programs} and not $_->{programs}->{$program};
926                                                 my $transposed = $note - ($_->{transpose} || 0) - $testtranspose;
927                                                 if(exists $_->{notes_on}{$transposed})
928                                                 {
929                                                         ++$votegood;
930                                                 }
931                                                 else
932                                                 {
933                                                         ++$votehigh if $transposed >= 0;
934                                                         ++$votelow if $transposed < 0;
935                                                 }
936                                         }
937                                         if($votegood)
938                                         {
939                                                 $good += $cnt;
940                                         }
941                                         elsif($votelow >= $votehigh)
942                                         {
943                                                 $toolow += $cnt;
944                                         }
945                                         else
946                                         {
947                                                 $toohigh += $cnt;
948                                         }
949                                 }
950                         }
951                 }
952                 next if !$toohigh != !$toolow;
953                 print STDERR "  Transpose $testtranspose: $toohigh too high, $toolow too low, $good good\n";
954         }
955
956         for my $program(sort keys %{$notes_seen{10}})
957         {
958                 for my $note(sort keys %{$notes_seen{10}{$program}})
959                 {
960                         my $cnt = $notes_seen{10}{$program}{$note};
961                         my $votegood = 0;
962                         for(@busybots_allocated)
963                         {
964                                 next # I won't play on this channel
965                                         if defined $_->{channels} and not $_->{channels}->{10};
966                                 next # I won't play this program
967                                         if defined $_->{programs} and not $_->{programs}->{$program};
968                                 if(exists $_->{percussion}{$note})
969                                 {
970                                         ++$votegood;
971                                 }
972                         }
973                         if(!$votegood)
974                         {
975                                 print STDERR "Failed percussion $note ($cnt times)\n";
976                         }
977                 }
978         }
979
980         while(my ($k1, $v1) = each %midinotes)
981         {
982                 while(my ($k2, $v2) = each %$v1)
983                 {
984                         busybot_note_off($t, $k1, $k2);
985                 }
986         }
987
988         for(@busybots_allocated)
989         {
990                 busybot_intermission_bot $_;
991         }
992         ++$intermissions;
993 }
994
995 sub Deallocate()
996 {
997         print STDERR "Bots allocated:\n";
998         my %notehash;
999         my %counthash;
1000         for(@busybots_allocated)
1001         {
1002                 print STDERR "$_->{id} is a $_->{classname}\n";
1003                 ++$counthash{$_->{classname}};
1004                 while(my ($type, $notehash) = each %{$_->{seen}})
1005                 {
1006                         while(my ($k, $v) = each %$notehash)
1007                         {
1008                                 $notehash{$_->{classname}}{$type}{$k} += $v;
1009                         }
1010                 }
1011         }
1012         for my $cn(sort keys %counthash)
1013         {
1014                 print STDERR "$counthash{$cn} bots of $cn have played:\n";
1015                 for my $type(sort keys %{$notehash{$cn}})
1016                 {
1017                         for my $note(sort { $a <=> $b } keys %{$notehash{$cn}{$type}})
1018                         {
1019                                 my $cnt = $notehash{$cn}{$type}{$note};
1020                                 print STDERR "  $type $note ($cnt times)\n";
1021                         }
1022                 }
1023         }
1024         for(@busybots_allocated)
1025         {
1026                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_predone];
1027                 busybot_cmd_bot_execute $_, 0, ['barrier'];
1028                 if($_->{done})
1029                 {
1030                         busybot_cmd_bot_execute $_, 0, @{$_->{done}};
1031                 }
1032                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_postdone];
1033                 busybot_cmd_bot_execute $_, 0, ['barrier'];
1034         }
1035 }
1036
1037 my @preallocate = ();
1038 $noalloc = 0;
1039 for(;;)
1040 {
1041         $commands = "";
1042         eval
1043         {
1044                 Preallocate(@preallocate);
1045                 my @l = @midilist;
1046                 while(@l)
1047                 {
1048                         my $filename = shift @l;
1049                         my $transpose = shift @l;
1050                         ConvertMIDI($filename, $transpose);
1051                 }
1052                 Deallocate();
1053                 my @preallocate_new = map { $_->{classname} } @busybots_allocated;
1054                 if(@preallocate_new == @preallocate)
1055                 {
1056                         print "sv_cmd bot_cmd reset\n";
1057                         print "sv_cmd bot_cmd setbots @{[scalar @preallocate_new]}\n";
1058                         print "$precommands$commands";
1059                         exit 0;
1060                 }
1061                 @preallocate = @preallocate_new;
1062                 $noalloc = 1;
1063                 1;
1064         } or do {
1065                 die "$@"
1066                         unless $@ eq "noalloc\n";
1067         };
1068 }