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