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