6 use Data::StarCraft::Replay;
14 "verbose|v!" => \$SHOWWARN,
15 "apm|a=s" => \$APMSVG,
19 use constant { APM_FIRSTFRAME => 80 / .042 };
21 my @race = (qw(Z T P), (undef) x 3, '-');
24 my $time = shift() * .042;
25 my $minutes = int($time / 60);
26 return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
30 my ($template, $expr, @elements) = @_;
31 my @data = unpack $template, $expr;
33 $map{$_} = shift @data for @elements;
34 return (\%map, @data);
37 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
38 and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24CZ26a38a*", $_, qw(
39 engine frames mag1 time mag2 name width height
40 unknown1 creator unknown2 map unknown3
42 or die "Couldn't read replay header\n";
44 $_ eq "\0\0\110" or warn sprintf(
45 "Mismatch in first header constant: %s\n",
46 join ",", map ord, split //, $_
48 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
49 "Mismatch in second header constant: %s\n",
50 join ",", map ord, split //, $_
52 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
54 my @playdata = unpack "Va32"x12 . "V8C8", $headdata[0]
55 or die "Couldn't parse player data in replay header\n";
59 my $number = shift @playdata;
60 defined $player[$number] and warn "Player #$number redefined";
61 my ($data) = unpackhash("VcccZ25", shift @playdata, qw(
62 slot type race unknown name
64 defined $race[$_] ? ($data->{race} = $race[$_]) :
65 warn "Unknown race #$_ for player $number"
67 $slot[$data->{slot}] = $number if $data->{slot} < 16;
68 $player[$number] = $data;
70 $player[$_]->{color} = shift @playdata for 0 .. 7;
71 $player[$_]->{index} = shift @playdata for 0 .. 7;
75 my $playdata = $player[$slot[$id]];
76 return defined $playdata ?
77 sprintf '%s (%s)', $playdata->{name}, $playdata->{race} : "#$id";
80 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
82 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
83 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
84 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
89 print Dumper \@player;
90 #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
94 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
98 my ($time, $player, $desc, @data) = @$_;
99 printf("@%s #%d %s: %s\n",
100 showtime($time), $player, $desc, join(", ", @data)
105 my %cmdmacro = map {$_ => 1} (
106 (map {$_, "cancel $_"}
107 qw/train build hatch research upgrade arm/,
109 qw/hotkey vision part rally/,
113 my %stats; # player => count
115 $stats{$_->[1]}{actions}++;
116 $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
117 $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
118 $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
119 $stats{$_->[1]}{count}{$_->[2]}++;
122 for my $player (sort keys %stats) {
123 my $row = $stats{$player};
124 $row->{last} ||= $map->[-1][0];
125 # printf("%-16s%6d actions (%3d micro,%4d macro);%4d APM\n",
126 my $name = showplayer($player);
127 printf("%-16s%6d actions in%7d frames (%s) = %d APM\n",
128 $name, $row->{actions}, $row->{last},
129 showtime($row->{last}),
130 # $row->{micro} / $row->{last} * 60 / .042 * 1.05,
131 # $row->{macro} / $row->{last} * 60 / .042 * 1.05,
132 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
136 my @order; # pos => [ [ pct, cmd ] ]
138 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
139 for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
140 print "build order:\n";
144 my ($pos, $txt) = @$_;
145 print ' ' x ($pos*60 - $lastpos);
146 $txt = substr $txt, 0, 8;
148 $lastpos = $pos + length $txt;
154 printf("action distribution: %s\n",
156 sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
158 sort {$row->{count}{$b} <=> $row->{count}{$a}}
159 keys %{ $row->{count} }
165 open my $imgfile, '>', "test.gif" or die;
170 my $ani = GD::Image->new($head->{width}, $head->{height});
171 my $bg = $ani->colorAllocate(0, 0, 0);
173 $ani->colorAllocate(255, 0, 0),
174 $ani->colorAllocate(255, 255, 0),
175 $ani->colorAllocate(0, 255, 0),
176 $ani->colorAllocate(0, 255, 255),
177 $ani->colorAllocate(0, 0, 255),
178 $ani->colorAllocate(255, 0, 255),
181 print $ani->gifanimbegin;
182 # print $ani->gifanimadd;
184 my $frame = GD::Image->new($ani->getBounds);
185 print $frame->gifanimadd;
186 my $length = 30 / .042;
189 my ($time, $player, $cmd, @data) = @$_;
190 #$time < $length * 10 or last;
191 while ($time > $last + $length) {
193 print $frame->gifanimadd(0, 0, 0, 32);
194 # $frame = GD::Image->new($ani->getBounds);
196 if ($cmd eq "build") {
197 $frame->setPixel($data[1]>>5, $data[2]>>5, $plot[$player]);
199 elsif ($cmd eq "move" or $cmd eq "attack") {
200 $frame->setPixel($data[0]>>5, $data[1]>>5, $plot[$player]);
201 # if $data[2] == 0xFFFF_FFFF;
204 # add_frame_data($frame);
205 print $frame->gifanimadd;
207 print $ani->gifanimend;
212 my @seq; # player => time (s) => actions
213 $seq[$_->[1]][$_->[0] * .042]++ for @$map;
216 for my $player (0 .. $#seq) {
218 $range += $seq[$player][$_] || 0 for 0 .. $flatten - 1;
219 my $leadfill = $range / $flatten;
220 for my $frame (0 .. $#{$seq[$player]}) {
221 $range += $seq[$player][$frame] || 0;
222 $range -= $frame < $flatten ? $leadfill :
223 $seq[$player][$frame - $flatten] || 0;
224 $apm[$player][$frame] = $range / $flatten;
228 BEGIN { unshift @INC, '.' }
229 use SVG::TT::Graph::TimeSeries;
230 my $graph = SVG::TT::Graph::TimeSeries->new({
233 style_sheet => "apm.css",
234 show_data_values => 0,
235 show_data_points => 0,
236 x_label_format => '%k:%M',
238 timescale_divisions => "5 minutes",
242 for my $player (0 .. $#apm) {
245 time2str('%Y-%m-%d %X', 946681200 + $_),
246 $apm[$player][$_] * 60
247 } 0 .. $#{$apm[$player]} ],
248 title => showplayer($player),
252 my ($name) = $APMSVG =~ /([^.]+)/;
253 my $title = "APM timeline" . ($name && " for $name");
254 my $lead = sprintf "\n<title>%s</title>", $title;
256 my $svg = $graph->burn();
257 s/^[ \t\r]+\n//gm, # remove lines with only whitespace (many useless ^M)
258 s/[ \t\r]+$//gm, # trailing whitespace
259 s/ {4}\r*/\t/g, # tabs for indenting
260 s/^(<svg width=")1600(" height=")1200("[^>]*>)/${1}100%${2}100%$3$lead/m,
261 for $svg; # cleanup xml
263 open my $apmfile, '>', "$APMSVG.svg";