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