misc/tools/midi2cfg.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
  12 my ($filename, $transpose, $walktime, @coords) = @ARGV;
  13 my @coords_percussion = ();
  14 my @coords_tuba = ();
  15 my $l = \@coords_tuba;
  16 for(@coords)
  17 {
  18         if($_ eq '/')
  19         {
  20                 $l = \@coords_percussion;
  21         }
  22         else
  23         {
  24                 push @$l, [split /\s+/, $_];
  25         }
  26 }
  27
  28 my $opus = MIDI::Opus->new({from_file => $filename});
  29 my $ticksperquarter = $opus->ticks();
  30 my $tracks = $opus->tracks_r();
  31 my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
  32 my $tick;
  33
  34 $tick = 0;
  35 for($tracks->[0]->events())
  36 {
  37     $tick += $_->[1];
  38     if($_->[0] eq 'set_tempo')
  39     {
  40         push @tempi, [$_->[1], $_->[2] * 0.000001 / $ticksperquarter];
  41     }
  42 }
  43 sub tick2sec($)
  44 {
  45     my ($tick) = @_;
  46     my $sec = 0;
  47     my $curtempo = [0, 0.5 / $ticksperquarter];
  48     for(@tempi)
  49     {
  50         if($_->[0] < $tick)
  51         {
  52                         # this event is in the past
  53                         # we add the full time since the last one then
  54                         $sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
  55         }
  56         else
  57         {
  58                         # if this event is in the future, we break
  59                         last;
  60         }
  61                 $curtempo = $_;
  62     }
  63         $sec += ($tick - $curtempo->[0]) * $curtempo->[1];
  64         return $sec;
  65 }
  66
  67 # merge all to a single track
  68 my @allmidievents = ();
  69 my $sequence = 0;
  70 for my $track(0..@$tracks-1)
  71 {
  72         $tick = 0;
  73         for($tracks->[$track]->events())
  74         {
  75                 my ($command, $delta, @data) = @$_;
  76                 $tick += $delta;
  77                 push @allmidievents, [$command, $tick, $sequence++, $track, @data];
  78         }
  79 }
  80 @allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
  81
  82
  83
  84
  85
  86 my @busybots_percussion = map { undef } @coords_percussion;
  87 my @busybots_tuba       = map { undef } @coords_tuba;
  88
  89 my $notes = 0;
  90 sub busybot_findfree($$$)
  91 {
  92         my ($time, $vchannel, $note) = @_;
  93         my $l = ($vchannel < 16) ? \@busybots_tuba : \@busybots_percussion;
  94         for(0..@$l-1)
  95         {
  96                 if(!$l->[$_])
  97                 {
  98                         my $bot = {id => $_ + 1, busy => 0, busytime => 0, channel => $vchannel, curtime => -$walktime, curbuttons => 0, noteoffset => 0};
  99                         return $bot;
 100                 }
 101                 return $l->[$_] if
 102                         $l->[$_]{channel} == $vchannel
 103                         &&
 104                         !$l->[$_]{busy}
 105                         &&
 106                         $time > $l->[$_]{busytime};
 107         }
 108         die "No free channel found ($notes notes active)\n";
 109 }
 110
 111 sub busybot_find($$)
 112 {
 113         my ($vchannel, $note) = @_;
 114         my $l = ($vchannel < 16) ? \@busybots_tuba : \@busybots_percussion;
 115         for(0..@$l-1)
 116         {
 117                 return $l->[$_] if
 118                         $l->[$_]
 119                         &&
 120                         $l->[$_]{busy}
 121                         &&
 122                         $l->[$_]{channel} == $vchannel
 123                         &&
 124                         defined $l->[$_]{note}
 125                         &&
 126                         $l->[$_]{note} == $note;
 127         }
 128         return undef;
 129 }
 130
 131 sub busybot_advance($$)
 132 {
 133         my ($bot, $t) = @_;
 134         my $t0 = $bot->{curtime};
 135         if($t != $t0)
 136         {
 137                 #print "sv_cmd bot_cmd $bot->{id} wait @{[$t - $t0]}\n";
 138                 print "sv_cmd bot_cmd $bot->{id} wait_until $t\n";
 139         }
 140         $bot->{curtime} = $t;
 141 }
 142
 143 sub busybot_setbuttons($$)
 144 {
 145         my ($bot, $b) = @_;
 146         my $b0 = $bot->{curbuttons};
 147         my $press = $b & ~$b0;
 148         my $release = $b0 & ~$b;
 149         print "sv_cmd bot_cmd $bot->{id} releasekey forward\n" if $release & 1;
 150         print "sv_cmd bot_cmd $bot->{id} releasekey backward\n" if $release & 2;
 151         print "sv_cmd bot_cmd $bot->{id} releasekey left\n" if $release & 4;
 152         print "sv_cmd bot_cmd $bot->{id} releasekey right\n" if $release & 8;
 153         print "sv_cmd bot_cmd $bot->{id} releasekey crouch\n" if $release & 16;
 154         print "sv_cmd bot_cmd $bot->{id} releasekey attack1\n" if $release & 32;
 155         print "sv_cmd bot_cmd $bot->{id} releasekey attack2\n" if $release & 64;
 156         print "sv_cmd bot_cmd $bot->{id} presskey forward\n" if $press & 1;
 157         print "sv_cmd bot_cmd $bot->{id} presskey backward\n" if $press & 2;
 158         print "sv_cmd bot_cmd $bot->{id} presskey left\n" if $press & 4;
 159         print "sv_cmd bot_cmd $bot->{id} presskey right\n" if $press & 8;
 160         print "sv_cmd bot_cmd $bot->{id} presskey crouch\n" if $press & 16;
 161         print "sv_cmd bot_cmd $bot->{id} presskey attack1\n" if $press & 32;
 162         print "sv_cmd bot_cmd $bot->{id} presskey attack2\n" if $press & 64;
 163         $bot->{curbuttons} = $b;
 164 }
 165
 166 my %notes = (
 167         -18 => '1lbc',
 168         -17 => '1bc',
 169         -16 => '1brc',
 170         -13 => '1frc',
 171         -12 => '1c',
 172         -11 => '2lbc',
 173         -10 => '1rc',
 174         -9 => '1flc',
 175         -8 => '1fc',
 176         -7 => '1lc',
 177         -6 => '1lb',
 178         -5 => '1b',
 179         -4 => '1br',
 180         -3 => '2rc',
 181         -2 => '2flc',
 182         -1 => '1fl',
 183         0 => '1',
 184         1 => '2lb',
 185         2 => '1r',
 186         3 => '1fl',
 187         4 => '1f',
 188         5 => '1l',
 189         6 => '2fr',
 190         7 => '2',
 191         9 => '2r',
 192         10 => '2fl',
 193         11 => '2f',
 194         12 => '2l'
 195 );
 196
 197 my $note_min = +99;
 198 my $note_max = -99;
 199 sub getnote($$)
 200 {
 201         my ($bot, $note) = @_;
 202         $note_max = $note if $note_max < $note;
 203         $note_min = $note if $note_min > $note;
 204         $note -= $transpose;
 205         $note -= $bot->{noteoffset};
 206         my $s = $notes{$note};
 207         return $s;
 208 }
 209
 210 sub busybot_playnote($$)
 211 {
 212         my ($bot, $note) = @_;
 213         my $s = getnote $bot => $note;
 214         return (warn("note $note not found"), 0)
 215                 unless defined $s;
 216         my $buttons = 0;
 217         $buttons |= 1 if $s =~ /f/;
 218         $buttons |= 2 if $s =~ /b/;
 219         $buttons |= 4 if $s =~ /l/;
 220         $buttons |= 8 if $s =~ /r/;
 221         $buttons |= 16 if $s =~ /c/;
 222         $buttons |= 32 if $s =~ /1/;
 223         $buttons |= 64 if $s =~ /2/;
 224         busybot_setbuttons $bot => $buttons;
 225         return 1;
 226 }
 227
 228 sub busybot_stopnote($$)
 229 {
 230         my ($bot, $note) = @_;
 231         my $s = getnote $bot => $note;
 232         return 0
 233                 unless defined $s;
 234         my $buttons = $bot->{curbuttons};
 235         $buttons &= ~(32 | 64);
 236         #$buttons = 0;
 237         busybot_setbuttons $bot => $buttons;
 238         return 1;
 239 }
 240
 241 sub note_on($$$)
 242 {
 243         my ($t, $channel, $note) = @_;
 244         if(busybot_find($channel, $note))
 245         {
 246                 note_off($t, $channel, $note); # MIDI allows redoing a note-on for the same note
 247         }
 248         ++$notes;
 249         if($channel == 10)
 250         {
 251                 $channel = 16 + $note; # percussion
 252         }
 253         my $bot = busybot_findfree($t, $channel, $note);
 254         if($channel < 16)
 255         {
 256                 busybot_advance $bot => $t if getnote $bot => $note;
 257                 if(busybot_playnote $bot => $note)
 258                 {
 259                         $bot->{busy} = 1;
 260                         $bot->{note} = $note;
 261                         $bot->{busytime} = $t + 0.25;
 262                         busybot_stopnote $bot => $note;
 263                 }
 264         }
 265         if($channel >= 16)
 266         {
 267                 print "sv_cmd bot_cmd $bot->{id} presskey attack1\n";
 268                 print "sv_cmd bot_cmd $bot->{id} releasekey attack1\n";
 269                 $bot->{busy} = 1;
 270                 $bot->{note} = $note;
 271                 $bot->{busytime} = $t + 1.5;
 272         }
 273 }
 274
 275 sub note_off($$$)
 276 {
 277         my ($t, $channel, $note) = @_;
 278         --$notes;
 279         if($channel == 10)
 280         {
 281                 $channel = 16 + $note; # percussion
 282         }
 283         my $bot = busybot_find($channel, $note)
 284                 or return;
 285         $bot->{busy} = 0;
 286         if($channel < 16)
 287         {
 288                 busybot_advance $bot => $t;
 289                 busybot_stopnote $bot => $note;
 290                 $bot->{busytime} = $t + 0.25;
 291         }
 292 }
 293
 294 for(@allmidievents)
 295 {
 296         my $t = tick2sec $_->[1];
 297         my $track = $_->[3];
 298         if($_->[0] eq 'note_on')
 299         {
 300                 my $chan = $_->[4];
 301                 note_on($t, $chan, $_->[5]);
 302         }
 303         elsif($_->[0] eq 'note_off')
 304         {
 305                 my $chan = $_->[4];
 306                 note_off($t, $chan, $_->[5]);
 307         }
 308 }
 309
 310 print STDERR "Range of notes: $note_min .. $note_max\n";
 311 print STDERR "Safe transpose range: @{[$note_max - 7]} .. @{[$note_min + 13]}\n";
 312 print STDERR "Unsafe transpose range: @{[$note_max - 12]} .. @{[$note_min + 18]}\n";
 313 printf STDERR "%d bots allocated for tuba, %d for percussion\n", scalar grep { defined $_ } @busybots_tuba, scalar grep { defined $_ } @busybots_percussion;
 314
 315 my $n = 0;
 316 for(@busybots_percussion, @busybots_tuba)
 317 {
 318         ++$n if $_ && $_->{busy};
 319 }
 320 if($n)
 321 {
 322         die "$n channels blocked ($notes MIDI notes)";
 323 }