xonotic/misc/tools/midi2cfg-ng.pl
2010-03-18 14:22:15 +01:00

610 lines
13 KiB
Perl
Executable File

#!/usr/bin/perl
# converter from Type 1 MIDI files to CFG files that control bots with the Tuba and other weapons for percussion (requires g_weaponarena all)
use strict;
use warnings;
use MIDI;
use MIDI::Opus;
use Storable;
use constant MIDI_FIRST_NONCHANNEL => 17;
use constant MIDI_DRUMS_CHANNEL => 10;
die "Usage: $0 filename.conf timeoffset_preinit timeoffset_postinit timeoffset_predone timeoffset_postdone timeoffset_preintermission timeoffset_postintermission midifile1 transpose1 midifile2 transpose2 ..."
unless @ARGV > 7 and @ARGV % 2;
my ($config, $timeoffset_preinit, $timeoffset_postinit, $timeoffset_predone, $timeoffset_postdone, $timeoffset_preintermission, $timeoffset_postintermission, @midilist) = @ARGV;
sub unsort(@)
{
return map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } @_;
}
sub override($$);
sub override($$)
{
my ($dest, $src) = @_;
if(ref $src eq 'HASH')
{
$dest = {}
if not defined $dest;
for(keys %$src)
{
$dest->{$_} = override $dest->{$_}, $src->{$_};
}
}
elsif(ref $src eq 'ARRAY')
{
$dest = []
if not defined $dest;
for(@$src)
{
push @$dest, override undef, $_;
}
}
elsif(ref $src)
{
$dest = Storable::dclone $src;
}
else
{
$dest = $src;
}
return $dest;
}
my $precommands = "";
my $commands = "";
my $busybots;
my @busybots_allocated;
my %notechannelbots;
my $transpose = 0;
my $notetime = undef;
my $lowestnotestart = undef;
my $noalloc = 0;
sub botconfig_read($)
{
my ($fn) = @_;
my %bots = ();
open my $fh, "<", $fn
or die "<$fn: $!";
my $currentbot = undef;
my $appendref = undef;
my $super = undef;
while(<$fh>)
{
chomp;
s/\s*#.*//;
next if /^$/;
if(s/^\t\t//)
{
my @cmd = split /\s+/, $_;
if($cmd[0] eq 'super')
{
push @$appendref, @$super
if $super;
}
elsif($cmd[0] eq 'percussion') # simple import
{
push @$appendref, @{$currentbot->{percussion}->{$cmd[1]}};
}
else
{
push @$appendref, \@cmd;
}
}
elsif(s/^\t//)
{
if(/^include (.*)/)
{
my $base = $bots{$1};
$currentbot = override $currentbot, $base;
}
elsif(/^count (\d+)/)
{
$currentbot->{count} = $1;
}
elsif(/^transpose (\d+)/)
{
$currentbot->{transpose} += $1;
}
elsif(/^channels (.*)/)
{
$currentbot->{channels} = { map { $_ => 1 } split /\s+/, $1 };
}
elsif(/^init$/)
{
$super = $currentbot->{init};
$currentbot->{init} = $appendref = [];
}
elsif(/^intermission$/)
{
$super = $currentbot->{intermission};
$currentbot->{intermission} = $appendref = [];
}
elsif(/^done$/)
{
$super = $currentbot->{done};
$currentbot->{done} = $appendref = [];
}
elsif(/^note on (-?\d+)/)
{
$super = $currentbot->{notes_on}->{$1};
$currentbot->{notes_on}->{$1} = $appendref = [];
}
elsif(/^note off (-?\d+)/)
{
$super = $currentbot->{notes_off}->{$1};
$currentbot->{notes_off}->{$1} = $appendref = [];
}
elsif(/^percussion (\d+)/)
{
$super = $currentbot->{percussion}->{$1};
$currentbot->{percussion}->{$1} = $appendref = [];
}
else
{
print "unknown command: $_\n";
}
}
elsif(/^bot (.*)/)
{
$currentbot = ($bots{$1} ||= {count => 0, transpose => 0});
}
elsif(/^raw (.*)/)
{
$precommands .= "$1\n";
}
else
{
print "unknown command: $_\n";
}
}
for(values %bots)
{
for(values %{$_->{notes_on}}, values %{$_->{percussion}})
{
my $t = $_->[0]->[0] eq 'time' ? $_->[0]->[1] : 0;
$lowestnotestart = $t if not defined $lowestnotestart or $t < $lowestnotestart;
}
}
return \%bots;
}
my $busybots_orig = botconfig_read $config;
sub busybot_cmd_bot_test($$@)
{
my ($bot, $time, @commands) = @_;
my $bottime = defined $bot->{timer} ? $bot->{timer} : -1;
my $botbusytime = defined $bot->{busytimer} ? $bot->{busytimer} : -1;
return 0
if $time < $botbusytime;
my $mintime = (@commands && ($commands[0]->[0] eq 'time')) ? $commands[0]->[1] : 0;
return 0
if $time + $mintime < $bottime;
return 1;
}
sub busybot_cmd_bot_execute($$@)
{
my ($bot, $time, @commands) = @_;
for(@commands)
{
if($_->[0] eq 'time')
{
$commands .= sprintf "sv_cmd bot_cmd %d wait_until %f\n", $bot->{id}, $time + $_->[1];
$bot->{timer} = $time + $_->[1];
}
elsif($_->[0] eq 'busy')
{
$bot->{busytimer} = $time + $_->[1];
}
elsif($_->[0] eq 'buttons')
{
my %buttons_release = %{$bot->{buttons} ||= {}};
for(@{$_}[1..@$_-1])
{
/(.*)\??/ or next;
delete $buttons_release{$1};
}
for(keys %buttons_release)
{
$commands .= sprintf "sv_cmd bot_cmd %d releasekey %s\n", $bot->{id}, $_;
delete $bot->{buttons}->{$_};
}
for(@{$_}[1..@$_-1])
{
/(.*)(\?)?/ or next;
defined $2 and next;
$commands .= sprintf "sv_cmd bot_cmd %d presskey %s\n", $bot->{id}, $_;
$bot->{buttons}->{$_} = 1;
}
}
elsif($_->[0] eq 'cmd')
{
$commands .= sprintf "sv_cmd bot_cmd %d %s\n", $bot->{id}, join " ", @{$_}[1..@$_-1];
}
elsif($_->[0] eq 'barrier')
{
$commands .= sprintf "sv_cmd bot_cmd %d barrier\n", $bot->{id};
$bot->{timer} = $bot->{busytimer} = 0;
}
elsif($_->[0] eq 'raw')
{
$commands .= sprintf "%s\n", join " ", @{$_}[1..@$_-1];
}
}
return 1;
}
my $intermissions = 0;
sub busybot_intermission_bot($)
{
my ($bot) = @_;
busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preintermission];
busybot_cmd_bot_execute $bot, 0, ['barrier'];
if($bot->{intermission})
{
busybot_cmd_bot_execute $bot, 0, @{$bot->{intermission}};
}
busybot_cmd_bot_execute $bot, 0, ['barrier'];
$notetime = $timeoffset_postintermission - $lowestnotestart;
}
#my $busy = 0;
sub busybot_note_off_bot($$$$)
{
my ($bot, $time, $channel, $note) = @_;
#print STDERR "note off $bot:$time:$channel:$note\n";
return 1
if $channel == 10;
my $cmds = $bot->{notes_off}->{$note - $bot->{transpose} - $transpose};
return 1
if not defined $cmds; # note off cannot fail
$bot->{busy} = 0;
#--$busy;
#print STDERR "BUSY: $busy bots (OFF)\n";
busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
return 1;
}
sub busybot_note_on_bot($$$$$)
{
my ($bot, $time, $channel, $note, $init) = @_;
return -1 # I won't play on this channel
if defined $bot->{channels} and not $bot->{channels}->{$channel};
my $cmds;
my $cmds_off;
if($channel == 10)
{
$cmds = $bot->{percussion}->{$note};
$cmds_off = undef;
}
else
{
$cmds = $bot->{notes_on}->{$note - $bot->{transpose} - $transpose};
$cmds_off = $bot->{notes_off}->{$note - $bot->{transpose} - $transpose};
}
return -1 # I won't play this note
if not defined $cmds;
return 0
if $bot->{busy};
#print STDERR "note on $bot:$time:$channel:$note\n";
if($init)
{
return 0
if not busybot_cmd_bot_test $bot, $time + $notetime, @$cmds;
busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
busybot_cmd_bot_execute $bot, 0, ['barrier'];
busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
if @{$bot->{init}};
busybot_cmd_bot_execute $bot, 0, ['barrier'];
for(1..$intermissions)
{
busybot_intermission_bot $bot;
}
busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
}
else
{
return 0
if not busybot_cmd_bot_test $bot, $time + $notetime, @$cmds;
busybot_cmd_bot_execute $bot, $time + $notetime, @$cmds;
}
if(defined $cmds and defined $cmds_off)
{
$bot->{busy} = 1;
#++$busy;
#print STDERR "BUSY: $busy bots (ON)\n";
}
return 1;
}
sub busybots_reset()
{
$busybots = Storable::dclone $busybots_orig;
@busybots_allocated = ();
%notechannelbots = ();
$transpose = 0;
$notetime = $timeoffset_postinit - $lowestnotestart;
}
sub busybot_note_off($$$)
{
my ($time, $channel, $note) = @_;
#print STDERR "note off $time:$channel:$note\n";
return 0
if $channel == 10;
if(my $bot = $notechannelbots{$channel}{$note})
{
busybot_note_off_bot $bot, $time, $channel, $note;
delete $notechannelbots{$channel}{$note};
return 1;
}
return 0;
}
sub busybot_note_on($$$)
{
my ($time, $channel, $note) = @_;
if($notechannelbots{$channel}{$note})
{
busybot_note_off $time, $channel, $note;
}
#print STDERR "note on $time:$channel:$note\n";
my $overflow = 0;
for(unsort @busybots_allocated)
{
my $canplay = busybot_note_on_bot $_, $time, $channel, $note, 0;
if($canplay > 0)
{
$notechannelbots{$channel}{$note} = $_;
return 1;
}
$overflow = 1
if $canplay == 0;
# wrong
}
for(unsort keys %$busybots)
{
next if $busybots->{$_}->{count} <= 0;
my $bot = Storable::dclone $busybots->{$_};
$bot->{id} = @busybots_allocated + 1;
$bot->{classname} = $_;
my $canplay = busybot_note_on_bot $bot, $time, $channel, $note, 1;
if($canplay > 0)
{
die "noalloc\n"
if $noalloc;
--$busybots->{$_}->{count};
$notechannelbots{$channel}{$note} = $bot;
push @busybots_allocated, $bot;
return 1;
}
die "Fresh bot cannot play stuff"
if $canplay == 0;
}
if($overflow)
{
warn "Not enough bots to play this (when playing $channel:$note)";
}
else
{
warn "Note $channel:$note cannot be played by any bot";
}
return 0;
}
sub Preallocate(@)
{
my (@preallocate) = @_;
busybots_reset();
for(@preallocate)
{
die "Cannot preallocate any more $_ bots"
if $busybots->{$_}->{count} <= 0;
my $bot = Storable::dclone $busybots->{$_};
$bot->{id} = @busybots_allocated + 1;
$bot->{classname} = $_;
busybot_cmd_bot_execute $bot, 0, ['cmd', 'wait', $timeoffset_preinit];
busybot_cmd_bot_execute $bot, 0, ['barrier'];
busybot_cmd_bot_execute $bot, 0, @{$bot->{init}}
if @{$bot->{init}};
busybot_cmd_bot_execute $bot, 0, ['barrier'];
--$busybots->{$_}->{count};
push @busybots_allocated, $bot;
}
}
sub ConvertMIDI($$)
{
my ($filename, $trans) = @_;
$transpose = $trans;
my $opus = MIDI::Opus->new({from_file => $filename});
my $ticksperquarter = $opus->ticks();
my $tracks = $opus->tracks_r();
my @tempi = (); # list of start tick, time per tick pairs (calculated as seconds per quarter / ticks per quarter)
my $tick;
$tick = 0;
for($tracks->[0]->events())
{
$tick += $_->[1];
if($_->[0] eq 'set_tempo')
{
push @tempi, [$tick, $_->[2] * 0.000001 / $ticksperquarter];
}
}
my $tick2sec = sub
{
my ($tick) = @_;
my $sec = 0;
my $curtempo = [0, 0.5 / $ticksperquarter];
for(@tempi)
{
if($_->[0] < $tick)
{
# this event is in the past
# we add the full time since the last one then
$sec += ($_->[0] - $curtempo->[0]) * $curtempo->[1];
}
else
{
# if this event is in the future, we break
last;
}
$curtempo = $_;
}
$sec += ($tick - $curtempo->[0]) * $curtempo->[1];
return $sec;
};
# merge all to a single track
my @allmidievents = ();
my $sequence = 0;
for my $track(0..@$tracks-1)
{
$tick = 0;
for($tracks->[$track]->events())
{
my ($command, $delta, @data) = @$_;
$command = 'note_off' if $command eq 'note_on' and $data[2] == 0;
$tick += $delta;
push @allmidievents, [$command, $tick, $sequence++, $track, @data];
}
}
@allmidievents = sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] } @allmidievents;
my %midinotes = ();
my $note_min = undef;
my $note_max = undef;
my $notes_stuck = 0;
my $t = 0;
for(@allmidievents)
{
$t = $tick2sec->($_->[1]);
my $track = $_->[3];
if($_->[0] eq 'note_on')
{
my $chan = $_->[4] + 1;
$note_min = $_->[5]
if not defined $note_min or $_->[5] < $note_min and $chan != 10;
$note_max = $_->[5]
if not defined $note_max or $_->[5] > $note_max and $chan != 10;
if($midinotes{$chan}{$_->[5]})
{
--$notes_stuck;
busybot_note_off($t, $chan, $_->[5]);
}
busybot_note_on($t, $chan, $_->[5]);
++$notes_stuck;
$midinotes{$chan}{$_->[5]} = 1;
}
elsif($_->[0] eq 'note_off')
{
my $chan = $_->[4] + 1;
if($midinotes{$chan}{$_->[5]})
{
--$notes_stuck;
busybot_note_off($t, $chan, $_->[5]);
}
$midinotes{$chan}{$_->[5]} = 0;
}
}
print STDERR "For file $filename:\n";
print STDERR " Range of notes: $note_min .. $note_max\n";
print STDERR " Safe transpose range: @{[$note_max - 19]} .. @{[$note_min + 13]}\n";
print STDERR " Unsafe transpose range: @{[$note_max - 27]} .. @{[$note_min + 18]}\n";
print STDERR " Stuck notes: $notes_stuck\n";
while(my ($k1, $v1) = each %midinotes)
{
while(my ($k2, $v2) = each %$v1)
{
busybot_note_off($t, $k1, $k2);
}
}
for(@busybots_allocated)
{
busybot_intermission_bot $_;
}
++$intermissions;
}
sub Deallocate()
{
print STDERR "Bots allocated:\n";
for(@busybots_allocated)
{
print STDERR "$_->{id} is a $_->{classname}\n";
}
for(@busybots_allocated)
{
busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_predone];
busybot_cmd_bot_execute $_, 0, ['barrier'];
if($_->{done})
{
busybot_cmd_bot_execute $_, 0, @{$_->{done}};
}
busybot_cmd_bot_execute $_, 0, ['cmd', 'wait', $timeoffset_postdone];
busybot_cmd_bot_execute $_, 0, ['barrier'];
}
}
my @preallocate = ();
$noalloc = 0;
for(;;)
{
$commands = "";
eval
{
Preallocate(@preallocate);
my @l = @midilist;
while(@l)
{
my $filename = shift @l;
my $transpose = shift @l;
ConvertMIDI($filename, $transpose);
}
Deallocate();
my @preallocate_new = map { $_->{classname} } @busybots_allocated;
if(@preallocate_new == @preallocate)
{
print "$precommands$commands";
exit 0;
}
@preallocate = @preallocate_new;
$noalloc = 1;
1;
} or do {
die "$@"
unless $@ eq "noalloc\n";
};
}