Annotation of /t2matchlog/t2matchlog

#!/bin/perl -W

use strict;
use GD;

die "Usage: perl $0 logfile outputdir" unless @ARGV == 2;
open LOG, $ARGV[0] or die "Failed to open $ARGV[0]: $!";
my $outdir = $ARGV[1];
mkdir $outdir or die "Failed to create output directory $outdir: $!";
my $dir = $0;
$dir =~ s!(^|/)[^/]+$!$1!;
(system "cp ${dir}t2matchlog.css $outdir/") == 0 or die "Failed to copy stylesheet: $!";

$/ = "\r\n";
$| = 1;

my $near0 = 70;
my $near1 = 200;
my $thumbsize = 400;

# from damageTypes.cs
my @DamageTypeText;
$DamageTypeText[0] = 'default';
$DamageTypeText[1] = 'blaster';
$DamageTypeText[2] = 'plasma';
$DamageTypeText[3] = 'chaingun';
$DamageTypeText[4] = 'disc';
$DamageTypeText[5] = 'grenade';
$DamageTypeText[6] = 'laser';
$DamageTypeText[7] = 'ELF';
$DamageTypeText[8] = 'mortar';
$DamageTypeText[9] = 'missile';
$DamageTypeText[10] = 'shocklance';
$DamageTypeText[11] = 'mine';
$DamageTypeText[12] = 'explosion';
$DamageTypeText[13] = 'impact';
$DamageTypeText[14] = 'ground';
$DamageTypeText[15] = 'turret';
$DamageTypeText[16] = 'plasma turret';
$DamageTypeText[17] = 'AA turret';
$DamageTypeText[18] = 'ELF turret';
$DamageTypeText[19] = 'mortar turret';
$DamageTypeText[20] = 'missile turret';
$DamageTypeText[21] = 'clamp turret';
$DamageTypeText[22] = 'spike turret';
$DamageTypeText[23] = 'sentry turret';
$DamageTypeText[24] = 'out of bounds';
$DamageTypeText[25] = 'lava';
$DamageTypeText[26] = 'shrike blaster';
$DamageTypeText[27] = 'belly turret';
$DamageTypeText[28] = 'bomber bomb';
$DamageTypeText[29] = 'tank chaingun';
$DamageTypeText[30] = 'tank mortar';
$DamageTypeText[31] = 'satchel charge';
$DamageTypeText[32] = 'MPB missile';
$DamageTypeText[33] = 'lighting';
$DamageTypeText[35] = 'ForceField';
$DamageTypeText[36] = 'Crash';
$DamageTypeText[98] = 'nexus camping';
$DamageTypeText[99] = 'suicide';

my $icon_player = load_image("${dir}icons/com_player_grey_24x.png");
my %icon;
$icon{'flag'} = load_image("${dir}icons/com_icon_flag_outside.png");
$icon{'gen'} = load_image("${dir}icons/com_icon_generator.png");
$icon{'turret'} = load_image("${dir}icons/com_icon_turretbase.png");
$icon{'inv'} = load_image("${dir}icons/com_icon_inventory.png");
$icon{'sensor'} = load_image("${dir}icons/com_icon_sensor.png");
$icon{'vpad'} = load_image("${dir}icons/com_icon_vehicle_inventory.png");
$icon{'solar'} = load_image("${dir}icons/com_icon_solar_gen.png");

my %colour = ('S' => 0xffff00, 'A' => 0xff8000, 'KK' => 0x00ff00, 'K' => 0xff0000,
                'L' => 0xff8000, 'F+' => 0x00ffff, 'F-' => 0xff00ff, 'P' => 0xff8000,
                'V' => 0xffff00, 'W' => 0xff0000, 'G' => 0x0080ff, 'J' => 0x00ff80,
                'GG' => 0x0080ff, 'JJ' => 0x00ff80);
