misc/tools/midi2cfg-ng.pl

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