11 "verbose|v!" => \$SHOWWARN,
12 "apm|a=s" => \$APMSVG,
15 use constant { APM_FIRSTFRAME => 80 / .042 };
19 package Data::StarCraft::Replay;
45 0x09 => "Science Vessel",
48 0x0C => "Battlecruiser",
70 0x32 => "Infested Terran",
75 0x3D => "Dark Templar",
81 0x43 => "High Templar",
94 0x6A => "Command Center",
96 0x6C => "Nuclear Silo",
97 0x6D => "Supply Depot",
98 0x6E => "Refinery", # refinery?
100 0x70 => "Academy", # Academy?
103 0x73 => "Control Tower",
104 0x74 => "Science Facility",
105 0x75 => "Covert Ops",
106 0x76 => "Physics Lab",
108 0x78 => "Machine Shop",
110 0x7A => "Engineering Bay",
112 0x7C => "Missile Turret",
115 0x82 => "Infested CC",
119 0x86 => "Nydus Canal",
120 0x87 => "Hydralisk Den",
121 0x88 => "Defiler Mound",
122 0x89 => "Greater Spire",
123 0x8A => "Queens Nest",
124 0x8B => "Evolution Chamber",
125 0x8C => "Ultralisk Cavern",
127 0x8E => "Spawning Pool",
128 0x8F => "Creep Colony",
129 0x90 => "Spore Colony",
131 0x92 => "Sunken Colony",
137 0x9B => "Robotics Facility",
139 0x9D => "Assimilator",
141 0x9F => "Observatory",
144 0xA2 => "Photon Cannon",
145 0xA3 => "Citadel of Adun",
146 0xA4 => "Cybernetics Core",
147 0xA5 => "Templar Archives",
151 0xA9 => "Fleet Beacon",
152 0xAA => "Arbiter Tribunal",
153 0xAB => "Robotics Support Bay",
154 0xAC => "Shield Battery",
158 0xC2 => "Dark Archon",
161 0xC5 => "Interceptor",
162 0xC6 => "Interceptor/Scarab",
165 "Terran Infantry Armor",
166 "Terran Vehicle Plating",
167 "Terran Ship Plating",
169 "Zerg Flyer Carapace",
170 "Protoss Ground Armor",
172 "Terran Infantry Weapons",
173 "Terran Vehicle Weapons",
174 "Terran Ship Weapons",
175 "Zerg Melee Attacks",
176 "Zerg Missile Attacks",
177 "Zerg Flyer Attacks",
178 "Protoss Ground Weapons",
179 "Protoss Air Weapons",
180 "Protoss Plasma Shields",
182 "U-238 Shells (Marine Range)",
183 "Ion Thrusters (Vulture Speed)",
185 "Titan Reactor (Science Vessel Energy)",
186 "Ocular Implants (Ghost Sight)",
187 "Moebius Reactor (Ghost Energy)",
188 "Apollo Reactor (Wraith Energy)",
189 "Colossus Reactor (Battle Cruiser Energy)",
190 "Ventral Sacs (Overlord Transport)",
191 "Antennae (Overlord Sight)",
192 "Pneumatized Carapace (Overlord Speed)",
193 "Metabolic Boost (Zergling Speed)",
194 "Adrenal Glands (Zergling Attack)",
195 "Muscular Augments (Hydralisk Speed)",
196 "Grooved Spines (Hydralisk Range)",
197 "Gamete Meiosis (Queen Energy)",
200 "Singularity Charge (Dragoon Range)",
201 "Leg Enhancement (Zealot Speed)",
204 "Gravitic Drive (Shuttle Speed)",
205 "Sensor Array (Observer Sight)",
206 "Gravitic Booster (Observer Speed)",
207 "Khaydarin Amulet (Templar Energy)",
208 "Apial Sensors (Scout Sight)",
209 "Gravitic Thrusters (Scout Speed)",
211 "Khaydarin Core (Arbiter Energy)",
214 "Argus Jewel (Corsair Energy)",
217 "Argus Talisman (Dark Archon Energy)",
218 "Caduceus Reactor (Medic Energy)",
219 "Chitinous Plating (Ultralisk Armor)",
220 "Anabolic Synthesis (Ultralisk Speed)",
221 "Charon Boosters (Goliath Range)",
233 "Cloaking Field (wraith)",
234 "Personal Cloaking (ghost)",
262 0x02 => "Unallowed Move?",
263 0x06 => "Force move",
266 0x0E => "Attack Move",
267 0x13 => "Failed Casting (?)",
271 0x27 => "Clear Rally",
278 0x77 => "Dark Swarm",
280 0x79 => "Spawn Broodling",
282 0x7E => "Launch Nuke",
284 0x8B => "ComSat Scan",
285 0x8D => "Defense Matrix",
286 0x8E => "Psionic Storm",
292 0x94 => "Hallucination",
296 0xB5 => "Disruption Web",
297 0xB6 => "Mind Control",
299 0xB9 => "Optic Flare",
305 0x09 => ["select", 1, 2 | CMD_REPEAT],
306 0x0A => ["add", 1, 2 | CMD_REPEAT],
307 0x0B => ["deselect", 1, 2 | CMD_REPEAT],
308 0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
309 0x0D => ["vision", 2],
310 0x0E => ["ally", 2, 2],
311 0x13 => ["hotkey", 1, [qw"assign select"], 1],
312 0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
313 0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
315 0x19 => ["cancel hatch"],
317 # 0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
318 0x1E => ["return cargo", 1],
319 0x1F => ["train", 2, \%unit],
320 0x20 => ["cancel train", 2], # == 254
321 0x21 => ["cloak", 1],
322 0x22 => ["decloak", 1],
323 0x23 => ["hatch", 2, \%unit],
324 0x25 => ["unsiege", 1],
325 0x26 => ["siege", 1],
326 0x27 => ["arm", 0], # scarab/interceptor
327 0x28 => ["unload all", 1],
328 0x29 => ["unload", 2],
329 0x2A => ["merge archon", 0],
330 0x2B => ["hold position", 1],
331 0x2C => ["burrow", 1],
332 0x2D => ["unburrow", 1],
333 0x2E => ["cancel nuke", 0],
334 0x2F => ["lift", 2, 2],
335 0x30 => ["research", 1, \@research],
336 0x31 => ["cancel research", 0],
337 0x32 => ["upgrade", 1, \@upgrade],
338 # 0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
339 0x35 => ["morph", 2, \%unit],
341 0x57 => ["part", 1, {qw"1 quit 6 drop"}],
342 0x5A => ["merge dark archon", 0],
352 my ($fh, $size, $seek) = @_;
353 seek *$fh, $seek, 0 if $seek;
354 read(*$fh, my $in, $size) eq $size or return undef;
362 while (not eof $file) {
363 local $_ = $self->_read($file, 5)
364 and my ($time, $size) = unpack "VC", $_
365 or die "Couldn't read time block head\n";
366 local $_ = $self->_read($file, $size)
367 and my @block = unpack "C*", $_
368 or die "Couldn't read time block data\n";
370 my $player = shift @block;
371 my $cmd = shift @block;
372 if (not defined $cmdread{$cmd}) {
373 warn sprintf "command #%X not defined: %d bytes ignored\n",
375 push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
380 my ($data, $byte) = @_;
381 my $out = shift @$data;
382 if (($byte & 3) == 2) {
383 @$data ? ($out += shift(@$data) << 8)
384 : warn "high byte not present\n";
389 my @format = @{ $cmdread{$cmd} };
390 my $desc = shift @format;
392 for my $bit (@format) {
394 if (ref $bit eq "ARRAY") {
395 $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
398 $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
404 if ($bit & CMD_REPEAT) {
405 push @data, readbyte(\@block, $bit) for 1 .. shift @data;
407 push @data, readbyte(\@block, $bit);
410 $desc eq "move" and $data[2] == 0 and $desc = "rally";
411 push @$self, [$time, $player, $desc, @data];
419 my @race = (qw(Z T P), (undef) x 3, '-');
422 my $time = shift() * .042;
423 my $minutes = int($time / 60);
424 return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
428 my ($template, $expr, @elements) = @_;
429 my @data = unpack $template, $expr;
431 $map{$_} = shift @data for @elements;
432 return (\%map, @data);
435 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
436 and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24CZ26a38a*", $_, qw(
437 engine frames mag1 time mag2 name width height
438 unknown1 creator unknown2 map unknown3
440 or die "Couldn't read replay header\n";
442 $_ eq "\0\0\110" or warn sprintf(
443 "Mismatch in first header constant: %s\n",
444 join ",", map ord, split //, $_
446 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
447 "Mismatch in second header constant: %s\n",
448 join ",", map ord, split //, $_
450 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
452 my @playdata = unpack "Va32"x12 . "V8C8", $headdata[0]
453 or die "Couldn't parse player data in replay header\n";
457 my $number = shift @playdata;
458 defined $player[$number] and warn "Player #$number redefined";
459 my ($data) = unpackhash("VcccZ25", shift @playdata, qw(
460 slot type race team name
462 defined $race[$_] ? ($data->{race} = $race[$_]) :
463 warn "Unknown race #$_ for player $number"
465 $slot[$data->{slot}] = $number if $data->{slot} < 16;
466 $player[$number] = $data;
468 $player[$_]->{color} = shift @playdata for 0 .. 7;
469 $player[$_]->{index} = shift @playdata for 0 .. 7;
473 my $playdata = $player[$slot[$id]];
474 return defined $playdata ?
475 sprintf '%s (%s)', $playdata->{name}, $playdata->{race} : "#$id";
478 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
480 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
481 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
482 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
487 print Dumper \@player;
488 #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
492 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
496 my ($time, $player, $desc, @data) = @$_;
497 printf("@%s #%d %s: %s\n",
498 showtime($time), $player, $desc, join(", ", @data)
503 my %cmdmacro = map {$_ => 1} (
504 (map {$_, "cancel $_"}
505 qw/train build hatch research upgrade arm/,
507 qw/hotkey vision part rally/,
511 my %stats; # player => count
513 $stats{$_->[1]}{actions}++;
514 $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
515 $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
516 $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
517 $stats{$_->[1]}{count}{$_->[2]}++;
520 for my $player (sort keys %stats) {
521 my $row = $stats{$player};
522 $row->{last} ||= $map->[-1][0];
523 # printf("%-16s%6d actions (%3d micro,%4d macro);%4d APM\n",
524 my $name = showplayer($player);
525 printf("%-16s%6d actions in%7d frames (%s) = %d APM\n",
526 $name, $row->{actions}, $row->{last},
527 showtime($row->{last}),
528 # $row->{micro} / $row->{last} * 60 / .042 * 1.05,
529 # $row->{macro} / $row->{last} * 60 / .042 * 1.05,
530 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
534 my @order; # pos => [ [ pct, cmd ] ]
536 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
537 for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
538 print "build order:\n";
542 my ($pos, $txt) = @$_;
543 print ' ' x ($pos*60 - $lastpos);
544 $txt = substr $txt, 0, 8;
546 $lastpos = $pos + length $txt;
552 printf("action distribution: %s\n",
554 sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
556 sort {$row->{count}{$b} <=> $row->{count}{$a}}
557 keys %{ $row->{count} }
563 my @seq; # player => time (s) => actions
564 $seq[$_->[1]][$_->[0] * .042]++ for @$map;
567 for my $player (0 .. $#seq) {
569 $range += $seq[$player][$_] || 0 for 0 .. $flatten - 1;
570 my $leadfill = $range / $flatten;
571 for my $frame (0 .. $#{$seq[$player]}) {
572 $range += $seq[$player][$frame] || 0;
573 $range -= $frame < $flatten ? $leadfill :
574 $seq[$player][$frame - $flatten] || 0;
575 $apm[$player][$frame] = $range / $flatten;
579 BEGIN { unshift @INC, '.' }
580 use SVG::TT::Graph::TimeSeries;
581 my $graph = SVG::TT::Graph::TimeSeries->new({
584 style_sheet => "apm.css",
585 show_data_values => 0,
586 show_data_points => 0,
587 x_label_format => '%k:%M',
589 timescale_divisions => "5 minutes",
593 for my $player (0 .. $#apm) {
596 time2str('%Y-%m-%d %X', 946681200 + $_),
597 $apm[$player][$_] * 60
598 } 0 .. $#{$apm[$player]} ],
599 title => showplayer($player),
603 my ($name) = $APMSVG =~ /([^.]+)/;
604 my $title = "APM timeline" . ($name && " for $name");
605 my $lead = sprintf "\n<title>%s</title>", $title;
607 my $svg = $graph->burn();
608 s/^[ \t\r]+\n//gm, # remove lines with only whitespace (many useless ^M)
609 s/[ \t\r]+$//gm, # trailing whitespace
610 s/ {4}\r*/\t/g, # tabs for indenting
611 s/^(<svg width=")1600(" height=")1200("[^>]*>)/${1}100%${2}100%$3$lead/m,
612 for $svg; # cleanup xml
614 open my $apmfile, '>', "$APMSVG.svg";