my $colour_me = 0xffffff;
my %desc = ('S' => 'spawned on team $team_name[$p1]',
                'A' => '$p1 armour',
                'KK' => 'killed $enemy using $DamageTypeText[$p2]',
                'K' => 'killed by $DamageTypeText[$p2] $enemy',
                'L' => 'left the game',
                'F+' => 'took the $team_name[$p1] flag',
                'F-' => 'dropped the $team_name[$p1] flag',
                'P' => '$p1',
                'V' => 'vehicle created',
                'W' => 'vehicle destroyed',
                'G' => 'entered " . vehicle_link($p1) . " as ${seat{$p2}}',
                'J' => 'ejected from vehicle',
                'GG' => '<a href=\'" . safe_name($p1) . ".html#t$time\'>$p1</a> entered as ${seat{$p2}}',
                'JJ' => '<a href=\'" . safe_name($p1) . ".html#t$time\'>$p1</a> ejected');
my @teamcol = (0xffffff, 0x0000ff, 0xff00ff);
my %seat = ('' => 'a passenger', 'p' => 'pilot', 'w' => 'gunner');
my %veh_name = ('BomberFlyer' => 'Bomber',
                'HAPCFlyer' => 'Havoc',
                'MobileBaseVehicle' => 'MPB',
                'ScoutFlyer' => 'Shrike',
                'AssaultVehicle' => 'Tank',
                'ScoutVehicle' => 'Wildcat');

my ($mission, $mission_type, $mission_name, $mission_type_name, $x0, $y0, $width, $height);
my (@landmarks, @waypoints);

print "reading data";
read_header();

my @events = ();
my @coords = ();
my %score = ();
my %kills = ();
my %deaths = ();
my %player = ();
my %vehicle = ();
my %team = ();
my $end_time;
my (@final_score, @team_name);

read_data();
print ".\n";

my $imall = create_image();

my $player;
foreach $player (keys %player) {
        print "$player";
        write_player_report($player);
        print ".\n";
}
my $vehicle;
foreach $vehicle (keys %vehicle) {
        my ($team, $name) = split / /, $vehicle, 2;
        print "$team_name[$team] $veh_name{$name}s";
        write_vehicle_report($name, $team);
        print ".\n";
}
write_summary_report();

exit;

####################################################################################################

sub read_header {
        $mission = <LOG>; chomp $mission;
        $mission_type = <LOG>; chomp $mission_type;
        $mission_name = <LOG>; chomp $mission_name;
        $mission_type_name = <LOG>; chomp $mission_type_name;
        my $area = <LOG>; chomp $area; ($x0, $y0, $width, $height) = split / /, $area;

        while (($_ = <LOG>) ne $/) {
                chomp;
                my ($team, $type, $block, $name, $x, $y, $z, $desc) = split / /, $_, 8;
                $x -= $x0; $y = $height - $y + $y0;
                if ($type eq 'StaticShape' and $block eq 'GeneratorLarge') {
                        push @landmarks, "$z gen $team $x $y";
                } elsif ($type eq 'Turret' and $block eq 'TurretBaseLarge') {
                        push @landmarks, "$z turret $team $x $y";
                } elsif ($type eq 'StaticShape' and $block eq 'ExteriorFlagStand') {
                        push @landmarks, "$z flag $team $x $y";
                } elsif ($type eq 'StaticShape' and $block eq 'StationVehicle') {
                        push @landmarks, "$z vpad $team $x $y";
                } elsif ($type eq 'StaticShape' and $block eq 'StationInventory') {
                        push @landmarks, "$z inv $team $x $y";
                } elsif ($type eq 'StaticShape' and $block eq 'SensorLargePulse') {
                        push @landmarks, "$z sensor $team $x $y";
                } elsif ($type eq 'StaticShape' and $block eq 'SolarPanel') {
                        push @landmarks, "$z solar $team $x $y";
                } elsif ($type eq 'WayPoint' and $block eq 'WayPointMarker') {
                        push @waypoints, "$team $x $y $z $desc";
                }
        }

        # sort by height for nicer plotting
        @landmarks = sort { my ($az, $ra) = split / /, $a, 2; my ($bz, $rb) = split / /, $b, 2;
                        return $az <=> $bz; } @landmarks;
}

####################################################################################################

