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 # 0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
316 0x1E => ["return cargo", 1],
317 0x1F => ["train", 2, \%unit],
318 0x20 => ["cancel train", 2], # == 254
319 0x21 => ["cloak", 1],
320 0x22 => ["decloak", 1],
321 0x23 => ["hatch", 2, \%unit],
322 0x25 => ["unsiege", 1],
323 0x26 => ["siege", 1],
324 0x27 => ["arm", 0], # scarab/interceptor
325 0x28 => ["unload all", 1],
326 0x29 => ["unload", 2],
327 0x2A => ["merge archon", 0],
328 0x2B => ["hold position", 1],
329 0x2C => ["burrow", 1],
330 0x2D => ["unburrow", 1],
331 0x2E => ["cancel nuke", 0],
332 0x2F => ["lift", 2, 2],
333 0x30 => ["research", 1, \@research],
334 0x31 => ["cancel research", 0],
335 0x32 => ["upgrade", 1, \@upgrade],
336 # 0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
337 0x35 => ["morph", 2, \%unit],
339 0x57 => ["part", 1, {qw"1 quit 6 drop"}],
340 0x5A => ["merge dark archon", 0],
350 my ($fh, $size, $seek) = @_;
351 seek *$fh, $seek, 0 if $seek;
352 read(*$fh, my $in, $size) eq $size or return undef;
360 while (not eof $file) {
361 local $_ = $self->_read($file, 5)
362 and my ($time, $size) = unpack "VC", $_
363 or die "Couldn't read time block head\n";
364 local $_ = $self->_read($file, $size)
365 and my @block = unpack "C*", $_
366 or die "Couldn't read time block data\n";
368 my $player = shift @block;
369 my $cmd = shift @block;
370 if (not defined $cmdread{$cmd}) {
371 warn sprintf "command #%X not defined: %d bytes ignored\n",
373 push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
378 my ($data, $byte) = @_;
379 my $out = shift @$data;
380 if (($byte & 3) == 2) {
381 @$data ? ($out += shift(@$data) << 8)
382 : warn "high byte not present\n";
387 my @format = @{ $cmdread{$cmd} };
388 my $desc = shift @format;
390 for my $bit (@format) {
392 if (ref $bit eq "ARRAY") {
393 $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
396 $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
402 if ($bit & CMD_REPEAT) {
403 push @data, readbyte(\@block, $bit) for 1 .. shift @data;
405 push @data, readbyte(\@block, $bit);
408 $desc eq "move" and $data[2] == 0 and $desc = "rally";
409 push @$self, [$time, $player, $desc, @data];
418 my $time = shift() * .042;
419 my $minutes = int($time / 60);
420 return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
424 my ($template, $expr, @elements) = @_;
425 my @data = unpack $template, $expr;
427 $map{$_} = shift @data for @elements;
428 return (\%map, @data);
431 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
432 and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24Ca26a38a*", $_, qw(
433 engine frames mag1 time mag2 name width height
434 unknown1 creator unknown2 map unknown3
436 or die "Couldn't read replay header\n";
438 $_ eq "\0\0\110" or warn sprintf(
439 "Mismatch in first header constant: %s\n",
440 join ",", map ord, split //, $_
442 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
443 "Mismatch in second header constant: %s\n",
444 join ",", map ord, split //, $_
446 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
448 my @playdata = unpack "a36"x12 . "V8C8", $headdata[0]
449 or die "Couldn't parse player data in replay header\n";
452 push @player, unpackhash("x11Z25", shift @playdata, qw/name/) for 0 .. 11;
453 $player[$_]->{color} = shift @playdata for 0 .. 7;
454 $player[$_]->{index} = shift @playdata for 0 .. 7;
456 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
458 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
459 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
460 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
465 print Dumper \@player;
466 #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
470 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
474 my ($time, $player, $desc, @data) = @$_;
475 printf("@%s #%d %s: %s\n",
476 showtime($time), $player, $desc, join(", ", @data)
481 my %cmdmacro = map {$_ => 1} (
482 (map {$_, "cancel $_"}
483 qw/train build hatch research upgrade arm/,
485 qw/hotkey vision part rally/,
489 my %stats; # player => count
491 $stats{$_->[1]}{actions}++;
492 $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
493 $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
494 $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
495 $stats{$_->[1]}{count}{$_->[2]}++;
498 for my $player (sort keys %stats) {
499 my $row = $stats{$player};
500 $row->{last} ||= $map->[-1][0];
501 # printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
502 printf("%d:%6d actions in%7d frames (%s) = %d APM\n",
503 $player, $row->{actions}, $row->{last},
504 showtime($row->{last}),
505 # $row->{micro} / $row->{last} * 60 / .042 * 1.05,
506 # $row->{macro} / $row->{last} * 60 / .042 * 1.05,
507 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
511 my @order; # pos => [ [ pct, cmd ] ]
513 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
514 for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
515 print "build order:\n";
519 my ($pos, $txt) = @$_;
520 print ' ' x ($pos*60 - $lastpos);
521 $txt = substr $txt, 0, 8;
523 $lastpos = $pos + length $txt;
529 printf("action distribution: %s\n",
531 sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
533 sort {$row->{count}{$b} <=> $row->{count}{$a}}
534 keys %{ $row->{count} }