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