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