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