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