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