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