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];
417 my @race = (qw(Z T P), (undef) x 3, '-');
420 my $time = shift() * .042;
421 my $minutes = int($time / 60);
422 return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
426 my ($template, $expr, @elements) = @_;
427 my @data = unpack $template, $expr;
429 $map{$_} = shift @data for @elements;
430 return (\%map, @data);
433 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
434 and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24CZ26a38a*", $_, qw(
435 engine frames mag1 time mag2 name width height
436 unknown1 creator unknown2 map unknown3
438 or die "Couldn't read replay header\n";
440 $_ eq "\0\0\110" or warn sprintf(
441 "Mismatch in first header constant: %s\n",
442 join ",", map ord, split //, $_
444 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
445 "Mismatch in second header constant: %s\n",
446 join ",", map ord, split //, $_
448 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
450 my @playdata = unpack "Va32"x12 . "V8C8", $headdata[0]
451 or die "Couldn't parse player data in replay header\n";
455 my $number = shift @playdata;
456 defined $player[$number] and warn "Player #$number redefined";
457 my ($data) = unpackhash("VcccZ25", shift @playdata, qw(
458 slot type race unknown name
460 defined $race[$_] ? ($data->{race} = $race[$_]) :
461 warn "Unknown race #$_ for player $number"
463 $slot[$data->{slot}] = $number if $data->{slot} < 16;
464 $player[$number] = $data;
466 $player[$_]->{color} = shift @playdata for 0 .. 7;
467 $player[$_]->{index} = shift @playdata for 0 .. 7;
471 my $playdata = $player[$slot[$id]];
472 return defined $playdata ?
473 sprintf '%s (%s)', $playdata->{name}, $playdata->{race} : "#$id";
476 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
478 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
479 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
480 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
485 print Dumper \@player;
486 #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
490 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
494 my ($time, $player, $desc, @data) = @$_;
495 printf("@%s #%d %s: %s\n",
496 showtime($time), $player, $desc, join(", ", @data)
501 my %cmdmacro = map {$_ => 1} (
502 (map {$_, "cancel $_"}
503 qw/train build hatch research upgrade arm/,
505 qw/hotkey vision part rally/,
509 my %stats; # player => count
511 $stats{$_->[1]}{actions}++;
512 $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
513 $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
514 $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
515 $stats{$_->[1]}{count}{$_->[2]}++;
518 for my $player (sort keys %stats) {
519 my $row = $stats{$player};
520 $row->{last} ||= $map->[-1][0];
521 # printf("%-16s%6d actions (%3d micro,%4d macro);%4d APM\n",
522 my $name = showplayer($player);
523 printf("%-16s%6d actions in%7d frames (%s) = %d APM\n",
524 $name, $row->{actions}, $row->{last},
525 showtime($row->{last}),
526 # $row->{micro} / $row->{last} * 60 / .042 * 1.05,
527 # $row->{macro} / $row->{last} * 60 / .042 * 1.05,
528 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
532 my @order; # pos => [ [ pct, cmd ] ]
534 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
535 for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
536 print "build order:\n";
540 my ($pos, $txt) = @$_;
541 print ' ' x ($pos*60 - $lastpos);
542 $txt = substr $txt, 0, 8;
544 $lastpos = $pos + length $txt;
550 printf("action distribution: %s\n",
552 sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
554 sort {$row->{count}{$b} <=> $row->{count}{$a}}
555 keys %{ $row->{count} }