10 "verbose|v!" => \$SHOWWARN,
13 use constant { APM_FIRSTFRAME => 80 / .042 };
17 package Data::StarCraft::Replay;
43 0x09 => "Science Vessel",
46 0x0C => "Battlecruiser",
68 0x32 => "Infested Terran",
73 0x3D => "Dark Templar",
79 0x43 => "High Templar",
92 0x6A => "Command Center",
94 0x6C => "Nuclear Silo",
95 0x6D => "Supply Depot",
96 0x6E => "Refinery", # refinery?
98 0x70 => "Academy", # Academy?
101 0x73 => "Control Tower",
102 0x74 => "Science Facility",
103 0x75 => "Covert Ops",
104 0x76 => "Physics Lab",
106 0x78 => "Machine Shop",
108 0x7A => "Engineering Bay",
110 0x7C => "Missile Turret",
113 0x82 => "Infested CC",
117 0x86 => "Nydus Canal",
118 0x87 => "Hydralisk Den",
119 0x88 => "Defiler Mound",
120 0x89 => "Greater Spire",
121 0x8A => "Queens Nest",
122 0x8B => "Evolution Chamber",
123 0x8C => "Ultralisk Cavern",
125 0x8E => "Spawning Pool",
126 0x8F => "Creep Colony",
127 0x90 => "Spore Colony",
129 0x92 => "Sunken Colony",
135 0x9B => "Robotics Facility",
137 0x9D => "Assimilator",
139 0x9F => "Observatory",
142 0xA2 => "Photon Cannon",
143 0xA3 => "Citadel of Adun",
144 0xA4 => "Cybernetics Core",
145 0xA5 => "Templar Archives",
149 0xA9 => "Fleet Beacon",
150 0xAA => "Arbiter Tribunal",
151 0xAB => "Robotics Support Bay",
152 0xAC => "Shield Battery",
156 0xC2 => "Dark Archon",
159 0xC5 => "Interceptor",
160 0xC6 => "Interceptor/Scarab",
163 "Terran Infantry Armor",
164 "Terran Vehicle Plating",
165 "Terran Ship Plating",
167 "Zerg Flyer Carapace",
168 "Protoss Ground Armor",
170 "Terran Infantry Weapons",
171 "Terran Vehicle Weapons",
172 "Terran Ship Weapons",
173 "Zerg Melee Attacks",
174 "Zerg Missile Attacks",
175 "Zerg Flyer Attacks",
176 "Protoss Ground Weapons",
177 "Protoss Air Weapons",
178 "Protoss Plasma Shields",
180 "U-238 Shells (Marine Range)",
181 "Ion Thrusters (Vulture Speed)",
183 "Titan Reactor (Science Vessel Energy)",
184 "Ocular Implants (Ghost Sight)",
185 "Moebius Reactor (Ghost Energy)",
186 "Apollo Reactor (Wraith Energy)",
187 "Colossus Reactor (Battle Cruiser Energy)",
188 "Ventral Sacs (Overlord Transport)",
189 "Antennae (Overlord Sight)",
190 "Pneumatized Carapace (Overlord Speed)",
191 "Metabolic Boost (Zergling Speed)",
192 "Adrenal Glands (Zergling Attack)",
193 "Muscular Augments (Hydralisk Speed)",
194 "Grooved Spines (Hydralisk Range)",
195 "Gamete Meiosis (Queen Energy)",
198 "Singularity Charge (Dragoon Range)",
199 "Leg Enhancement (Zealot Speed)",
202 "Gravitic Drive (Shuttle Speed)",
203 "Sensor Array (Observer Sight)",
204 "Gravitic Booster (Observer Speed)",
205 "Khaydarin Amulet (Templar Energy)",
206 "Apial Sensors (Scout Sight)",
207 "Gravitic Thrusters (Scout Speed)",
209 "Khaydarin Core (Arbiter Energy)",
212 "Argus Jewel (Corsair Energy)",
215 "Argus Talisman (Dark Archon Energy)",
216 "Caduceus Reactor (Medic Energy)",
217 "Chitinous Plating (Ultralisk Armor)",
218 "Anabolic Synthesis (Ultralisk Speed)",
219 "Charon Boosters (Goliath Range)",
231 "Cloaking Field (wraith)",
232 "Personal Cloaking (ghost)",
260 0x02 => "Unallowed Move?",
261 0x06 => "Force move",
264 0x0E => "Attack Move",
265 0x13 => "Failed Casting (?)",
269 0x27 => "Clear Rally",
276 0x77 => "Dark Swarm",
278 0x79 => "Spawn Broodling",
280 0x7E => "Launch Nuke",
282 0x8B => "ComSat Scan",
283 0x8D => "Defense Matrix",
284 0x8E => "Psionic Storm",
290 0x94 => "Hallucination",
294 0xB5 => "Disruption Web",
295 0xB6 => "Mind Control",
297 0xB9 => "Optic Flare",
303 0x09 => ["select", 1, 2 | CMD_REPEAT],
304 0x0A => ["add", 1, 2 | CMD_REPEAT],
305 0x0B => ["deselect", 1, 2 | CMD_REPEAT],
306 0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
307 0x0D => ["vision", 2],
308 0x0E => ["ally", 2, 2],
309 0x13 => ["hotkey", 1, [qw"assign select"], 1],
310 0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
311 0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
313 0x19 => ["cancel hatch"],
315 0x1E => ["return cargo", 1],
316 0x1F => ["train", 2, \%unit],
317 0x20 => ["cancel train", 2], # == 254
318 0x21 => ["cloak", 1],
319 0x22 => ["decloak", 1],
320 0x23 => ["hatch", 2, \%unit],
321 0x25 => ["unsiege", 1],
322 0x26 => ["siege", 1],
323 0x27 => ["arm", 0], # scarab/interceptor
324 0x28 => ["unload all", 1],
325 0x29 => ["unload", 2],
326 0x2A => ["merge archon", 0],
327 0x2B => ["hold position", 1],
328 0x2C => ["burrow", 1],
329 0x2D => ["unburrow", 1],
330 0x2E => ["cancel nuke", 0],
331 0x2F => ["lift", 2, 2],
332 0x30 => ["research", 1, \@research],
333 0x31 => ["cancel research", 0],
334 0x32 => ["upgrade", 1, \@upgrade],
335 # 0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
336 0x35 => ["morph", 2, \%unit],
338 0x57 => ["part", 1, {qw"1 quit 6 drop"}],
339 0x5A => ["merge dark archon", 0],
349 my ($fh, $size, $seek) = @_;
350 seek *$fh, $seek, 0 if $seek;
351 read(*$fh, my $in, $size) eq $size or return undef;
359 while (not eof $file) {
360 local $_ = $self->_read($file, 5)
361 and my ($time, $size) = unpack "VC", $_
362 or die "Couldn't read time block head\n";
363 local $_ = $self->_read($file, $size)
364 and my @block = unpack "C*", $_
365 or die "Couldn't read time block data\n";
367 my $player = shift @block;
368 my $cmd = shift @block;
369 if (not defined $cmdread{$cmd}) {
370 warn sprintf "command #%X not defined: %d bytes ignored\n",
372 push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
377 my ($data, $byte) = @_;
378 my $out = shift @$data;
379 if (($byte & 3) == 2) {
380 @$data ? ($out += shift(@$data) << 8)
381 : warn "high byte not present\n";
386 my @format = @{ $cmdread{$cmd} };
387 my $desc = shift @format;
389 for my $bit (@format) {
391 if (ref $bit eq "ARRAY") {
392 $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
395 $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
401 if ($bit & CMD_REPEAT) {
402 push @data, readbyte(\@block, $bit) for 1 .. shift @data;
404 push @data, readbyte(\@block, $bit);
407 $desc eq "move" and $data[2] == 0 and $desc = "rally";
408 push @$self, [$time, $player, $desc, @data];
417 my $time = shift() * .042;
418 my $minutes = int($time / 60);
419 return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
423 my ($template, $expr, @elements) = @_;
424 my @data = unpack $template, $expr;
426 $map{$_} = shift @data for @elements;
427 return (\%map, @data);
430 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
431 and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24Ca26a38a*", $_, qw(
432 engine frames mag1 time mag2 name width height
433 unknown1 creator unknown2 map unknown3
435 or die "Couldn't read replay header\n";
437 $_ eq "\0\0\110" or warn sprintf(
438 "Mismatch in first header constant: %s\n",
439 join ",", map ord, split //, $_
441 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
442 "Mismatch in second header constant: %s\n",
443 join ",", map ord, split //, $_
445 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
447 my @playdata = unpack "a36"x12 . "V8C8", $headdata[0]
448 or die "Couldn't parse player data in replay header\n";
451 push @player, unpackhash("x11Z25", shift @playdata, qw/name/) for 0 .. 11;
452 $player[$_]->{color} = shift @playdata for 0 .. 7;
453 $player[$_]->{index} = shift @playdata for 0 .. 7;
455 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
457 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
458 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
459 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
464 print Dumper \@player;
465 #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
469 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
473 my ($time, $player, $desc, @data) = @$_;
474 printf("@%s #%d %s: %s\n",
475 showtime($time), $player, $desc, join(", ", @data)
480 my %cmdmacro = map {$_ => 1} (
481 (map {$_, "cancel $_"}
482 qw/train build hatch research upgrade arm/,
484 qw/hotkey vision part rally/,
488 my %stats; # player => count
490 $stats{$_->[1]}{actions}++;
491 $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
492 $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
493 $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
494 $stats{$_->[1]}{count}{$_->[2]}++;
497 for my $player (sort keys %stats) {
498 my $row = $stats{$player};
499 $row->{last} ||= $map->[-1][0];
500 # printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
501 printf("%d:%6d actions in%7d frames (%s) = %d APM\n",
502 $player, $row->{actions}, $row->{last},
503 showtime($row->{last}),
504 # $row->{micro} / $row->{last} * 60 / .042 * 1.05,
505 # $row->{macro} / $row->{last} * 60 / .042 * 1.05,
506 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
510 my @order; # pos => [ [ pct, cmd ] ]
512 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
513 for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
514 print "build order:\n";
518 my ($pos, $txt) = @$_;
519 print ' ' x ($pos*60 - $lastpos);
520 $txt = substr $txt, 0, 8;
522 $lastpos = $pos + length $txt;
528 printf("action distribution: %s\n",
530 sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
532 sort {$row->{count}{$b} <=> $row->{count}{$a}}
533 keys %{ $row->{count} }