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