misc/tools/midi2cfg-ng.pl

   1 #!/usr/bin/perl
   2
   3 # converter from Type 1 MIDI files to CFG files that control bots with the Tuba and other weapons for percussion (requires g_weaponarena all)
   4
   5 use strict;
   6 use warnings;
   7 use MIDI;
   8 use MIDI::Opus;
   9 use Storable;
  10
  11 # workaround for possible refire time problems
  12 use constant SYS_TICRATE => 0.033333;
  13 #use constant SYS_TICRATE => 0;
  14
  15 use constant MIDI_FIRST_NONCHANNEL => 17;
  16 use constant MIDI_DRUMS_CHANNEL => 10;
  17
  18 die "Usage: $0 filename.conf timeoffset_preinit timeoffset_postinit timeoffset_predone timeoffset_postdone timeoffset_preintermission timeoffset_postintermission midifile1 transpose1 midifile2 transpose2 ..."
  19         unless @ARGV > 7 and @ARGV % 2;
  20 my ($config, $timeoffset_preinit, $timeoffset_postinit, $timeoffset_predone, $timeoffset_postdone, $timeoffset_preintermission, $timeoffset_postintermission, @midilist) = @ARGV;
  21
  22 sub unsort(@)
  23 {
  24         return map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } @_;
  25 }
  26
  27 sub override($$);
  28 sub override($$)
  29 {
  30         my ($dest, $src) = @_;
  31         if(ref $src eq 'HASH')
  32         {
  33                 $dest = {}
  34                         if not defined $dest;
  35                 for(keys %$src)
  36                 {
  37                         $dest->{$_} = override $dest->{$_}, $src->{$_};
  38                 }
  39         }
  40         elsif(ref $src eq 'ARRAY')
  41         {
  42                 $dest = []
  43                         if not defined $dest;
  44                 for(@$src)
  45                 {
  46                         push @$dest, override undef, $_;
  47                 }
  48         }
  49         elsif(ref $src)
  50         {
  51                 $dest = Storable::dclone $src;
  52         }
  53         else
  54         {
  55                 $dest = $src;
  56         }
  57         return $dest;
  58 }
  59
  60 my $precommands = "";
  61 my $commands = "";
  62 my $busybots;
  63 my @busybots_allocated;
  64 my %notechannelbots;
  65 my $transpose = 0;
  66 my $notetime = undef;
  67 my $lowestnotestart = undef;
  68 my $noalloc = 0;
  69 sub botconfig_read($)
  70 {
  71         my ($fn) = @_;
  72         my %bots = ();
  73         open my $fh, "<", $fn
  74                 or die "<$fn: $!";
  75
  76         my $currentbot = undef;
  77         my $appendref = undef;
  78         my $super = undef;
  79         while(<$fh>)
  80         {
  81                 chomp;
  82                 s/\s*#.*//;
  83                 next if /^$/;
  84                 if(s/^\t\t//)
  85                 {
  86                         my @cmd = split /\s+/, $_;
  87                         if($cmd[0] eq 'super')
  88                         {
  89                                 push @$appendref, @$super
  90                                         if $super;
  91                         }
  92                         elsif($cmd[0] eq 'percussion') # simple import
  93                         {
  94                                 push @$appendref, @{$currentbot->{percussion}->{$cmd[1]}};
  95                         }
  96                         else
  97                         {
  98                                 push @$appendref, \@cmd;
  99                         }
 100                 }
 101                 elsif(s/^\t//)
 102                 {
 103                         if(/^include (.*)/)
 104                         {
 105                                 my $base = $bots{$1};
 106                                 $currentbot = override $currentbot, $base;
 107                         }
 108                         elsif(/^count (\d+)/)
 109                         {
 110                                 $currentbot->{count} = $1;
 111                         }
 112                         elsif(/^transpose (\d+)/)
 113                         {
 114                                 $currentbot->{transpose} ||= 0;
 115                                 $currentbot->{transpose} += $1;
 116                         }
 117                         elsif(/^channels (.*)/)
 118                         {
 119                                 $currentbot->{channels} = { map { $_ => 1 } split /\s+/, $1 };
 120                         }
 121                         elsif(/^init$/)
 122                         {
 123                                 $super = $currentbot->{init};
 124                                 $currentbot->{init} = $appendref = [];
 125                         }
 126                         elsif(/^intermission$/)
 127                         {
 128                                 $super = $currentbot->{intermission};
 129                                 $currentbot->{intermission} = $appendref = [];
 130                         }
 131                         elsif(/^done$/)
 132                         {
 133                                 $super = $currentbot->{done};
 134                                 $currentbot->{done} = $appendref = [];
 135                         }
 136                         elsif(/^note on (-?\d+)/)
 137                         {
 138                                 $super = $currentbot->{notes_on}->{$1};
 139                                 $currentbot->{notes_on}->{$1} = $appendref = [];
 140                         }
 141                         elsif(/^note off (-?\d+)/)
 142                         {
 143                                 $super = $currentbot->{notes_off}->{$1};
 144                                 $currentbot->{notes_off}->{$1} = $appendref = [];
 145                         }
 146                         elsif(/^percussion (\d+)/)
 147                         {
 148                                 $super = $currentbot->{percussion}->{$1};
 149                                 $currentbot->{percussion}->{$1} = $appendref = [];
 150                         }
 151                         elsif(/^vocals$/)
 152                         {
 153                                 $super = $currentbot->{vocals};
 154                                 $currentbot->{vocals} = $appendref = [];
 155                         }
 156                         else
 157                         {
 158                                 print "unknown command: $_\n";
 159                         }
 160                 }
 161                 elsif(/^bot (.*)/)
 162                 {
 163                         $currentbot = ($bots{$1} ||= {count => 0});
 164                 }
 165                 elsif(/^raw (.*)/)
 166                 {
 167                         $precommands .= "$1\n";
 168                 }
 169                 else
 170                 {
 171                         print "unknown command: $_\n";
 172                 }
 173         }
 174
 175         for(values %bots)
 176         {
 177                 for(values %{$_->{notes_on}}, values %{$_->{percussion}})
 178                 {
 179                         my $t = $_->[0]->[0] eq 'time' ? $_->[0]->[1] : 0;
 180                         $lowestnotestart = $t if not defined $lowestnotestart or $t < $lowestnotestart;
 181                 }
 182         }
 183
 184         return \%bots;
 185 }
 186 my $busybots_orig = botconfig_read $config;
 187
 188
 189 sub busybot_cmd_bot_test($$@)
 190 {
 191         my ($bot, $time, @commands) = @_;
 192
 193         my $bottime = defined $bot->{timer} ? $bot->{timer} : -1;
 194         my $botbusytime = defined $bot->{busytimer} ? $bot->{busytimer} : -1;
 195
 196         return 0
 197                 if $time < $botbusytime + SYS_TICRATE;
 198
 199         my $mintime = (@commands && ($commands[0]->[0] eq 'time')) ? $commands[0]->[1] : 0;
 200
 201         return 0
 202                 if $time + $mintime < $bottime + SYS_TICRATE;
 203
 204         return 1;
 205 }
 206
 207 sub busybot_cmd_bot_execute($$@)
 208 {
 209         my ($bot, $time, @commands) = @_;
 210
 211         for(@commands)
 212         {
 213                 if($_->[0] eq 'time')
 214                 {
 215                         $commands .= sprintf "sv_cmd bot_cmd %d wait_until %f\n", $bot->{id}, $time + $_->[1];
 216                         $bot->{timer} = $time + $_->[1];
 217                 }
 218                 elsif($_->[0] eq 'busy')
 219                 {
 220                         $bot->{busytimer} = $time + $_->[1];
 221                 }
 222                 elsif($_->[0] eq 'buttons')
 223                 {
 224                         my %buttons_release = %{$bot->{buttons} ||= {}};
 225                         for(@{$_}[1..@$_-1])
 226                         {
 227                                 /(.*)\??/ or next;
 228                                 delete $buttons_release{$1};
 229                         }
 230                         for(keys %buttons_release)
 231                         {
 232                                 $commands .= sprintf "sv_cmd bot_cmd %d releasekey %s\n", $bot->{id}, $_;
 233                                 delete $bot->{buttons}->{$_};
 234                         }
 235                         for(@{$_}[1..@$_-1])
 236                         {
 237                                 /(.*)(\?)?/ or next;
 238                                 defined $2 and next;
 239                                 $commands .= sprintf "sv_cmd bot_cmd %d presskey %s\n", $bot->{id}, $_;
 240                                 $bot->{buttons}->{$_} = 1;
 241                         }
 242                 }
 243                 elsif($_->[0] eq 'cmd')
 244                 {
 245                         $commands .= sprintf "sv_cmd bot_cmd %d %s\n", $bot->{id}, join " ", @{$_}[1..@$_-1];
 246                 }
 247                 elsif($_->[0] eq 'barrier')
 248                 {
 249                         $commands .= sprintf "sv_cmd bot_cmd %d barrier\n", $bot->{id};
 250                         $bot->{timer} = $bot->{busytimer} = 0;
 251                 }
 252                 elsif($_->[0] eq 'raw')
 253                 {
 254                         $commands .= sprintf "%s\n", join " ", @{$_}[1..@$_-1];
 255                 }
 256         }
 257
 258         return 1;
 259 }
 260
 261 my $intermissions = 0;
 262
 263 sub busybot_intermission_bot($)
 264 {
 265         my ($bot) = @_;
 266         busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preintermission];
 267         busybot_cmd_bot_execute $bot, 0, ['barrier'];
 268         if($bot->{intermission})
 269         {
 270                 busybot_cmd_bot_execute $bot, 0, @{$bot->{intermission}};
 271         }
 272         busybot_cmd_bot_execute $bot, 0, ['barrier'];
 273         $notetime = $timeoffset_postintermission - $lowestnotestart;
 274 }
 275
 276 #my $busy = 0;
 277 sub busybot_note_off_bot($$$$)
 278 {
 279         my ($bot, $time, $channel, $note) = @_;
 280         #print STDERR "note off $bot:$time:$channel:$note\n";
 281         return 1
 282                 if $channel == 10;
 283         my $cmds = $bot->{notes_off}->{$note - ($bot->{transpose} || 0) - $transpose};
 284         return 1
 285                 if not defined $cmds; # note off cannot fail
 286         $bot->{busy} = 0;
 287         #--$busy;
 288         #print STDERR "BUSY: $busy bots (OFF)\n";
 289         busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
 290         return 1;
 291 }
 292
 293 sub busybot_note_on_bot($$$$$)
 294 {
 295         my ($bot, $time, $channel, $note, $init) = @_;
 296         return -1 # I won't play on this channel
 297                 if defined $bot->{channels} and not $bot->{channels}->{$channel};
 298         my $cmds;
 299         my $cmds_off;
 300         my $k0;
 301         my $k1;
 302         if($channel <= 0)
 303         {
 304                 # vocals
 305                 $cmds = $bot->{vocals};
 306                 $cmds_off = undef;
 307                 if(defined $cmds)
 308                 {
 309                         $cmds = [ map { [ map { $_ eq '%s' ? $note : $_ } @$_ ] } @$cmds ];
 310                 }
 311                 $k0 = "vocals";
 312                 $k1 = $channel;
 313         }
 314         elsif($channel == 10)
 315         {
 316                 # percussion
 317                 $cmds = $bot->{percussion}->{$note};
 318                 $cmds_off = undef;
 319                 $k0 = "percussion";
 320                 $k1 = $note;
 321         }
 322         else
 323         {
 324                 # music
 325                 $cmds = $bot->{notes_on}->{$note - ($bot->{transpose} || 0) - $transpose};
 326                 $cmds_off = $bot->{notes_off}->{$note - ($bot->{transpose} || 0) - $transpose};
 327                 $k0 = "note";
 328                 $k1 = $note - ($bot->{transpose} || 0) - $transpose;
 329         }
 330         return -1 # I won't play this note
 331                 if not defined $cmds;
 332         return 0
 333                 if $bot->{busy};
 334         #print STDERR "note on $bot:$time:$channel:$note\n";
 335         if($init)
 336         {
 337                 return 0
 338                         if not busybot_cmd_bot_test $bot, $time + $notetime, @$cmds;
 339                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
 340                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 341                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
 342                         if @{$bot->{init}};
 343                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 344                 for(1..$intermissions)
 345                 {
 346                         busybot_intermission_bot $bot;
 347                 }
 348                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
 349         }
 350         else
 351         {
 352                 return 0
 353                         if not busybot_cmd_bot_test $bot, $time + $notetime, @$cmds;
 354                 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
 355         }
 356         if(defined $cmds and defined $cmds_off)
 357         {
 358                 $bot->{busy} = 1;
 359                 #++$busy;
 360                 #print STDERR "BUSY: $busy bots (ON)\n";
 361         }
 362         ++$bot->{seen}{$k0}{$k1};
 363         return 1;
 364 }
 365
 366 sub busybots_reset()
 367 {
 368         $busybots = Storable::dclone $busybots_orig;
 369         @busybots_allocated = ();
 370         %notechannelbots = ();
 371         $transpose = 0;
 372         $notetime = $timeoffset_postinit - $lowestnotestart;
 373 }
 374
 375 sub busybot_note_off($$$)
 376 {
 377         my ($time, $channel, $note) = @_;
 378
 379         #print STDERR "note off $time:$channel:$note\n";
 380
 381         return 0
 382                 if $channel <= 0;
 383         return 0
 384                 if $channel == 10;
 385
 386         if(my $bot = $notechannelbots{$channel}{$note})
 387         {
 388                 busybot_note_off_bot $bot, $time, $channel, $note;
 389                 delete $notechannelbots{$channel}{$note};
 390                 return 1;
 391         }
 392
 393         return 0;
 394 }
 395
 396 sub busybot_note_on($$$)
 397 {
 398         my ($time, $channel, $note) = @_;
 399
 400         if($notechannelbots{$channel}{$note})
 401         {
 402                 busybot_note_off $time, $channel, $note;
 403         }
 404
 405         #print STDERR "note on $time:$channel:$note\n";
 406
 407         my $overflow = 0;
 408
 409         for(unsort @busybots_allocated)
 410         {
 411                 my $canplay = busybot_note_on_bot $_, $time, $channel, $note, 0;
 412                 if($canplay > 0)
 413                 {
 414                         $notechannelbots{$channel}{$note} = $_;
 415                         return 1;
 416                 }
 417                 $overflow = 1
 418                         if $canplay == 0;
 419                 # wrong
 420         }
 421
 422         for(unsort keys %$busybots)
 423         {
 424                 next if $busybots->{$_}->{count} <= 0;
 425                 my $bot = Storable::dclone $busybots->{$_};
 426                 $bot->{id} = @busybots_allocated + 1;
 427                 $bot->{classname} = $_;
 428                 my $canplay = busybot_note_on_bot $bot, $time, $channel, $note, 1;
 429                 if($canplay > 0)
 430                 {
 431                         die "noalloc\n"
 432                                 if $noalloc;
 433                         --$busybots->{$_}->{count};
 434                         $notechannelbots{$channel}{$note} = $bot;
 435                         push @busybots_allocated, $bot;
 436                         return 1;
 437                 }
 438                 die "Fresh bot cannot play stuff"
 439                         if $canplay == 0;
 440         }
 441
 442         if($overflow)
 443         {
 444                 warn "Not enough bots to play this (when playing $channel:$note)";
 445         }
 446         else
 447         {
 448                 warn "Note $channel:$note cannot be played by any bot";
 449         }
 450
 451         return 0;
 452 }
 453
 454 sub Preallocate(@)
 455 {
 456         my (@preallocate) = @_;
 457         busybots_reset();
 458         for(@preallocate)
 459         {
 460                 die "Cannot preallocate any more $_ bots"
 461                         if $busybots->{$_}->{count} <= 0;
 462                 my $bot = Storable::dclone $busybots->{$_};
 463                 $bot->{id} = @busybots_allocated + 1;
 464                 $bot->{classname} = $_;
 465                 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
 466                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 467                 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
 468                         if @{$bot->{init}};
 469                 busybot_cmd_bot_execute $bot, 0, ['barrier'];
 470                 --$busybots->{$_}->{count};
 471                 push @busybots_allocated, $bot;
 472         }
 473 }
 474
 475 sub ConvertMIDI($$)
 476 {
 477         my ($filename, $trans) = @_;
 478         $transpose = $trans;
 479
 480         my $opus = MIDI::Opus->new({from_file => $filename});
 481         my $ticksperquarter = $opus->ticks();
 482         my $tracks = $opus->tracks_r();
 483         my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
 484         my $tick;
 485
 486         $tick = 0;
 487         for($tracks->[0]->events())
 488         {
 489                 $tick += $_->[1];
 490                 if($_->[0] eq 'set_tempo')
 491                 {
 492                         push @tempi, [$tick, $_->[2] * 0.000001 / $ticksperquarter];
 493                 }
 494         }
 495         my $tick2sec = sub
 496         {
 497                 my ($tick) = @_;
 498                 my $sec = 0;
 499                 my $curtempo = [0, 0.5 / $ticksperquarter];
 500                 for(@tempi)
 501                 {
 502                         if($_->[0] < $tick)
 503                         {
 504                                 # this event is in the past
 505                                 # we add the full time since the last one then
 506                                 $sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
 507                         }
 508                         else
 509                         {
 510                                 # if this event is in the future, we break
 511                                 last;
 512                         }
 513                         $curtempo = $_;
 514                 }
 515                 $sec += ($tick - $curtempo->[0]) * $curtempo->[1];
 516                 return $sec;
 517         };
 518
 519         # merge all to a single track
 520         my @allmidievents = ();
 521         my $sequence = 0;
 522         for my $track(0..@$tracks-1)
 523         {
 524                 $tick = 0;
 525                 for($tracks->[$track]->events())
 526                 {
 527                         my ($command, $delta, @data) = @$_;
 528                         $command = 'note_off' if $command eq 'note_on' and $data[2] == 0;
 529                         $tick += $delta;
 530                         push @allmidievents, [$command, $tick, $sequence++, $track, @data];
 531                 }
 532         }
 533
 534         if(open my $fh, "$filename.vocals")
 535         {
 536                 my $scale = 1;
 537                 my $shift = 0;
 538                 for(<$fh>)
 539                 {
 540                         chomp;
 541                         my ($tick, $file) = split /\s+/, $_;
 542                         if($tick eq 'scale')
 543                         {
 544                                 $scale = $file;
 545                         }
 546                         elsif($tick eq 'shift')
 547                         {
 548                                 $shift = $file;
 549                         }
 550                         else
 551                         {
 552                                 push @allmidievents, ['note_on', $tick * $scale + $shift, $sequence++, -1, -1, $file];
 553                                 push @allmidievents, ['note_off', $tick * $scale + $shift, $sequence++, -1, -1, $file];
 554                         }
 555                 }
 556         }
 557
 558         @allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
 559
 560         my %midinotes = ();
 561         my $note_min = undef;
 562         my $note_max = undef;
 563         my $notes_stuck = 0;
 564         my $t = 0;
 565         for(@allmidievents)
 566         {
 567                 $t = $tick2sec->($_->[1]);
 568                 my $track = $_->[3];
 569                 if($_->[0] eq 'note_on')
 570                 {
 571                         my $chan = $_->[4] + 1;
 572                         $note_min = $_->[5]
 573                                 if $chan != 10 and $chan > 0 and (not defined $note_min or $_->[5] < $note_min);
 574                         $note_max = $_->[5]
 575                                 if $chan != 10 and $chan > 0 and (not defined $note_max or $_->[5] > $note_max);
 576                         if($midinotes{$chan}{$_->[5]})
 577                         {
 578                                 --$notes_stuck;
 579                                 busybot_note_off($t, $chan, $_->[5]);
 580                         }
 581                         busybot_note_on($t, $chan, $_->[5]);
 582                         ++$notes_stuck;
 583                         $midinotes{$chan}{$_->[5]} = 1;
 584                 }
 585                 elsif($_->[0] eq 'note_off')
 586                 {
 587                         my $chan = $_->[4] + 1;
 588                         if($midinotes{$chan}{$_->[5]})
 589                         {
 590                                 --$notes_stuck;
 591                                 busybot_note_off($t, $chan, $_->[5]);
 592                         }
 593                         $midinotes{$chan}{$_->[5]} = 0;
 594                 }
 595         }
 596
 597         print STDERR "For file $filename:\n";
 598         print STDERR "  Range of notes: $note_min .. $note_max\n";
 599         print STDERR "  Safe transpose range: @{[$note_max - 19]} .. @{[$note_min + 13]}\n";
 600         print STDERR "  Unsafe transpose range: @{[$note_max - 27]} .. @{[$note_min + 18]}\n";
 601         print STDERR "  Stuck notes: $notes_stuck\n";
 602
 603         while(my ($k1, $v1) = each %midinotes)
 604         {
 605                 while(my ($k2, $v2) = each %$v1)
 606                 {
 607                         busybot_note_off($t, $k1, $k2);
 608                 }
 609         }
 610
 611         for(@busybots_allocated)
 612         {
 613                 busybot_intermission_bot $_;
 614         }
 615         ++$intermissions;
 616 }
 617
 618 sub Deallocate()
 619 {
 620         print STDERR "Bots allocated:\n";
 621         my %notehash;
 622         my %counthash;
 623         for(@busybots_allocated)
 624         {
 625                 print STDERR "$_->{id} is a $_->{classname}\n";
 626                 ++$counthash{$_->{classname}};
 627                 while(my ($type, $notehash) = each %{$_->{seen}})
 628                 {
 629                         while(my ($k, $v) = each %$notehash)
 630                         {
 631                                 $notehash{$_->{classname}}{$type}{$k} += $v;
 632                         }
 633                 }
 634         }
 635         for my $cn(sort keys %counthash)
 636         {
 637                 print STDERR "$counthash{$cn} bots of $cn have played:\n";
 638                 for my $type(sort keys %{$notehash{$cn}})
 639                 {
 640                         for my $note(sort { $a <=> $b } keys %{$notehash{$cn}{$type}})
 641                         {
 642                                 my $cnt = $notehash{$cn}{$type}{$note};
 643                                 print STDERR "  $type $note ($cnt times)\n";
 644                         }
 645                 }
 646         }
 647         for(@busybots_allocated)
 648         {
 649                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_predone];
 650                 busybot_cmd_bot_execute $_, 0, ['barrier'];
 651                 if($_->{done})
 652                 {
 653                         busybot_cmd_bot_execute $_, 0, @{$_->{done}};
 654                 }
 655                 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_postdone];
 656                 busybot_cmd_bot_execute $_, 0, ['barrier'];
 657         }
 658 }
 659
 660 my @preallocate = ();
 661 $noalloc = 0;
 662 for(;;)
 663 {
 664         $commands = "";
 665         eval
 666         {
 667                 Preallocate(@preallocate);
 668                 my @l = @midilist;
 669                 while(@l)
 670                 {
 671                         my $filename = shift @l;
 672                         my $transpose = shift @l;
 673                         ConvertMIDI($filename, $transpose);
 674                 }
 675                 Deallocate();
 676                 my @preallocate_new = map { $_->{classname} } @busybots_allocated;
 677                 if(@preallocate_new == @preallocate)
 678                 {
 679                         print "$precommands$commands";
 680                         exit 0;
 681                 }
 682                 @preallocate = @preallocate_new;
 683                 $noalloc = 1;
 684                 1;
 685         } or do {
 686                 die "$@"
 687                         unless $@ eq "noalloc\n";
 688         };
 689 }