sub read_data {
        my $time = 0;
        my %name = ();
        my @flag_carrier;
        my %player_veh;

        while (<LOG>) {
                chomp;
                if ($_ eq '') {
                        $time++;
                        next;
                }

                my ($cmd, $params) = split / /, $_, 2;

                if ($cmd eq 'S') {              # player spawned
                        my ($id, $team, $name) = split / /, $params, 3;
                        $name{$id} = $name;
                        push @events, [$time, 'S', $name, $team];
                        $player{$name} = 1;
                        $team{$name} = $team;
                        $player_veh{$name} = 0;

                } elsif ($cmd eq 'K') {         # player killed
                        my ($victim, $killer, $weapon) = split / /, $params;
                        $deaths{$name{$victim}}++;
                        $kills{$name{$killer}}++ if exists $name{$killer};
                        push @events, [$time, 'K', $name{$victim}, $name{$killer}, $weapon];
                        push @events, [$time, 'KK', $name{$killer}, $name{$victim}, $weapon]
                                        if exists $name{$killer};
                        if (exists $name{$killer} and $player_veh{$name{$killer}}) {
                                push @events, [$time, 'KK', $name{$player_veh{$name{$killer}}},
                                                $name{$victim}, $weapon];
                        }
                        # if (defined $player_veh{$name})  TODO
                        delete $name{$victim};

                } elsif ($cmd eq 'L') {         # player left
                        my ($id, $score) = split / /, $params;
                        push @events, [$time, 'L', $name{$id}];
                        $score{$name{$id}} += $score;
                        delete $name{$id};

                } elsif ($cmd eq 'A') {         # armour changed
                        my ($id, $armour) = split / /, $params;
                        push @events, [$time, 'A', $name{$id}, $armour];

                } elsif ($cmd eq 'I') {         # inventory changed
                        my ($id, $item, $count) = split / /, $params;
                        if ($item =~ m/(Pack|SatchelCharge)$/ and $count == 1) {
                                $item =~ s/Pack$/ pack/;
                                push @events, [$time, 'P', $name{$id}, $item];
                        }

                } elsif ($cmd eq 'D') {         # player damaged
                        my ($victim, $attacker, $weapon) = split / /, $params;

                } elsif ($cmd eq 'V') {         # new vehicle
                        my ($id, $team, $name) = split / /, $params, 3;
                        $vehicle{"$team $name"}++;
                        $name{$id} = "$team $name " . $vehicle{"$team $name"};
                        $team{$name{$id}} = $team;
                        push @events, [$time, 'V', $name{$id}];

                } elsif ($cmd eq 'W') {         # vehicle destroyed
                        my $id = $params;
                        push @events, [$time, 'W', $name{$id}];
                        #delete $name{$id};

                } elsif ($cmd eq 'Z') {         # final score
                        my ($team, $score, $team_name) = split / /, $params, 3;
                        $final_score[$team] = $score;
                        $team_name[$team] = $team_name;

                } elsif ($cmd eq 'F') {         # flag position
                        my ($team, @data) = split / /, $params;
                        my $carrier;
                        $flag_carrier[$team] = 0 unless defined $flag_carrier[$team];
                        if (@data == 3) {
                                my ($x, $y, $z) = @data;
                                $x -= $x0; $y = $height - $y + $y0;
                                $carrier = 0;
                        } else {
                                $carrier = $name{$data[0]};
                        }
                        if ($carrier ne $flag_carrier[$team]) {
                                if ($flag_carrier[$team]) {
                                        push @events, [$time, 'F-', $flag_carrier[$team], $team];
                                }
                                if ($carrier) {
                                        push @events, [$time, 'F+', $carrier, $team];
                                }
                                $flag_carrier[$team] = $carrier;
                        }

                } else {                        # player / vehicle position
                        my $id = $cmd;
                        next unless exists $name{$id};
                        my $name = $name{$id};
                        my ($x, $y, $z, $vehicle, $seat) = split / /, $params;
                        $x -= $x0; $y = $height - $y + $y0;
                        ${$coords[$time]}{$name} = "$x $y $z";
                        next unless defined $player{$name};
                        if ($player_veh{$name} != $vehicle) {
                                if ($player_veh{$name}) {
                                        push @events, [$time, 'J', $name];
                                        push @events, [$time, 'JJ',
                                                        $name{$player_veh{$name}}, $name];
                                }
                                if ($vehicle != 0) {
                                        push @events, [$time, 'G', $name,
                                                        $name{$vehicle}, $seat];
                                        push @events, [$time, 'GG', $name{$vehicle},
                                                        $name, $seat];
                                }
                                $player_veh{$name} = $vehicle;
                        }
                }
        }
        $end_time = $time + 1;
}

