recognize team in replay's player data

[perl/schtarr.git] / screp

diff --git a/screp b/screp
index 0b35ac0d00c709010a07dc7017f1de7a7103df8a..dbd264c22916e8e239f22cf86b6fe462bfc053cf 100755 (executable)
--- a/screp
+++ b/screp
@@ -4,10 +4,12 @@ use warnings;
 use Data::Dumper;
 
 my $SHOWWARN = 0;
+my $APMSVG = undef;
 
 use Getopt::Long;
 GetOptions(
        "verbose|v!" => \$SHOWWARN,
+       "apm|a=s" => \$APMSVG,
 );
 
 use constant { APM_FIRSTFRAME => 80 / .042 };
@@ -312,6 +314,7 @@ my %cmdread = (
        0x18 => ["cancel"],
        0x19 => ["cancel hatch"],
        0x1A => ["stop", 1],
+#      0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
        0x1E => ["return cargo", 1],
        0x1F => ["train", 2, \%unit],
        0x20 => ["cancel train", 2], # == 254
@@ -413,6 +416,8 @@ sub open {
 
 }
 
+my @race = (qw(Z T P), (undef) x 3, '-');
+
 sub showtime {
        my $time = shift() * .042;
        my $minutes = int($time / 60);
@@ -428,7 +433,7 @@ sub unpackhash {
 }
 
 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
-       and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24Ca26a38a*", $_, qw(
+       and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24CZ26a38a*", $_, qw(
                engine frames mag1 time mag2 name width height
                unknown1 creator unknown2 map unknown3
        ))
@@ -444,14 +449,32 @@ $_ eq "\10"x8 . "\0"x4 or warn sprintf(
 ) for $head->{mag2};
 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
 
-my @playdata = unpack "a36"x12 . "V8C8", $headdata[0]
+my @playdata = unpack "Va32"x12 . "V8C8", $headdata[0]
        or die "Couldn't parse player data in replay header\n";
 
-my @player;
-push @player, unpackhash("x11Z25", shift @playdata, qw/name/) for 0 .. 11;
+my (@player, @slot);
+for (0 .. 11) {
+       my $number = shift @playdata;
+       defined $player[$number] and warn "Player #$number redefined";
+       my ($data) = unpackhash("VcccZ25", shift @playdata, qw(
+               slot type race team name
+       ));
+       defined $race[$_] ? ($data->{race} = $race[$_]) :
+               warn "Unknown race #$_ for player $number"
+               for $data->{race};
+       $slot[$data->{slot}] = $number if $data->{slot} < 16;
+       $player[$number] = $data;
+}
 $player[$_]->{color} = shift @playdata for 0 .. 7;
 $player[$_]->{index} = shift @playdata for 0 .. 7;
 
+sub showplayer {
+       my $id = shift;
+       my $playdata = $player[$slot[$id]];
+       return defined $playdata ?
+               sprintf '%s (%s)', $playdata->{name}, $playdata->{race} : "#$id";
+}
+
 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
 use Date::Format;
 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
@@ -497,9 +520,10 @@ for (@$map) {
 for my $player (sort keys %stats) {
        my $row = $stats{$player};
        $row->{last} ||= $map->[-1][0];
-#      printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
-       printf("%d:%6d actions in%7d frames (%s) = %d APM\n",
-               $player, $row->{actions}, $row->{last},
+#      printf("%-16s%6d actions (%3d micro,%4d macro);%4d APM\n",
+       my $name = showplayer($player);
+       printf("%-16s%6d actions in%7d frames (%s) = %d APM\n",
+               $name, $row->{actions}, $row->{last},
                showtime($row->{last}),
 #              $row->{micro} / $row->{last} * 60 / .042 * 1.05,
 #              $row->{macro} / $row->{last} * 60 / .042 * 1.05,
@@ -535,3 +559,59 @@ for my $player (sort keys %stats) {
        ) if 0;
 }
 
+if ($APMSVG) {
+       my @seq;  # player => time (s) => actions
+       $seq[$_->[1]][$_->[0] * .042]++ for @$map;
+       my $flatten = 120;
+       my @apm;
+       for my $player (0 .. $#seq) {
+               my $range = 0;
+                  $range += $seq[$player][$_] || 0 for 0 .. $flatten - 1;
+               my $leadfill = $range / $flatten;
+               for my $frame (0 .. $#{$seq[$player]}) {
+                       $range += $seq[$player][$frame] || 0;
+                       $range -= $frame < $flatten ? $leadfill :
+                               $seq[$player][$frame - $flatten] || 0;
+                       $apm[$player][$frame] = $range / $flatten;
+               }
+       }
+
+       BEGIN { unshift @INC, '.' }
+       use SVG::TT::Graph::TimeSeries;
+       my $graph = SVG::TT::Graph::TimeSeries->new({
+               height => 1200,
+               width => 1600,
+               style_sheet => "apm.css",
+               show_data_values => 0,
+               show_data_points => 0,
+               x_label_format => '%k:%M',
+               key => 1,
+               timescale_divisions => "5 minutes",
+       #       compress => 1,
+       });
+
+       for my $player (0 .. $#apm) {
+               $graph->add_data({
+                       data => [map {
+                               time2str('%Y-%m-%d %X', 946681200 + $_),
+                               $apm[$player][$_] * 60
+                       } 0 .. $#{$apm[$player]} ],
+                       title => showplayer($player),
+               });
+       }
+
+       my ($name) = $APMSVG =~ /([^.]+)/;
+       my $title = "APM timeline" . ($name && " for $name");
+       my $lead = sprintf "\n<title>%s</title>", $title;
+
+       my $svg = $graph->burn();
+       s/^[ \t\r]+\n//gm,  # remove lines with only whitespace (many useless ^M)
+       s/[ \t\r]+$//gm,    # trailing whitespace
+       s/ {4}\r*/\t/g,     # tabs for indenting
+       s/^(<svg width=")1600(" height=")1200("[^>]*>)/${1}100%${2}100%$3$lead/m,
+               for $svg; # cleanup xml
+
+       open my $apmfile, '>', "$APMSVG.svg";
+       print $apmfile $svg;
+}
+