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)
11 # workaround for possible refire time problems
12 use constant SYS_TICRATE => 0.033333;
13 #use constant SYS_TICRATE => 0;
15 use constant MIDI_FIRST_NONCHANNEL => 17;
16 use constant MIDI_DRUMS_CHANNEL => 10;
18 die "Usage: $0 filename.conf timeoffset_preinit timeoffset_postinit timeoffset_predone timeoffset_postdone timeoffset_preintermission timeoffset_postintermission midifile1 transpose1 midifile2 transpose2 ..."
19 unless @ARGV > 7 and @ARGV % 2;
20 my ($config, $timeoffset_preinit, $timeoffset_postinit, $timeoffset_predone, $timeoffset_postdone, $timeoffset_preintermission, $timeoffset_postintermission, @midilist) = @ARGV;
24 return map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } @_;
30 my ($dest, $src) = @_;
31 if(ref $src eq 'HASH')
37 $dest->{$_} = override $dest->{$_}, $src->{$_};
40 elsif(ref $src eq 'ARRAY')
46 push @$dest, override undef, $_;
51 $dest = Storable::dclone $src;
63 my @busybots_allocated;
67 my $lowestnotestart = undef;
76 my $currentbot = undef;
77 my $appendref = undef;
86 my @cmd = split /\s+/, $_;
87 if($cmd[0] eq 'super')
89 push @$appendref, @$super
92 elsif($cmd[0] eq 'percussion') # simple import
94 push @$appendref, @{$currentbot->{percussion}->{$cmd[1]}};
98 push @$appendref, \@cmd;
105 my $base = $bots{$1};
106 $currentbot = override $currentbot, $base;
108 elsif(/^count (\d+)/)
110 $currentbot->{count} = $1;
112 elsif(/^transpose (\d+)/)
114 $currentbot->{transpose} ||= 0;
115 $currentbot->{transpose} += $1;
117 elsif(/^channels (.*)/)
119 $currentbot->{channels} = { map { $_ => 1 } split /\s+/, $1 };
123 $super = $currentbot->{init};
124 $currentbot->{init} = $appendref = [];
126 elsif(/^intermission$/)
128 $super = $currentbot->{intermission};
129 $currentbot->{intermission} = $appendref = [];
133 $super = $currentbot->{done};
134 $currentbot->{done} = $appendref = [];
136 elsif(/^note on (-?\d+)/)
138 $super = $currentbot->{notes_on}->{$1};
139 $currentbot->{notes_on}->{$1} = $appendref = [];
141 elsif(/^note off (-?\d+)/)
143 $super = $currentbot->{notes_off}->{$1};
144 $currentbot->{notes_off}->{$1} = $appendref = [];
146 elsif(/^percussion (\d+)/)
148 $super = $currentbot->{percussion}->{$1};
149 $currentbot->{percussion}->{$1} = $appendref = [];
153 $super = $currentbot->{vocals};
154 $currentbot->{vocals} = $appendref = [];
158 print "unknown command: $_\n";
163 $currentbot = ($bots{$1} ||= {count => 0});
167 $precommands .= "$1\n";
171 print "unknown command: $_\n";
177 for(values %{$_->{notes_on}}, values %{$_->{percussion}})
179 my $t = $_->[0]->[0] eq 'time' ? $_->[0]->[1] : 0;
180 $lowestnotestart = $t if not defined $lowestnotestart or $t < $lowestnotestart;
186 my $busybots_orig = botconfig_read $config;
189 # returns: ($mintime, $maxtime, $busytime)
190 sub busybot_cmd_bot_cmdinfo(@)
196 my $busytime = undef;
200 if($_->[0] eq 'time')
203 if not defined $mintime or $_->[1] < $mintime;
204 $maxtime = $_->[1] + SYS_TICRATE
205 if not defined $maxtime or $_->[1] > $maxtime;
207 elsif($_->[0] eq 'busy')
209 $busytime = $_->[1] + SYS_TICRATE;
213 return ($mintime, $maxtime, $busytime);
216 sub busybot_cmd_bot_matchtime($$$@)
218 my ($bot, $targettime, $targetbusytime, @commands) = @_;
220 # I want to execute @commands so that I am free on $targettime and $targetbusytime
221 # when do I execute it then?
223 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
225 my $tstart_max = defined $maxtime ? $targettime - $maxtime : $targettime;
226 my $tstart_busy = defined $busytime ? $targetbusytime - $busytime : $targettime;
228 return $tstart_max < $tstart_busy ? $tstart_max : $tstart_busy;
231 # TODO function to find out whether, and when, to insert a command before another command to make it possible
232 # (note-off before note-on)
234 sub busybot_cmd_bot_test($$$@)
236 my ($bot, $time, $force, @commands) = @_;
238 my $bottime = defined $bot->{timer} ? $bot->{timer} : -1;
239 my $botbusytime = defined $bot->{busytimer} ? $bot->{busytimer} : -1;
241 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
243 if($time < $botbusytime)
245 warn "FORCE: $time < $botbusytime"
250 if(defined $mintime and $time + $mintime < $bottime)
252 warn "FORCE: $time + $mintime < $bottime"
260 sub busybot_cmd_bot_execute($$@)
262 my ($bot, $time, @commands) = @_;
266 if($_->[0] eq 'time')
268 $commands .= sprintf "sv_cmd bot_cmd %d wait_until %f\n", $bot->{id}, $time + $_->[1];
269 if($bot->{timer} > $time + $_->[1] + SYS_TICRATE)
271 #use Carp; carp "Negative wait: $bot->{timer} <= @{[$time + $_->[1] + SYS_TICRATE]}";
273 $bot->{timer} = $time + $_->[1] + SYS_TICRATE;
275 elsif($_->[0] eq 'busy')
277 $bot->{busytimer} = $time + $_->[1] + SYS_TICRATE;
279 elsif($_->[0] eq 'buttons')
281 my %buttons_release = %{$bot->{buttons} ||= {}};
285 delete $buttons_release{$1};
287 for(keys %buttons_release)
289 $commands .= sprintf "sv_cmd bot_cmd %d releasekey %s\n", $bot->{id}, $_;
290 delete $bot->{buttons}->{$_};
296 $commands .= sprintf "sv_cmd bot_cmd %d presskey %s\n", $bot->{id}, $_;
297 $bot->{buttons}->{$_} = 1;
300 elsif($_->[0] eq 'cmd')
302 $commands .= sprintf "sv_cmd bot_cmd %d %s\n", $bot->{id}, join " ", @{$_}[1..@$_-1];
304 elsif($_->[0] eq 'barrier')
306 $commands .= sprintf "sv_cmd bot_cmd %d barrier\n", $bot->{id};
307 $bot->{timer} = $bot->{busytimer} = 0;
309 elsif($_->[0] eq 'raw')
311 $commands .= sprintf "%s\n", join " ", @{$_}[1..@$_-1];
318 my $intermissions = 0;
320 sub busybot_intermission_bot($)
323 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preintermission];
324 busybot_cmd_bot_execute $bot, 0, ['barrier'];
325 if($bot->{intermission})
327 busybot_cmd_bot_execute $bot, 0, @{$bot->{intermission}};
329 busybot_cmd_bot_execute $bot, 0, ['barrier'];
330 $notetime = $timeoffset_postintermission - $lowestnotestart;
334 sub busybot_note_off_bot($$$$)
336 my ($bot, $time, $channel, $note) = @_;
337 #print STDERR "note off $bot:$time:$channel:$note\n";
338 my ($busychannel, $busynote, $cmds) = @{$bot->{busy}};
340 if not defined $cmds; # note off cannot fail
341 die "Wrong note-off?!?"
342 if $busychannel != $channel || $busynote ne $note;
343 $bot->{busy} = undef;
345 my $t = $time + $notetime;
346 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
348 # perform note-off "as soon as we can"
349 $t = $bot->{busytimer}
350 if $t < $bot->{busytimer};
351 $t = $bot->{timer} - $mintime
352 if $t < $bot->{timer} - $mintime;
354 busybot_cmd_bot_execute $bot, $t, @$cmds;
358 sub busybot_get_cmds_bot($$$)
360 my ($bot, $channel, $note) = @_;
361 my ($k0, $k1, $cmds, $cmds_off) = (undef, undef, undef, undef);
365 $cmds = $bot->{vocals};
368 $cmds = [ map { [ map { $_ eq '%s' ? $note : $_ } @$_ ] } @$cmds ];
373 elsif($channel == 10)
376 $cmds = $bot->{percussion}->{$note};
383 $cmds = $bot->{notes_on}->{$note - ($bot->{transpose} || 0) - $transpose};
384 $cmds_off = $bot->{notes_off}->{$note - ($bot->{transpose} || 0) - $transpose};
386 $k1 = $note - ($bot->{transpose} || 0) - $transpose;
388 return ($cmds, $cmds_off, $k0, $k1);
391 sub busybot_note_on_bot($$$$$$)
393 my ($bot, $time, $channel, $note, $init, $force) = @_;
394 return -1 # I won't play on this channel
395 if defined $bot->{channels} and not $bot->{channels}->{$channel};
397 my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot($bot, $channel, $note);
399 return -1 # I won't play this note
400 if not defined $cmds;
403 #print STDERR "note on $bot:$time:$channel:$note\n";
407 if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds;
408 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
409 busybot_cmd_bot_execute $bot, 0, ['barrier'];
410 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
412 busybot_cmd_bot_execute $bot, 0, ['barrier'];
413 for(1..$intermissions)
415 busybot_intermission_bot $bot;
417 # we always did a barrier, so we know this works
418 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
423 if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds;
424 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
426 if(defined $cmds and defined $cmds_off)
428 $bot->{busy} = [$channel, $note, $cmds_off];
430 ++$bot->{seen}{$k0}{$k1};
436 $busybots = Storable::dclone $busybots_orig;
437 @busybots_allocated = ();
438 %notechannelbots = ();
440 $notetime = $timeoffset_postinit - $lowestnotestart;
443 sub busybot_note_off($$$)
445 my ($time, $channel, $note) = @_;
447 # print STDERR "note off $time:$channel:$note\n";
454 if(my $bot = $notechannelbots{$channel}{$note})
456 busybot_note_off_bot $bot, $time, $channel, $note;
457 delete $notechannelbots{$channel}{$note};
464 sub busybot_note_on($$$)
466 my ($time, $channel, $note) = @_;
468 if($notechannelbots{$channel}{$note})
470 busybot_note_off $time, $channel, $note;
473 # print STDERR "note on $time:$channel:$note\n";
477 my @epicfailbots = ();
479 for(unsort @busybots_allocated)
481 my $canplay = busybot_note_on_bot $_, $time, $channel, $note, 0, 0;
484 $notechannelbots{$channel}{$note} = $_;
487 push @epicfailbots, $_
494 for(unsort keys %$busybots)
496 next if $busybots->{$_}->{count} <= 0;
497 my $bot = Storable::dclone $busybots->{$_};
498 $bot->{id} = @busybots_allocated + 1;
499 $bot->{classname} = $_;
500 my $canplay = busybot_note_on_bot $bot, $time, $channel, $note, 1, 0;
509 --$busybots->{$_}->{count};
510 $notechannelbots{$channel}{$note} = $bot;
511 push @busybots_allocated, $bot;
515 die "Fresh bot cannot play stuff"
521 # we cannot add a new bot to play this
522 # we could try finding a bot that could play this, and force him to stop the note!
524 my @candidates = (); # contains: [$bot, $score, $offtime]
526 # put in all currently busy bots that COULD play this, if they did a note-off first
527 for my $bot(@epicfailbots)
530 if $busybots->{$bot->{classname}}->{count} != 0;
533 my ($busy_chan, $busy_note, $busy_cmds_off) = @{$bot->{busy}};
535 unless $busy_cmds_off;
536 my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot $bot, $channel, $note;
539 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
541 my $noteofftime = busybot_cmd_bot_matchtime $bot, $time + $notetime + $mintime, $time, @$busy_cmds_off;
543 if $noteofftime < $bot->{busytimer};
545 if $noteofftime + $mintime < $bot->{timer};
548 # prefer turning off long notes
549 $score += 100 * ($noteofftime - $bot->{timer});
550 # prefer turning off low notes
551 $score += 1 * (-$note);
552 # prefer turning off notes that already play on another channel
553 $score += 1000 * (grep { $_ != $busy_chan && $notechannelbots{$_}{$busy_note} && $notechannelbots{$_}{$busy_note}{busy} } keys %notechannelbots);
555 push @candidates, [$bot, $score, $noteofftime];
562 @candidates = sort { $a->[1] <=> $b->[1] } @candidates;
563 my ($bot, $score, $offtime) = @{(pop @candidates)};
564 my $oldchan = $bot->{busy}->[0];
565 my $oldnote = $bot->{busy}->[1];
566 busybot_note_off $offtime - $notetime, $oldchan, $oldnote;
567 my $canplay = busybot_note_on_bot $bot, $time, $channel, $note, 0, 1;
568 die "Canplay but not?"
570 warn "Made $channel:$note play by stopping $oldchan:$oldnote";
571 $notechannelbots{$channel}{$note} = $bot;
581 warn "Not enough bots to play this (when playing $channel:$note)";
584 # my $b = $_->{busy};
585 # warn "$_->{classname} -> @{[$b ? qq{$b->[0]:$b->[1]} : 'none']} @{[$_->{timer} - $notetime]} ($time)\n";
590 warn "Note $channel:$note cannot be played by any bot";
598 my (@preallocate) = @_;
602 die "Cannot preallocate any more $_ bots"
603 if $busybots->{$_}->{count} <= 0;
604 my $bot = Storable::dclone $busybots->{$_};
605 $bot->{id} = @busybots_allocated + 1;
606 $bot->{classname} = $_;
607 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
608 busybot_cmd_bot_execute $bot, 0, ['barrier'];
609 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
611 busybot_cmd_bot_execute $bot, 0, ['barrier'];
612 --$busybots->{$_}->{count};
613 push @busybots_allocated, $bot;
619 my ($filename, $trans) = @_;
622 my $opus = MIDI::Opus->new({from_file => $filename});
623 my $ticksperquarter = $opus->ticks();
624 my $tracks = $opus->tracks_r();
625 my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
629 for($tracks->[0]->events())
632 if($_->[0] eq 'set_tempo')
634 push @tempi, [$tick, $_->[2] * 0.000001 / $ticksperquarter];
641 my $curtempo = [0, 0.5 / $ticksperquarter];
646 # this event is in the past
647 # we add the full time since the last one then
648 $sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
652 # if this event is in the future, we break
657 $sec += ($tick - $curtempo->[0]) * $curtempo->[1];
661 # merge all to a single track
662 my @allmidievents = ();
664 for my $track(0..@$tracks-1)
667 for($tracks->[$track]->events())
669 my ($command, $delta, @data) = @$_;
670 $command = 'note_off' if $command eq 'note_on' and $data[2] == 0;
672 push @allmidievents, [$command, $tick, $sequence++, $track, @data];
676 if(open my $fh, "$filename.vocals")
683 my ($tick, $file) = split /\s+/, $_;
688 elsif($tick eq 'shift')
694 push @allmidievents, ['note_on', $tick * $scale + $shift, $sequence++, -1, -1, $file];
695 push @allmidievents, ['note_off', $tick * $scale + $shift, $sequence++, -1, -1, $file];
700 @allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
703 my $note_min = undef;
704 my $note_max = undef;
709 $t = $tick2sec->($_->[1]);
711 if($_->[0] eq 'note_on')
713 my $chan = $_->[4] + 1;
715 if $chan != 10 and $chan > 0 and (not defined $note_min or $_->[5] < $note_min);
717 if $chan != 10 and $chan > 0 and (not defined $note_max or $_->[5] > $note_max);
718 if($midinotes{$chan}{$_->[5]})
721 busybot_note_off($t - SYS_TICRATE, $chan, $_->[5]);
723 busybot_note_on($t, $chan, $_->[5]);
725 $midinotes{$chan}{$_->[5]} = 1;
727 elsif($_->[0] eq 'note_off')
729 my $chan = $_->[4] + 1;
730 if($midinotes{$chan}{$_->[5]})
733 busybot_note_off($t - SYS_TICRATE, $chan, $_->[5]);
735 $midinotes{$chan}{$_->[5]} = 0;
739 print STDERR "For file $filename:\n";
740 print STDERR " Range of notes: $note_min .. $note_max\n";
741 print STDERR " Safe transpose range: @{[$note_max - 19]} .. @{[$note_min + 13]}\n";
742 print STDERR " Unsafe transpose range: @{[$note_max - 27]} .. @{[$note_min + 18]}\n";
743 print STDERR " Stuck notes: $notes_stuck\n";
745 while(my ($k1, $v1) = each %midinotes)
747 while(my ($k2, $v2) = each %$v1)
749 busybot_note_off($t, $k1, $k2);
753 for(@busybots_allocated)
755 busybot_intermission_bot $_;
762 print STDERR "Bots allocated:\n";
765 for(@busybots_allocated)
767 print STDERR "$_->{id} is a $_->{classname}\n";
768 ++$counthash{$_->{classname}};
769 while(my ($type, $notehash) = each %{$_->{seen}})
771 while(my ($k, $v) = each %$notehash)
773 $notehash{$_->{classname}}{$type}{$k} += $v;
777 for my $cn(sort keys %counthash)
779 print STDERR "$counthash{$cn} bots of $cn have played:\n";
780 for my $type(sort keys %{$notehash{$cn}})
782 for my $note(sort { $a <=> $b } keys %{$notehash{$cn}{$type}})
784 my $cnt = $notehash{$cn}{$type}{$note};
785 print STDERR " $type $note ($cnt times)\n";
789 for(@busybots_allocated)
791 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_predone];
792 busybot_cmd_bot_execute $_, 0, ['barrier'];
795 busybot_cmd_bot_execute $_, 0, @{$_->{done}};
797 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_postdone];
798 busybot_cmd_bot_execute $_, 0, ['barrier'];
802 my @preallocate = ();
809 Preallocate(@preallocate);
813 my $filename = shift @l;
814 my $transpose = shift @l;
815 ConvertMIDI($filename, $transpose);
818 my @preallocate_new = map { $_->{classname} } @busybots_allocated;
819 if(@preallocate_new == @preallocate)
821 print "$precommands$commands";
824 @preallocate = @preallocate_new;
829 unless $@ eq "noalloc\n";