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 timeoffset_preinit timeoffset_postinit timeoffset_predone timeoffset_postdone timeoffset_preintermission timeoffset_postintermission midifile1 transpose1 midifile2 transpose2 ..."
  19         unless @ARGV > 7 and @ARGV % 2;
  20 my ($config, $timeoffset_preinit, $timeoffset_postinit, $timeoffset_predone, $timeoffset_postdone, $timeoffset_preintermission, $timeoffset_postintermission, @midilist) = @ARGV;
  21
  22 sub unsort(@)
  23 {
  24         return map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } @_;
  25 }
  26
  27 sub override($$);
  28 sub override($$)
  29 {
  30         my ($dest, $src) = @_;
  31         if(ref $src eq 'HASH')
  32         {
  33                 $dest = {}
  34                         if not defined $dest;
  35                 for(keys %$src)
  36                 {
  37                         $dest->{$_} = override $dest->{$_}, $src->{$_};
  38                 }
  39         }
  40         elsif(ref $src eq 'ARRAY')
  41         {
  42                 $dest = []
  43                         if not defined $dest;
  44                 for(@$src)
  45                 {
  46                         push @$dest, override undef, $_;
  47                 }
  48         }
  49         elsif(ref $src)
  50         {
  51                 $dest = Storable::dclone $src;
  52         }
  53         else
  54         {
  55                 $dest = $src;
  56         }
  57         return $dest;
  58 }
  59
  60 my $precommands = "";
  61 my $commands = "";
  62 my $busybots;
  63 my @busybots_allocated;
  64 my %notechannelbots;
  65 my $transpose = 0;
  66 my $notetime = undef;
  67 my $lowestnotestart = undef;
  68 my $noalloc = 0;
  69 sub botconfig_read($)
  70 {
  71         my ($fn) = @_;
  72         my %bots = ();
  73         open my $fh, "<", $fn
  74                 or die "<$fn: $!";
  75
  76         my $currentbot = undef;
  77         my $appendref = undef;
  78         my $super = undef;
  79         while(<$fh>)
  80         {
  81                 chomp;
  82                 s/\s*#.*//;
  83                 next if /^$/;
  84                 if(s/^\t\t//)
  85                 {
  86                         my @cmd = split /\s+/, $_;
  87                         if($cmd[0] eq 'super')
  88                         {
  89                                 push @$appendref, @$super
  90                                         if $super;
  91                         }
  92                         elsif($cmd[0] eq 'percussion') # simple import
  93                         {
  94                                 push @$appendref, @{$currentbot->{percussion}->{$cmd[1]}};
  95                         }
  96                         else
  97                         {
  98                                 push @$appendref, \@cmd;
  99                         }
 100                 }
 101                 elsif(s/^\t//)
 102                 {
 103                         if(/^include (.*)/)
 104                         {
 105                                 my $base = $bots{$1};
 106                                 $currentbot = override $currentbot, $base;
 107                         }
 108                         elsif(/^count (\d+)/)
 109                         {
 110                                 $currentbot->{count} = $1;
 111                         }
 112                         elsif(/^transpose (\d+)/)
 113                         {
 114                                 $currentbot->{transpose} ||= 0;
 115                                 $currentbot->{transpose} += $1;
 116                         }
 117                         elsif(/^channels (.*)/)
 118                         {
 119                                 $currentbot->{channels} = { map { $_ => 1 } split /\s+/, $1 };
 120                         }
 121                         elsif(/^init$/)
 122                         {
 123                                 $super = $currentbot->{init};
 124                                 $currentbot->{init} = $appendref = [];
 125                         }
 126                         elsif(/^intermission$/)
 127                         {
 128                                 $super = $currentbot->{intermission};
 129                                 $currentbot->{intermission} = $appendref = [];
 130                         }
 131                         elsif(/^done$/)
 132                         {
 133                                 $super = $currentbot->{done};
 134                                 $currentbot->{done} = $appendref = [];
 135                         }
 136                         elsif(/^note on (-?\d+)/)
 137                         {
 138                                 $super = $currentbot->{notes_on}->{$1};
 139                                 $currentbot->{notes_on}->{$1} = $appendref = [];
 140                         }
 141                         elsif(/^note off (-?\d+)/)
 142                         {
 143                                 $super = $currentbot->{notes_off}->{$1};
 144                                 $currentbot->{notes_off}->{$1} = $appendref = [];
 145                         }
 146                         elsif(/^percussion (\d+)/)
 147                         {
 148                                 $super = $currentbot->{percussion}->{$1};
 149                                 $currentbot->{percussion}->{$1} = $appendref = [];
 150                         }
 151                         elsif(/^vocals$/)
 152                         {
 153                                 $super = $currentbot->{vocals};
 154                                 $currentbot->{vocals} = $appendref = [];
 155                         }
 156                         else
 157                         {
 158                                 print "unknown command: $_\n";
 159                         }
 160                 }
 161                 elsif(/^bot (.*)/)
 162                 {
 163                         $currentbot = ($bots{$1} ||= {count => 0});
 164                 }
 165                 elsif(/^raw (.*)/)
 166                 {
 167                         $precommands .= "$1\n";
 168                 }
 169                 else
 170                 {
 171                         print "unknown command: $_\n";
 172                 }
 173         }
 174
 175         for(values %bots)
 176         {
 177                 for(values %{$_->{notes_on}}, values %{$_->{percussion}})
 178                 {
 179                         my $t = $_->[0]->[0] eq 'time' ? $_->[0]->[1] : 0;
 180                         $lowestnotestart = $t if not defined $lowestnotestart or $t < $lowestnotestart;
 181                 }
 182         }
 183
 184         return \%bots;
 185 }
 186 my $busybots_orig = botconfig_read $config;
 187
 188
 189 # returns: ($mintime, $maxtime, $busytime)
 190 sub busybot_cmd_bot_cmdinfo(@)
 191 {
 192         my (@commands) = @_;
 193
 194         my $mintime = undef;
 195         my $maxtime = undef;
 196         my $busytime = undef;
 197
 198         for(@commands)
 199         {
 200                 if($_->[0] eq 'time')
 201                 {
 202                         $mintime = $_->[1]
 203                                 if not defined $mintime or $_->[1] < $mintime;
 204                         $maxtime = $_->[1] + SYS_TICRATE
 205                                 if not defined $maxtime or $_->[1] > $maxtime;
 206                 }
 207                 elsif($_->[0] eq 'busy')
 208                 {
 209                         $busytime = $_->[1] + SYS_TICRATE;
 210                 }
 211         }
 212
 213         return ($mintime, $maxtime, $busytime);
 214 }
 215
 216 sub busybot_cmd_bot_matchtime($$$@)
 217 {
 218         my ($bot, $targettime, $targetbusytime, @commands) = @_;
 219
 220         # I want to execute @commands so that I am free on $targettime and $targetbusytime
 221         # when do I execute it then?
 222
 223         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
 224
 225         my $tstart_max = defined $maxtime ? $targettime - $maxtime : $targettime;
 226         my $tstart_busy = defined $busytime ? $targetbusytime - $busytime : $targettime;
 227
 228         return $tstart_max < $tstart_busy ? $tstart_max : $tstart_busy;
 229 }
 230
 231 # TODO function to find out whether, and when, to insert a command before another command to make it possible
 232 # (note-off before note-on)
 233
 234 sub busybot_cmd_bot_test($$$@)
 235 {
 236         my ($bot, $time, $force, @commands) = @_;
 237
 238         my $bottime = defined $bot->{timer} ? $bot->{timer} : -1;
 239         my $botbusytime = defined $bot->{busytimer} ? $bot->{busytimer} : -1;
 240
 241         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
 242
 243         if($time < $botbusytime)
 244         {
 245                 warn "FORCE: $time < $botbusytime"
 246                         if $force;
 247                 return $force;
 248         }
 249
 250         if(defined $mintime and $time + $mintime < $bottime)
 251         {
 252                 warn "FORCE: $time + $mintime < $bottime"
 253                         if $force;
 254                 return $force;
 255         }
 256
 257         return 1;
 258 }
 259
 260 sub busybot_cmd_bot_execute($$@)
 261 {
 262         my ($bot, $time, @commands) = @_;
 263
 264         for(@commands)
 265         {
 266                 if($_->[0] eq 'time')
 267                 {
 268                         $commands .= sprintf "sv_cmd bot_cmd %d wait_until %f\n", $bot->{id}, $time + $_->[1];
 269                         if($bot->{timer} > $time + $_->[1] + SYS_TICRATE)
 270                         {
 271                                 #use Carp; carp "Negative wait: $bot->{timer} <= @{[$time + $_->[1] + SYS_TICRATE]}";
 272                         }
 273                         $bot->{timer} = $time + $_->[1] + SYS_TICRATE;
 274                 }
 275                 elsif($_->[0] eq 'busy')
 276                 {
 277                         $bot->{busytimer} = $time + $_->[1] + SYS_TICRATE;
 278                 }
 279                 elsif($_->[0] eq 'buttons')
 280                 {
 281                         my %buttons_release = %{$bot->{buttons} ||= {}};
 282                         for(@{$_}[1..@$_-1])
 283                         {
 284                                 /(.*)\??/ or next;
 285                                 delete $buttons_release{$1};
 286                         }
 287                         for(keys %buttons_release)
 288                         {
 289                                 $commands .= sprintf "sv_cmd bot_cmd %d releasekey %s\n", $bot->{id}, $_;
 290                                 delete $bot->{buttons}->{$_};
 291                         }
 292                         for(@{$_}[1..@$_-1])
 293                         {
 294                                 /(.*)(\?)?/ or next;
 295                                 defined $2 and next;
 296                                 $commands .= sprintf "sv_cmd bot_cmd %d presskey %s\n", $bot->{id}, $_;
 297                                 $bot->{buttons}->{$_} = 1;
 298                         }
 299                 }
 300                 elsif($_->[0] eq 'cmd')
 301                 {
 302                         $commands .= sprintf "sv_cmd bot_cmd %d %s\n", $bot->{id}, join " ", @{$_}[1..@$_-1];
 303                 }
 304                 elsif($_->[0] eq 'barrier')
 305                 {
 306                         $commands .= sprintf "sv_cmd bot_cmd %d barrier\n", $bot->{id};
 307                         $bot->{timer} = $bot->{busytimer} = 0;
 308                 }
 309                 elsif($_->[0] eq 'raw')
 310                 {
 311                         $commands .= sprintf "%s\n", join " ", @{$_}[1..@$_-1];
 312                 }
 313         }
 314
 315         return 1;
 316 }
 317
 318 my $intermissions = 0;
 319
 320 sub busybot_intermission_bot($)
 321 {
 322         my ($bot) = @_;
 323         busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preintermission];
 324         busybot_cmd_bot_execute $bot, 0, ['barrier'];
 325         if($bot->{intermission})
 326         {
 327                 busybot_cmd_bot_execute $bot, 0, @{$bot->{intermission}};
 328         }
 329         busybot_cmd_bot_execute $bot, 0, ['barrier'];
 330         $notetime = $timeoffset_postintermission - $lowestnotestart;
 331 }
 332
 333 #my $busy = 0;
 334 sub busybot_note_off_bot($$$$)
 335 {
 336         my ($bot, $time, $channel, $note) = @_;
 337         #print STDERR "note off $bot:$time:$channel:$note\n";
 338         my ($busychannel, $busynote, $cmds) = @{$bot->{busy}};
 339         return 1
 340                 if not defined $cmds; # note off cannot fail
 341         die "Wrong note-off?!?"
 342                 if $busychannel != $channel || $busynote ne $note;
 343         $bot->{busy} = undef;
 344
 345         my $t = $time + $notetime;
 346         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
 347
 348         # perform note-off "as soon as we can"
 349         $t = $bot->{busytimer}
 350                 if $t < $bot->{busytimer};
 351         $t = $bot->{timer} - $mintime
 352                 if $t < $bot->{timer} - $mintime;
 353
 354         busybot_cmd_bot_execute $bot, $t, @$cmds;
 355         return 1;
 356 }
 357
 358 sub busybot_get_cmds_bot($$$)
 359 {
 360         my ($bot, $channel, $note) = @_;
 361         my ($k0, $k1, $cmds, $cmds_off) = (undef, undef, undef, undef);
 362         if($channel <= 0)
 363         {
 364                 # vocals
 365                 $cmds = $bot->{vocals};
 366                 if(defined $cmds)
 367                 {
 368                         $cmds = [ map { [ map { $_ eq '%s' ? $note : $_ } @$_ ] } @$cmds ];
 369                 }
 370                 $k0 = "vocals";
 371                 $k1 = $channel;
 372         }
 373         elsif($channel == 10)
 374         {
 375                 # percussion
 376                 $cmds = $bot->{percussion}->{$note};
 377                 $k0 = "percussion";
 378                 $k1 = $note;
 379         }
 380         else
 381         {
 382                 # music
 383                 $cmds = $bot->{notes_on}->{$note - ($bot->{transpose} || 0) - $transpose};
 384                 $cmds_off = $bot->{notes_off}->{$note - ($bot->{transpose} || 0) - $transpose};
 385                 $k0 = "note";
 386                 $k1 = $note - ($bot->{transpose} || 0) - $transpose;
 387         }
 388         return ($cmds, $cmds_off, $k0, $k1);
 389 }
 390
 391 sub busybot_note_on_bot($$$$$$)
 392 {
 393         my ($bot, $time, $channel, $note, $init, $force) = @_;
 394         return -1 # I won't play on this channel
 395                 if defined $bot->{channels} and not $bot->{channels}->{$channel};
 396
 397         my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot($bot, $channel, $note);
 398
 399         return -1 # I won't play this note
 400                 if not defined $cmds;
 401         return 0
 402                 if $bot->{busy};
 403         #print STDERR "note on $bot:$time:$channel:$note\n";
 404         if($init)
 405         {
 406                 return 0
 407                         if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds;
 408                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
 409                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 410                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
 411                         if @{$bot->{init}};
 412                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 413                 for(1..$intermissions)
 414                 {
 415                         busybot_intermission_bot $bot;
 416                 }
 417                 # we always did a barrier, so we know this works
 418                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
 419         }
 420         else
 421         {
 422                 return 0
 423                         if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds;
 424                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
 425         }
 426         if(defined $cmds and defined $cmds_off)
 427         {
 428                 $bot->{busy} = [$channel, $note, $cmds_off];
 429         }
 430         ++$bot->{seen}{$k0}{$k1};
 431         return 1;
 432 }
 433
 434 sub busybots_reset()
 435 {
 436         $busybots = Storable::dclone $busybots_orig;
 437         @busybots_allocated = ();
 438         %notechannelbots = ();
 439         $transpose = 0;
 440         $notetime = $timeoffset_postinit - $lowestnotestart;
 441 }
 442
 443 sub busybot_note_off($$$)
 444 {
 445         my ($time, $channel, $note) = @_;
 446
 447 #       print STDERR "note off $time:$channel:$note\n";
 448
 449         return 0
 450                 if $channel <= 0;
 451         return 0
 452                 if $channel == 10;
 453
 454         if(my $bot = $notechannelbots{$channel}{$note})
 455         {
 456                 busybot_note_off_bot $bot, $time, $channel, $note;
 457                 delete $notechannelbots{$channel}{$note};
 458                 return 1;
 459         }
 460
 461         return 0;
 462 }
 463
 464 sub busybot_note_on($$$)
 465 {
 466         my ($time, $channel, $note) = @_;
 467
 468         if($notechannelbots{$channel}{$note})
 469         {
 470                 busybot_note_off $time, $channel, $note;
 471         }
 472
 473 #       print STDERR "note on $time:$channel:$note\n";
 474
 475         my $overflow = 0;
 476
 477         my @epicfailbots = ();
 478
 479         for(unsort @busybots_allocated)
 480         {
 481                 my $canplay = busybot_note_on_bot $_, $time, $channel, $note, 0, 0;
 482                 if($canplay > 0)
 483                 {
 484                         $notechannelbots{$channel}{$note} = $_;
 485                         return 1;
 486                 }
 487                 push @epicfailbots, $_
 488                         if $canplay == 0;
 489                 # wrong
 490         }
 491
 492         my $needalloc = 0;
 493
 494         for(unsort keys %$busybots)
 495         {
 496                 next if $busybots->{$_}->{count} <= 0;
 497                 my $bot = Storable::dclone $busybots->{$_};
 498                 $bot->{id} = @busybots_allocated + 1;
 499                 $bot->{classname} = $_;
 500                 my $canplay = busybot_note_on_bot $bot, $time, $channel, $note, 1, 0;
 501                 if($canplay > 0)
 502                 {
 503                         if($noalloc)
 504                         {
 505                                 $needalloc = 1;
 506                         }
 507                         else
 508                         {
 509                                 --$busybots->{$_}->{count};
 510                                 $notechannelbots{$channel}{$note} = $bot;
 511                                 push @busybots_allocated, $bot;
 512                                 return 1;
 513                         }
 514                 }
 515                 die "Fresh bot cannot play stuff"
 516                         if $canplay == 0;
 517         }
 518
 519         if(@epicfailbots)
 520         {
 521                 # we cannot add a new bot to play this
 522                 # we could try finding a bot that could play this, and force him to stop the note!
 523
 524                 my @candidates = (); # contains: [$bot, $score, $offtime]
 525
 526                 # put in all currently busy bots that COULD play this, if they did a note-off first
 527                 for my $bot(@epicfailbots)
 528                 {
 529                         next
 530                                 if $busybots->{$bot->{classname}}->{count} != 0;
 531                         next
 532                                 unless $bot->{busy};
 533                         my ($busy_chan, $busy_note, $busy_cmds_off) = @{$bot->{busy}};
 534                         next
 535                                 unless $busy_cmds_off;
 536                         my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot $bot, $channel, $note;
 537                         next
 538                                 unless $cmds;
 539                         my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
 540
 541                         my $noteofftime = busybot_cmd_bot_matchtime $bot, $time + $notetime + $mintime, $time, @$busy_cmds_off;
 542                         next
 543                                 if $noteofftime < $bot->{busytimer};
 544                         next
 545                                 if $noteofftime + $mintime < $bot->{timer};
 546
 547                         my $score = 0;
 548                         # prefer turning off long notes
 549                         $score +=  100 * ($noteofftime - $bot->{timer});
 550                         # prefer turning off low notes
 551                         $score +=    1 * (-$note);
 552                         # prefer turning off notes that already play on another channel
 553                         $score += 1000 * (grep { $_ != $busy_chan && $notechannelbots{$_}{$busy_note} && $notechannelbots{$_}{$busy_note}{busy} } keys %notechannelbots);
 554
 555                         push @candidates, [$bot, $score, $noteofftime];
 556                 }
 557
 558                 # we found one?
 559
 560                 if(@candidates)
 561                 {
 562                         @candidates = sort { $a->[1] <=> $b->[1] } @candidates;
 563                         my ($bot, $score, $offtime) = @{(pop @candidates)};
 564                         my $oldchan = $bot->{busy}->[0];
 565                         my $oldnote = $bot->{busy}->[1];
 566                         busybot_note_off $offtime - $notetime, $oldchan, $oldnote;
 567                         my $canplay = busybot_note_on_bot $bot, $time, $channel, $note, 0, 1;
 568                         die "Canplay but not?"
 569                                 if $canplay <= 0;
 570                         warn "Made $channel:$note play by stopping $oldchan:$oldnote";
 571                         $notechannelbots{$channel}{$note} = $bot;
 572                         return 1;
 573                 }
 574         }
 575
 576         die "noalloc\n"
 577                 if $needalloc;
 578
 579         if(@epicfailbots)
 580         {
 581                 warn "Not enough bots to play this (when playing $channel:$note)";
 582 #               for(@epicfailbots)
 583 #               {
 584 #                       my $b = $_->{busy};
 585 #                       warn "$_->{classname} -> @{[$b ? qq{$b->[0]:$b->[1]} : 'none']} @{[$_->{timer} - $notetime]} ($time)\n";
 586 #               }
 587         }
 588         else
 589         {
 590                 warn "Note $channel:$note cannot be played by any bot";
 591         }
 592
 593         return 0;
 594 }
 595
 596 sub Preallocate(@)
 597 {
 598         my (@preallocate) = @_;
 599         busybots_reset();
 600         for(@preallocate)
 601         {
 602                 die "Cannot preallocate any more $_ bots"
 603                         if $busybots->{$_}->{count} <= 0;
 604                 my $bot = Storable::dclone $busybots->{$_};
 605                 $bot->{id} = @busybots_allocated + 1;
 606                 $bot->{classname} = $_;
 607                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
 608                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 609                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
 610                         if @{$bot->{init}};
 611                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 612                 --$busybots->{$_}->{count};
 613                 push @busybots_allocated, $bot;
 614         }
 615 }
 616
 617 sub ConvertMIDI($$)
 618 {
 619         my ($filename, $trans) = @_;
 620         $transpose = $trans;
 621
 622         my $opus = MIDI::Opus->new({from_file => $filename});
 623         my $ticksperquarter = $opus->ticks();
 624         my $tracks = $opus->tracks_r();
 625         my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
 626         my $tick;
 627
 628         $tick = 0;
 629         for($tracks->[0]->events())
 630         {
 631                 $tick += $_->[1];
 632                 if($_->[0] eq 'set_tempo')
 633                 {
 634                         push @tempi, [$tick, $_->[2] * 0.000001 / $ticksperquarter];
 635                 }
 636         }
 637         my $tick2sec = sub
 638         {
 639                 my ($tick) = @_;
 640                 my $sec = 0;
 641                 my $curtempo = [0, 0.5 / $ticksperquarter];
 642                 for(@tempi)
 643                 {
 644                         if($_->[0] < $tick)
 645                         {
 646                                 # this event is in the past
 647                                 # we add the full time since the last one then
 648                                 $sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
 649                         }
 650                         else
 651                         {
 652                                 # if this event is in the future, we break
 653                                 last;
 654                         }
 655                         $curtempo = $_;
 656                 }
 657                 $sec += ($tick - $curtempo->[0]) * $curtempo->[1];
 658                 return $sec;
 659         };
 660
 661         # merge all to a single track
 662         my @allmidievents = ();
 663         my $sequence = 0;
 664         for my $track(0..@$tracks-1)
 665         {
 666                 $tick = 0;
 667                 for($tracks->[$track]->events())
 668                 {
 669                         my ($command, $delta, @data) = @$_;
 670                         $command = 'note_off' if $command eq 'note_on' and $data[2] == 0;
 671                         $tick += $delta;
 672                         push @allmidievents, [$command, $tick, $sequence++, $track, @data];
 673                 }
 674         }
 675
 676         if(open my $fh, "$filename.vocals")
 677         {
 678                 my $scale = 1;
 679                 my $shift = 0;
 680                 for(<$fh>)
 681                 {
 682                         chomp;
 683                         my ($tick, $file) = split /\s+/, $_;
 684                         if($tick eq 'scale')
 685                         {
 686                                 $scale = $file;
 687                         }
 688                         elsif($tick eq 'shift')
 689                         {
 690                                 $shift = $file;
 691                         }
 692                         else
 693                         {
 694                                 push @allmidievents, ['note_on', $tick * $scale + $shift, $sequence++, -1, -1, $file];
 695                                 push @allmidievents, ['note_off', $tick * $scale + $shift, $sequence++, -1, -1, $file];
 696                         }
 697                 }
 698         }
 699
 700         @allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
 701
 702         my %midinotes = ();
 703         my $note_min = undef;
 704         my $note_max = undef;
 705         my $notes_stuck = 0;
 706         my $t = 0;
 707         for(@allmidievents)
 708         {
 709                 $t = $tick2sec->($_->[1]);
 710                 my $track = $_->[3];
 711                 if($_->[0] eq 'note_on')
 712                 {
 713                         my $chan = $_->[4] + 1;
 714                         $note_min = $_->[5]
 715                                 if $chan != 10 and $chan > 0 and (not defined $note_min or $_->[5] < $note_min);
 716                         $note_max = $_->[5]
 717                                 if $chan != 10 and $chan > 0 and (not defined $note_max or $_->[5] > $note_max);
 718                         if($midinotes{$chan}{$_->[5]})
 719                         {
 720                                 --$notes_stuck;
 721                                 busybot_note_off($t - SYS_TICRATE, $chan, $_->[5]);
 722                         }
 723                         busybot_note_on($t, $chan, $_->[5]);
 724                         ++$notes_stuck;
 725                         $midinotes{$chan}{$_->[5]} = 1;
 726                 }
 727                 elsif($_->[0] eq 'note_off')
 728                 {
 729                         my $chan = $_->[4] + 1;
 730                         if($midinotes{$chan}{$_->[5]})
 731                         {
 732                                 --$notes_stuck;
 733                                 busybot_note_off($t - SYS_TICRATE, $chan, $_->[5]);
 734                         }
 735                         $midinotes{$chan}{$_->[5]} = 0;
 736                 }
 737         }
 738
 739         print STDERR "For file $filename:\n";
 740         print STDERR "  Range of notes: $note_min .. $note_max\n";
 741         print STDERR "  Safe transpose range: @{[$note_max - 19]} .. @{[$note_min + 13]}\n";
 742         print STDERR "  Unsafe transpose range: @{[$note_max - 27]} .. @{[$note_min + 18]}\n";
 743         print STDERR "  Stuck notes: $notes_stuck\n";
 744
 745         while(my ($k1, $v1) = each %midinotes)
 746         {
 747                 while(my ($k2, $v2) = each %$v1)
 748                 {
 749                         busybot_note_off($t, $k1, $k2);
 750                 }
 751         }
 752
 753         for(@busybots_allocated)
 754         {
 755                 busybot_intermission_bot $_;
 756         }
 757         ++$intermissions;
 758 }
 759
 760 sub Deallocate()
 761 {
 762         print STDERR "Bots allocated:\n";
 763         my %notehash;
 764         my %counthash;
 765         for(@busybots_allocated)
 766         {
 767                 print STDERR "$_->{id} is a $_->{classname}\n";
 768                 ++$counthash{$_->{classname}};
 769                 while(my ($type, $notehash) = each %{$_->{seen}})
 770                 {
 771                         while(my ($k, $v) = each %$notehash)
 772                         {
 773                                 $notehash{$_->{classname}}{$type}{$k} += $v;
 774                         }
 775                 }
 776         }
 777         for my $cn(sort keys %counthash)
 778         {
 779                 print STDERR "$counthash{$cn} bots of $cn have played:\n";
 780                 for my $type(sort keys %{$notehash{$cn}})
 781                 {
 782                         for my $note(sort { $a <=> $b } keys %{$notehash{$cn}{$type}})
 783                         {
 784                                 my $cnt = $notehash{$cn}{$type}{$note};
 785                                 print STDERR "  $type $note ($cnt times)\n";
 786                         }
 787                 }
 788         }
 789         for(@busybots_allocated)
 790         {
 791                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_predone];
 792                 busybot_cmd_bot_execute $_, 0, ['barrier'];
 793                 if($_->{done})
 794                 {
 795                         busybot_cmd_bot_execute $_, 0, @{$_->{done}};
 796                 }
 797                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_postdone];
 798                 busybot_cmd_bot_execute $_, 0, ['barrier'];
 799         }
 800 }
 801
 802 my @preallocate = ();
 803 $noalloc = 0;
 804 for(;;)
 805 {
 806         $commands = "";
 807         eval
 808         {
 809                 Preallocate(@preallocate);
 810                 my @l = @midilist;
 811                 while(@l)
 812                 {
 813                         my $filename = shift @l;
 814                         my $transpose = shift @l;
 815                         ConvertMIDI($filename, $transpose);
 816                 }
 817                 Deallocate();
 818                 my @preallocate_new = map { $_->{classname} } @busybots_allocated;
 819                 if(@preallocate_new == @preallocate)
 820                 {
 821                         print "$precommands$commands";
 822                         exit 0;
 823                 }
 824                 @preallocate = @preallocate_new;
 825                 $noalloc = 1;
 826                 1;
 827         } or do {
 828                 die "$@"
 829                         unless $@ eq "noalloc\n";
 830         };
 831 }