####################################################################################################

sub write_player_report {
        my $player = shift;

        my $score = exists $score{$player} ? $score{$player} : 0;
        my $deaths = exists $deaths{$player} ? $deaths{$player} : 0;
        my $kills = exists $kills{$player} ? $kills{$player} : 0;
        my $sname = safe_name($player);
        my $html = create_html($player);

        $html .= <<END;
<p>Total score $score, deaths $deaths, kills $kills. <a href="./">Match summary.</a></p>
END

        # find spawn / death times
        my @spawn = map $$_[0], (grep {$$_[2] eq $player and $$_[1] eq 'S'} @events);
        my @death = map $$_[0], (grep {$$_[2] eq $player and 
                        ($$_[1] eq 'K' or $$_[1] eq 'L')} @events);
        push @spawn, $end_time;

        for (my $life = 0; $life != @spawn - 1; $life++) {
                my $nicetime = nice_time($spawn[$life]);
                my $nicedtime = nice_time($death[$life]);
                my $life1 = $life + 1;
                $html .= <<END;
<div><h2 id="life$life1">Life $life1 ($nicetime - $nicedtime)</h2>
<div><a href="${sname}_$life1.png"><img src="s${sname}_$life1.png"
alt="" title="Map of life $life1"></a></div>
END
                $html .= player_life($player, "${sname}_$life1.png",
                                $spawn[$life], $spawn[$life1] - 1);
                $html .= '</div>';
        }

        save_html(safe_name($player) . '.html', $html);
}

####################################################################################################

sub player_life {
        my $player = shift;
        my $imname = shift;
        my $time0 = shift;
        my $time1 = shift;

        my $prev_time = -1;

        my $html = "<table>\n";

        my $im = create_image();
        plot_route($im, $player, $time0, $time1);

        my @evs = grep {$$_[2] eq $player and $time0 <= $$_[0] and $$_[0] <= $time1} @events;

        my $event;
        foreach $event (@evs) {
                my ($time, $ev, $me, $p1, $p2) = @$event;

                my $nicetime = nice_time($time);
                if ($time == $prev_time) {
                        $html .= '<tr><td></td>';
                } else {
                        $html .= "<tr id='t$time'><td class='time'>$nicetime</td>";
                }

                my $enemy = '';
                if (($ev eq 'K' or $ev eq 'KK') and defined $p1) {
                        my $sname_en = safe_name($p1);
                        $enemy = "<a href='$sname_en.html#t$time'>$p1</a>";
                }
                my $desc = eval '"' . $desc{$ev} . '"';
                my $hexcol = sprintf "%.6lx", $colour{$ev};
                $html .= "<td style='color: #$hexcol'>$desc</td></tr>\n";

                if (exists ${$coords[$time]}{$player}) {
                        my ($x, $y, $z) = split / /, ${$coords[$time]}{$player};
                        square($im, $x, $y, 8, $colour{$ev});
                } elsif (exists ${$coords[$time - 1]}{$player}) {
                        my ($x, $y, $z) = split / /, ${$coords[$time - 1]}{$player};
                        square($im, $x, $y, 8, $colour{$ev});
                }
                $prev_time = $time;
        }

        $html .= "</table>\n";
        save_image($im, $imname);

        return $html;
}

####################################################################################################

