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