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 midifile1 transpose1 midifile2 transpose2 ..."
19 unless @ARGV > 1 and @ARGV % 2;
21 my $timeoffset_preinit = 2;
22 my $timeoffset_postinit = 2;
23 my $timeoffset_predone = 2;
24 my $timeoffset_postdone = 2;
25 my $timeoffset_preintermission = 2;
26 my $timeoffset_postintermission = 2;
28 my ($config, @midilist) = @ARGV;
32 return map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } @_;
38 my ($dest, $src) = @_;
39 if(ref $src eq 'HASH')
45 $dest->{$_} = override $dest->{$_}, $src->{$_};
48 elsif(ref $src eq 'ARRAY')
54 push @$dest, override undef, $_;
59 $dest = Storable::dclone $src;
71 my @busybots_allocated;
75 my $lowestnotestart = undef;
84 my $currentbot = undef;
85 my $appendref = undef;
94 my @cmd = split /\s+/, $_;
95 if($cmd[0] eq 'super')
97 push @$appendref, @$super
100 elsif($cmd[0] eq 'percussion') # simple import
102 push @$appendref, @{$currentbot->{percussion}->{$cmd[1]}};
106 push @$appendref, \@cmd;
113 my $base = $bots{$1};
114 $currentbot = override $currentbot, $base;
116 elsif(/^count (\d+)/)
118 $currentbot->{count} = $1;
120 elsif(/^transpose (\d+)/)
122 $currentbot->{transpose} ||= 0;
123 $currentbot->{transpose} += $1;
125 elsif(/^channels (.*)/)
127 $currentbot->{channels} = { map { $_ => 1 } split /\s+/, $1 };
129 elsif(/^programs (.*)/)
131 $currentbot->{programs} = { map { $_ => 1 } split /\s+/, $1 };
135 $super = $currentbot->{init};
136 $currentbot->{init} = $appendref = [];
138 elsif(/^intermission$/)
140 $super = $currentbot->{intermission};
141 $currentbot->{intermission} = $appendref = [];
145 $super = $currentbot->{done};
146 $currentbot->{done} = $appendref = [];
148 elsif(/^note on (-?\d+)/)
150 $super = $currentbot->{notes_on}->{$1};
151 $currentbot->{notes_on}->{$1} = $appendref = [];
153 elsif(/^note off (-?\d+)/)
155 $super = $currentbot->{notes_off}->{$1};
156 $currentbot->{notes_off}->{$1} = $appendref = [];
158 elsif(/^percussion (\d+)/)
160 $super = $currentbot->{percussion}->{$1};
161 $currentbot->{percussion}->{$1} = $appendref = [];
165 $super = $currentbot->{vocals};
166 $currentbot->{vocals} = $appendref = [];
170 print "unknown command: $_\n";
175 $currentbot = ($bots{$1} ||= {count => 0});
179 $precommands .= "$1\n";
181 elsif(/^timeoffset_preinit (.*)/)
183 $timeoffset_preinit = $1;
185 elsif(/^timeoffset_postinit (.*)/)
187 $timeoffset_postinit = $1;
189 elsif(/^timeoffset_predone (.*)/)
191 $timeoffset_predone = $1;
193 elsif(/^timeoffset_postdone (.*)/)
195 $timeoffset_postdone = $1;
197 elsif(/^timeoffset_preintermission (.*)/)
199 $timeoffset_preintermission = $1;
201 elsif(/^timeoffset_postintermission (.*)/)
203 $timeoffset_postintermission = $1;
207 print "unknown command: $_\n";
213 for(values %{$_->{notes_on}}, values %{$_->{percussion}})
215 my $t = $_->[0]->[0] eq 'time' ? $_->[0]->[1] : 0;
216 $lowestnotestart = $t if not defined $lowestnotestart or $t < $lowestnotestart;
222 my $busybots_orig = botconfig_read $config;
225 # returns: ($mintime, $maxtime, $busytime)
226 sub busybot_cmd_bot_cmdinfo(@)
232 my $busytime = undef;
236 if($_->[0] eq 'time')
239 if not defined $mintime or $_->[1] < $mintime;
240 $maxtime = $_->[1] + SYS_TICRATE
241 if not defined $maxtime or $_->[1] + SYS_TICRATE > $maxtime;
243 elsif($_->[0] eq 'busy')
245 $busytime = $_->[1] + SYS_TICRATE;
249 return ($mintime, $maxtime, $busytime);
252 sub busybot_cmd_bot_matchtime($$$@)
254 my ($bot, $targettime, $targetbusytime, @commands) = @_;
256 # I want to execute @commands so that I am free on $targettime and $targetbusytime
257 # when do I execute it then?
259 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
261 my $tstart_max = defined $maxtime ? $targettime - $maxtime : $targettime;
262 my $tstart_busy = defined $busytime ? $targetbusytime - $busytime : $targettime;
264 return $tstart_max < $tstart_busy ? $tstart_max : $tstart_busy;
267 # TODO function to find out whether, and when, to insert a command before another command to make it possible
268 # (note-off before note-on)
270 sub busybot_cmd_bot_test($$$@)
272 my ($bot, $time, $force, @commands) = @_;
274 my $bottime = defined $bot->{timer} ? $bot->{timer} : -1;
275 my $botbusytime = defined $bot->{busytimer} ? $bot->{busytimer} : -1;
277 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @commands;
279 if($time < $botbusytime)
281 warn "FORCE: $time < $botbusytime"
286 if(defined $mintime and $time + $mintime < $bottime)
288 warn "FORCE: $time + $mintime < $bottime"
296 sub busybot_cmd_bot_execute($$@)
298 my ($bot, $time, @commands) = @_;
302 if($_->[0] eq 'time')
304 $commands .= sprintf "sv_cmd bot_cmd %d wait_until %f\n", $bot->{id}, $time + $_->[1];
305 if($bot->{timer} > $time + $_->[1] + SYS_TICRATE)
307 #use Carp; carp "Negative wait: $bot->{timer} <= @{[$time + $_->[1] + SYS_TICRATE]}";
309 $bot->{timer} = $time + $_->[1] + SYS_TICRATE;
311 elsif($_->[0] eq 'busy')
313 $bot->{busytimer} = $time + $_->[1] + SYS_TICRATE;
315 elsif($_->[0] eq 'buttons')
317 my %buttons_release = %{$bot->{buttons} ||= {}};
321 delete $buttons_release{$1};
323 for(keys %buttons_release)
325 $commands .= sprintf "sv_cmd bot_cmd %d releasekey %s\n", $bot->{id}, $_;
326 delete $bot->{buttons}->{$_};
332 $commands .= sprintf "sv_cmd bot_cmd %d presskey %s\n", $bot->{id}, $_;
333 $bot->{buttons}->{$_} = 1;
336 elsif($_->[0] eq 'cmd')
338 $commands .= sprintf "sv_cmd bot_cmd %d %s\n", $bot->{id}, join " ", @{$_}[1..@$_-1];
340 elsif($_->[0] eq 'barrier')
342 $commands .= sprintf "sv_cmd bot_cmd %d barrier\n", $bot->{id};
343 $bot->{timer} = $bot->{busytimer} = 0;
345 elsif($_->[0] eq 'raw')
347 $commands .= sprintf "%s\n", join " ", @{$_}[1..@$_-1];
354 my $intermissions = 0;
356 sub busybot_intermission_bot($)
359 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preintermission];
360 busybot_cmd_bot_execute $bot, 0, ['barrier'];
361 if($bot->{intermission})
363 busybot_cmd_bot_execute $bot, 0, @{$bot->{intermission}};
365 busybot_cmd_bot_execute $bot, 0, ['barrier'];
366 $notetime = $timeoffset_postintermission - $lowestnotestart;
370 sub busybot_note_off_bot($$$$)
372 my ($bot, $time, $channel, $note) = @_;
373 #print STDERR "note off $bot:$time:$channel:$note\n";
374 my ($busychannel, $busynote, $cmds) = @{$bot->{busy}};
376 if not defined $cmds; # note off cannot fail
377 die "Wrong note-off?!?"
378 if $busychannel != $channel || $busynote ne $note;
379 $bot->{busy} = undef;
381 my $t = $time + $notetime;
382 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
384 # perform note-off "as soon as we can"
385 $t = $bot->{busytimer}
386 if $t < $bot->{busytimer};
387 $t = $bot->{timer} - $mintime
388 if $t < $bot->{timer} - $mintime;
390 busybot_cmd_bot_execute $bot, $t, @$cmds;
394 sub busybot_get_cmds_bot($$$)
396 my ($bot, $channel, $note) = @_;
397 my ($k0, $k1, $cmds, $cmds_off) = (undef, undef, undef, undef);
401 $cmds = $bot->{vocals};
404 $cmds = [ map { [ map { $_ eq '%s' ? $note : $_ } @$_ ] } @$cmds ];
409 elsif($channel == 10)
412 $cmds = $bot->{percussion}->{$note};
419 $cmds = $bot->{notes_on}->{$note - ($bot->{transpose} || 0) - $transpose};
420 $cmds_off = $bot->{notes_off}->{$note - ($bot->{transpose} || 0) - $transpose};
422 $k1 = $note - ($bot->{transpose} || 0) - $transpose;
424 return ($cmds, $cmds_off, $k0, $k1);
427 sub busybot_note_on_bot($$$$$$$)
429 my ($bot, $time, $channel, $program, $note, $init, $force) = @_;
430 return -1 # I won't play on this channel
431 if defined $bot->{channels} and not $bot->{channels}->{$channel};
432 return -1 # I won't play this program
433 if defined $bot->{programs} and not $bot->{programs}->{$program};
435 my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot($bot, $channel, $note);
437 return -1 # I won't play this note
438 if not defined $cmds;
441 #print STDERR "note on $bot:$time:$channel:$note\n";
445 if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds;
446 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
447 busybot_cmd_bot_execute $bot, 0, ['barrier'];
448 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
450 busybot_cmd_bot_execute $bot, 0, ['barrier'];
451 for(1..$intermissions)
453 busybot_intermission_bot $bot;
455 # we always did a barrier, so we know this works
456 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
461 if not busybot_cmd_bot_test $bot, $time + $notetime, $force, @$cmds;
462 busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
464 if(defined $cmds and defined $cmds_off)
466 $bot->{busy} = [$channel, $note, $cmds_off];
468 ++$bot->{seen}{$k0}{$k1};
474 $busybots = Storable::dclone $busybots_orig;
475 @busybots_allocated = ();
476 %notechannelbots = ();
478 $notetime = $timeoffset_postinit - $lowestnotestart;
481 sub busybot_note_off($$$)
483 my ($time, $channel, $note) = @_;
485 # print STDERR "note off $time:$channel:$note\n";
492 if(my $bot = $notechannelbots{$channel}{$note})
494 busybot_note_off_bot $bot, $time, $channel, $note;
495 delete $notechannelbots{$channel}{$note};
502 sub busybot_note_on($$$$)
504 my ($time, $channel, $program, $note) = @_;
506 if($notechannelbots{$channel}{$note})
508 busybot_note_off $time, $channel, $note;
511 # print STDERR "note on $time:$channel:$note\n";
515 my @epicfailbots = ();
517 for(unsort @busybots_allocated)
519 my $canplay = busybot_note_on_bot $_, $time, $channel, $program, $note, 0, 0;
522 $notechannelbots{$channel}{$note} = $_;
525 push @epicfailbots, $_
532 for(unsort keys %$busybots)
534 next if $busybots->{$_}->{count} <= 0;
535 my $bot = Storable::dclone $busybots->{$_};
536 $bot->{id} = @busybots_allocated + 1;
537 $bot->{classname} = $_;
538 my $canplay = busybot_note_on_bot $bot, $time, $channel, $program, $note, 1, 0;
547 --$busybots->{$_}->{count};
548 $notechannelbots{$channel}{$note} = $bot;
549 push @busybots_allocated, $bot;
553 die "Fresh bot cannot play stuff"
559 # we cannot add a new bot to play this
560 # we could try finding a bot that could play this, and force him to stop the note!
562 my @candidates = (); # contains: [$bot, $score, $offtime]
564 # put in all currently busy bots that COULD play this, if they did a note-off first
565 for my $bot(@epicfailbots)
568 if $busybots->{$bot->{classname}}->{count} != 0;
571 my ($busy_chan, $busy_note, $busy_cmds_off) = @{$bot->{busy}};
573 unless $busy_cmds_off;
574 my ($cmds, $cmds_off, $k0, $k1) = busybot_get_cmds_bot $bot, $channel, $note;
577 my ($mintime, $maxtime, $busytime) = busybot_cmd_bot_cmdinfo @$cmds;
578 my ($mintime_off, $maxtime_off, $busytime_off) = busybot_cmd_bot_cmdinfo @$busy_cmds_off;
580 my $noteofftime = busybot_cmd_bot_matchtime $bot, $time + $notetime + $mintime, $time + $notetime, @$busy_cmds_off;
582 if $noteofftime < $bot->{busytimer};
584 if $noteofftime + $mintime_off < $bot->{timer};
587 # prefer turning off long notes
588 $score += 100 * ($noteofftime - $bot->{timer});
589 # prefer turning off low notes
590 $score += 1 * (-$note);
591 # prefer turning off notes that already play on another channel
592 $score += 1000 * (grep { $_ != $busy_chan && $notechannelbots{$_}{$busy_note} && $notechannelbots{$_}{$busy_note}{busy} } keys %notechannelbots);
594 push @candidates, [$bot, $score, $noteofftime];
601 @candidates = sort { $a->[1] <=> $b->[1] } @candidates;
602 my ($bot, $score, $offtime) = @{(pop @candidates)};
603 my $oldchan = $bot->{busy}->[0];
604 my $oldnote = $bot->{busy}->[1];
605 busybot_note_off $offtime - $notetime, $oldchan, $oldnote;
606 my $canplay = busybot_note_on_bot $bot, $time, $channel, $program, $note, 0, 1;
607 die "Canplay but not?"
609 warn "Made $channel:$note play by stopping $oldchan:$oldnote";
610 $notechannelbots{$channel}{$note} = $bot;
620 warn "Not enough bots to play this (when playing $channel:$note)";
623 # my $b = $_->{busy};
624 # warn "$_->{classname} -> @{[$b ? qq{$b->[0]:$b->[1]} : 'none']} @{[$_->{timer} - $notetime]} ($time)\n";
629 warn "Note $channel:$note cannot be played by any bot";
637 my (@preallocate) = @_;
641 die "Cannot preallocate any more $_ bots"
642 if $busybots->{$_}->{count} <= 0;
643 my $bot = Storable::dclone $busybots->{$_};
644 $bot->{id} = @busybots_allocated + 1;
645 $bot->{classname} = $_;
646 busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
647 busybot_cmd_bot_execute $bot, 0, ['barrier'];
648 busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
650 busybot_cmd_bot_execute $bot, 0, ['barrier'];
651 --$busybots->{$_}->{count};
652 push @busybots_allocated, $bot;
658 my ($filename, $trans) = @_;
661 my $opus = MIDI::Opus->new({from_file => $filename});
662 my $ticksperquarter = $opus->ticks();
663 my $tracks = $opus->tracks_r();
664 my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
668 for($tracks->[0]->events())
671 if($_->[0] eq 'set_tempo')
673 push @tempi, [$tick, $_->[2] * 0.000001 / $ticksperquarter];
680 my $curtempo = [0, 0.5 / $ticksperquarter];
685 # this event is in the past
686 # we add the full time since the last one then
687 $sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
691 # if this event is in the future, we break
696 $sec += ($tick - $curtempo->[0]) * $curtempo->[1];
700 # merge all to a single track
701 my @allmidievents = ();
703 for my $track(0..@$tracks-1)
706 for($tracks->[$track]->events())
708 my ($command, $delta, @data) = @$_;
709 $command = 'note_off' if $command eq 'note_on' and $data[2] == 0;
711 push @allmidievents, [$command, $tick, $sequence++, $track, @data];
715 if(open my $fh, "$filename.vocals")
722 my ($tick, $file) = split /\s+/, $_;
727 elsif($tick eq 'shift')
733 push @allmidievents, ['note_on', $tick * $scale + $shift, $sequence++, -1, -1, $file];
734 push @allmidievents, ['note_off', $tick * $scale + $shift, $sequence++, -1, -1, $file];
739 @allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
748 $t = $tick2sec->($_->[1]);
750 if($_->[0] eq 'note_on')
752 my $chan = $_->[4] + 1;
753 ++$notes_seen{$chan}{($programs{$chan} || 1)}{$_->[5]};
754 if($midinotes{$chan}{$_->[5]})
757 busybot_note_off($t - SYS_TICRATE, $chan, $_->[5]);
759 busybot_note_on($t, $chan, $programs{$chan} || 1, $_->[5]);
761 $midinotes{$chan}{$_->[5]} = 1;
763 elsif($_->[0] eq 'note_off')
765 my $chan = $_->[4] + 1;
766 if($midinotes{$chan}{$_->[5]})
769 busybot_note_off($t - SYS_TICRATE, $chan, $_->[5]);
771 $midinotes{$chan}{$_->[5]} = 0;
773 elsif($_->[0] eq 'patch_change')
775 my $chan = $_->[4] + 1;
776 my $program = $_->[5] + 1;
777 $programs{$chan} = $program;
781 print STDERR "For file $filename:\n";
782 print STDERR " Stuck notes: $notes_stuck\n";
784 for my $testtranspose(-127..127)
789 for my $channel(sort keys %notes_seen)
791 next if $channel == 10 or $channel < 0;
792 for my $program(sort keys %{$notes_seen{$channel}})
794 for my $note(sort keys %{$notes_seen{$channel}{$program}})
796 my $cnt = $notes_seen{$channel}{$program}{$note};
800 for(@busybots_allocated)
802 next # I won't play on this channel
803 if defined $_->{channels} and not $_->{channels}->{$channel};
804 next # I won't play this program
805 if defined $_->{programs} and not $_->{programs}->{$program};
806 my $transposed = $note - ($_->{transpose} || 0) - $testtranspose;
807 if(exists $_->{notes_on}{$transposed})
813 ++$votehigh if $transposed >= 0;
814 ++$votelow if $transposed < 0;
821 elsif($votelow >= $votehigh)
832 next if !$toohigh != !$toolow;
833 print STDERR " Transpose $testtranspose: $toohigh too high, $toolow too low, $good good\n";
836 for my $program(sort keys %{$notes_seen{10}})
838 for my $note(sort keys %{$notes_seen{10}{$program}})
840 my $cnt = $notes_seen{10}{$program}{$note};
842 for(@busybots_allocated)
844 next # I won't play on this channel
845 if defined $_->{channels} and not $_->{channels}->{10};
846 next # I won't play this program
847 if defined $_->{programs} and not $_->{programs}->{$program};
848 if(exists $_->{percussion}{$note})
855 print STDERR "Failed percussion $note ($cnt times)\n";
860 while(my ($k1, $v1) = each %midinotes)
862 while(my ($k2, $v2) = each %$v1)
864 busybot_note_off($t, $k1, $k2);
868 for(@busybots_allocated)
870 busybot_intermission_bot $_;
877 print STDERR "Bots allocated:\n";
880 for(@busybots_allocated)
882 print STDERR "$_->{id} is a $_->{classname}\n";
883 ++$counthash{$_->{classname}};
884 while(my ($type, $notehash) = each %{$_->{seen}})
886 while(my ($k, $v) = each %$notehash)
888 $notehash{$_->{classname}}{$type}{$k} += $v;
892 for my $cn(sort keys %counthash)
894 print STDERR "$counthash{$cn} bots of $cn have played:\n";
895 for my $type(sort keys %{$notehash{$cn}})
897 for my $note(sort { $a <=> $b } keys %{$notehash{$cn}{$type}})
899 my $cnt = $notehash{$cn}{$type}{$note};
900 print STDERR " $type $note ($cnt times)\n";
904 for(@busybots_allocated)
906 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_predone];
907 busybot_cmd_bot_execute $_, 0, ['barrier'];
910 busybot_cmd_bot_execute $_, 0, @{$_->{done}};
912 busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_postdone];
913 busybot_cmd_bot_execute $_, 0, ['barrier'];
917 my @preallocate = ();
924 Preallocate(@preallocate);
928 my $filename = shift @l;
929 my $transpose = shift @l;
930 ConvertMIDI($filename, $transpose);
933 my @preallocate_new = map { $_->{classname} } @busybots_allocated;
934 if(@preallocate_new == @preallocate)
936 print "$precommands$commands";
939 @preallocate = @preallocate_new;
944 unless $@ eq "noalloc\n";