sub plot_route {
        my $image = shift;
        my $name = shift;
        my $t0 = shift;
        my $t1 = shift;
        my %near = ();
        for (my $t = $t0; $t != $t1; $t++) {
                my $s = ($t % 10) == 0 ? 2 : 1;
                if (exists ${$coords[$t]}{$name}) {
                        my ($x0, $y0, $z0) = split / /, ${$coords[$t]}{$name};
                        my $near;
                        foreach $near (keys %near) {
                                if (exists ${$coords[$t]}{$near}) {
                                        my ($xn, $yn, $zn) = split / /, ${$coords[$t]}{$near};
                                        delete $near{$near} if $near1 < distance($x0, $y0, $z0,
                                                        $xn, $yn, $zn);
                                } else {
                                        delete $near{$near};
                                }
                        }
                        foreach $near (keys %player) {
                                next if $near eq $name;
                                next if exists $near{$near};
                                if (exists ${$coords[$t]}{$near}) {
                                        my ($xn, $yn, $zn) = split / /, ${$coords[$t]}{$near};
                                        if (distance($x0, $y0, $z0, $xn, $yn, $zn) < $near0) {
                                                $near{$near} = 1;
                                                line($image, $x0, $y0, $xn, $yn, 0x444444);
                                                text($image, $xn, $yn, $near);
                                        }
                                }
                        }
                        foreach $near (keys %near) {
                                my ($xn0, $yn0, $zn0) = split / /, ${$coords[$t]}{$near};
                                my $colour = $team{$name} == $team{$near} ? 0x00ff00 : 0xff0000;
                                line($image, $x0, $y0, $xn0, $yn0, 0x444444) if $s == 2;
                                if (exists ${$coords[$t + 1]}{$near}) {
                                        my ($xn1, $yn1, $zn1) = split / /,
                                                        ${$coords[$t + 1]}{$near};
                                        line($image, $xn0, $yn0, $xn1, $yn1, $colour);
                                }
                                square($image, $xn0, $yn0, $s, $colour);
                        }
                        if (exists ${$coords[$t + 1]}{$name}) {
                                my ($x1, $y1, $z1) = split / /, ${$coords[$t + 1]}{$name};
                                line($image, $x0, $y0, $x1, $y1, $colour_me);
                                line($imall, $x0, $y0, $x1, $y1, $teamcol[$team{$name}]);
                        }
                        square($image, $x0, $y0, $s, $colour_me);
                        text($image, $x0, $y0, nice_time($t)) if $s == 2;
                }
        }
}

####################################################################################################

sub write_vehicle_report {
        my $name = shift;
        my $team = shift;

        my $sname = safe_name($name);
        my $html = create_html($team_name[$team] . ' ' . $veh_name{$name} . 's');
        $html .= '<p><a href="./">Match summary.</a></p>';

        my $run;
        for ($run = 1; $run != $vehicle{"$team $name"} + 1; $run++) {
                my @ev = grep {$$_[2] eq "$team $name $run"} @events;
                my $time0 = ${$ev[0]}[0];
                my $time1 = ${$ev[-1]}[1] eq 'W' ? ${$ev[-1]}[0] : $end_time;
                my $nicetime = nice_time($time0);
                my $nicedtime = nice_time($time1);

                $html .= <<END;
<div><h2 id="life$run">$veh_name{$name} $run ($nicetime - $nicedtime)</h2>
<div><a href="${team}_${sname}_$run.png"><img src="s${team}_${sname}_$run.png"
alt="" title="Map of $veh_name{$name} $run"></a></div>
END
                $html .= player_life("$team $name $run", "${team}_${sname}_$run.png",
                                $time0, $time1);
                $html .= '</div>';
        }

        save_html("${team}_$sname.html", $html);
}

####################################################################################################

sub vehicle_link {
        my $s = shift;
        my ($team, $name, $run) = split / /, $s;
        return "<a href='${team}_$name.html#life$run'>$team_name[$team] $veh_name{$name} $run</a>";
}

####################################################################################################

sub write_summary_report {
        my $html = create_html("Match Summary");
        my $name;
        my $nicetime = nice_time($end_time);
        my $i;

        $html .= <<END;
<div><a href="Overview.png"><img src="sOverview.png"
alt="" title="Overview map"></a></div>
<p>Playing time $nicetime</p>
<table><tr><th>Final scores</th></tr>
END
        for ($i = 1; $i != @team_name; $i++) {
                $html .= "<tr><td>${team_name[$i]}</td><td>${final_score[$i]}</td></tr>\n";
        }

        $html .= <<END;
</table>
<table>
<tr><th>Player</th><th>Team</th><th>Score</th><th>Deaths</th><th>Kills</th></tr>
END

        foreach $name (sort keys %player) {
                my $sname = safe_name($name);
                my $score = exists $score{$name} ? $score{$name} : 0;
                my $deaths = exists $deaths{$name} ? $deaths{$name} : 0;
                my $kills = exists $kills{$name} ? $kills{$name} : 0;
                $html .= <<END;
<tr><td><a href="$sname.html">$name</a></td><td>$team_name[$team{$name}]</td><td>$score</td><td>$deaths</td><td>$kills</td></tr>
END
        }

        $html .= "</table>\n";

        $html .= "<table><tr><th>Vehicles</th><th>Total used</th></tr>\n";
        foreach $vehicle (sort keys %vehicle) {
                my ($team, $name) = split / /, $vehicle, 2;
                my $sname = safe_name($name);
                $html .= <<END;
<tr><td><a href="${team}_$sname.html">$team_name[$team] $veh_name{$name}s</a></td><td>${vehicle{"$team $name"}}</td></tr>
END
        }
        $html .= "</table>\n";

        save_html('index.html', $html);
        save_image($imall, 'Overview.png');
}

####################################################################################################

sub create_image {
        my $image = GD::Image->newTrueColor($width, $height);
        my ($lm, $g);
        foreach $lm (@landmarks) {
                my ($z, $type, $team, $x, $y) = split / /, $lm;
                icon($image, $icon{$type}, $x, $y);
        }
        foreach $g (@waypoints) {
                my ($team, $x, $y, $z, $desc) = split / /, $g, 5;
                text($image, $x, $y, $desc);
        }
        return $image;
}

sub save_image {
        my $image = shift;
        my $file = shift;
        my $png = $image->png;
        open PNG, ">$outdir/$file" or die "failed to open $outdir/$file: $!";
        binmode PNG;
        print PNG $png;
        close PNG;

        my $max = $width < $height ? $height : $width;
        my $thumb = GD::Image->newTrueColor($thumbsize * $width / $max,
                        $thumbsize * $height / $max);
        $thumb->copyResampled($image, 0, 0, 0, 0, $thumbsize * $width / $max,
                        $thumbsize * $height / $max, $width, $height);
        $png = $thumb->png;
        open PNG, ">$outdir/s$file" or die "failed to open $outdir/s$file: $!";
        binmode PNG;
        print PNG $png;
        close PNG;
}

sub square {
        my $image = shift;
        return unless defined $image;
        my $x = shift;
        my $y = shift;
        my $s = shift;
        my $colour = shift;
        $image->filledRectangle($x - $s, $y - $s, $x + $s, $y + $s, $colour);
}

sub line {
        my $image = shift;
        return unless defined $image;
        my $x0 = shift;
        my $y0 = shift;
        my $x1 = shift;
        my $y1 = shift;
        my $colour = shift;
        $image->line($x0, $y0, $x1, $y1, $colour);
}

sub load_image {
        my $file = shift;
        open PNG, $file or die "failed to open $file: $!";
        my $im = GD::Image->newFromPng(\*PNG) or die "PNG load of $file failed";
        close PNG;
        $im->transparent(0);
        return $im;
}

sub icon {
        my $image = shift;
        my $icon = shift;
        my $x = shift;
        my $y = shift;
        $image->setBrush($icon);
        $image->setPixel($x, $y, gdBrushed);
}

sub text {
        my $image = shift;
        my $x = shift;
        my $y = shift;
        my $text = shift;
        $image->string(gdSmallFont, $x, $y, $text, 0xffffff);
}

####################################################################################################

sub create_html {
        my $title = shift;
        my $html = <<END;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
        "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<link rel="stylesheet" type="text/css" href="t2matchlog.css">
<title>$title ($mission_name / $mission_type_name)</title>
</head>

<body>
<h1>$title <em class="mission">($mission_name / $mission_type_name)</em></h1>

END
        return $html;
}

sub save_html {
        my $file = shift;
        my $html = shift;
        $html .= "</body></html>\n";
        open HTML, ">$outdir/$file" or die "failed to open $outdir/$file: $!";
        print HTML $html;
        close HTML;
}

####################################################################################################

sub safe_name {
        my $s = shift;
        $s =~ tr/[a-zA-Z0-9]/_/cs;
        return $s;
}

sub nice_time {
        my $time = shift;
        my $secs = $time % 60;
        return int($time / 60) . ':' . (($secs < 10) ? "0$secs" : $secs);
}

sub distance {
        return sqrt (($_[0] - $_[3]) ** 2 + ($_[1] - $_[4]) ** 2 + ($_[2] - $_[5]) ** 2);
}

####################################################################################################
