10 "verbose|v!" => \$SHOWWARN,
15 package Data::StarCraft::Replay;
41 0x09 => "Science Vessel",
44 0x0C => "Battlecruiser",
66 0x32 => "Infested Terran",
71 0x3D => "Dark Templar",
77 0x43 => "High Templar",
90 0x6A => "Command Center",
92 0x6C => "Nuclear Silo",
93 0x6D => "Supply Depot",
94 0x6E => "Refinery", # refinery?
96 0x70 => "Academy", # Academy?
99 0x73 => "Control Tower",
100 0x74 => "Science Facility",
101 0x75 => "Covert Ops",
102 0x76 => "Physics Lab",
104 0x78 => "Machine Shop",
106 0x7A => "Engineering Bay",
108 0x7C => "Missile Turret",
111 0x82 => "Infested CC",
115 0x86 => "Nydus Canal",
116 0x87 => "Hydralisk Den",
117 0x88 => "Defiler Mound",
118 0x89 => "Greater Spire",
119 0x8A => "Queens Nest",
120 0x8B => "Evolution Chamber",
121 0x8C => "Ultralisk Cavern",
123 0x8E => "Spawning Pool",
124 0x8F => "Creep Colony",
125 0x90 => "Spore Colony",
127 0x92 => "Sunken Colony",
133 0x9B => "Robotics Facility",
135 0x9D => "Assimilator",
137 0x9F => "Observatory",
140 0xA2 => "Photon Cannon",
141 0xA3 => "Citadel of Adun",
142 0xA4 => "Cybernetics Core",
143 0xA5 => "Templar Archives",
147 0xA9 => "Fleet Beacon",
148 0xAA => "Arbiter Tribunal",
149 0xAB => "Robotics Support Bay",
150 0xAC => "Shield Battery",
154 0xC2 => "Dark Archon",
157 0xC5 => "Interceptor",
158 0xC6 => "Interceptor/Scarab",
161 "Terran Infantry Armor",
162 "Terran Vehicle Plating",
163 "Terran Ship Plating",
165 "Zerg Flyer Carapace",
166 "Protoss Ground Armor",
168 "Terran Infantry Weapons",
169 "Terran Vehicle Weapons",
170 "Terran Ship Weapons",
171 "Zerg Melee Attacks",
172 "Zerg Missile Attacks",
173 "Zerg Flyer Attacks",
174 "Protoss Ground Weapons",
175 "Protoss Air Weapons",
176 "Protoss Plasma Shields",
178 "U-238 Shells (Marine Range)",
179 "Ion Thrusters (Vulture Speed)",
181 "Titan Reactor (Science Vessel Energy)",
182 "Ocular Implants (Ghost Sight)",
183 "Moebius Reactor (Ghost Energy)",
184 "Apollo Reactor (Wraith Energy)",
185 "Colossus Reactor (Battle Cruiser Energy)",
186 "Ventral Sacs (Overlord Transport)",
187 "Antennae (Overlord Sight)",
188 "Pneumatized Carapace (Overlord Speed)",
189 "Metabolic Boost (Zergling Speed)",
190 "Adrenal Glands (Zergling Attack)",
191 "Muscular Augments (Hydralisk Speed)",
192 "Grooved Spines (Hydralisk Range)",
193 "Gamete Meiosis (Queen Energy)",
196 "Singularity Charge (Dragoon Range)",
197 "Leg Enhancement (Zealot Speed)",
200 "Gravitic Drive (Shuttle Speed)",
201 "Sensor Array (Observer Sight)",
202 "Gravitic Booster (Observer Speed)",
203 "Khaydarin Amulet (Templar Energy)",
204 "Apial Sensors (Scout Sight)",
205 "Gravitic Thrusters (Scout Speed)",
207 "Khaydarin Core (Arbiter Energy)",
210 "Argus Jewel (Corsair Energy)",
213 "Argus Talisman (Dark Archon Energy)",
214 "Caduceus Reactor (Medic Energy)",
215 "Chitinous Plating (Ultralisk Armor)",
216 "Anabolic Synthesis (Ultralisk Speed)",
217 "Charon Boosters (Goliath Range)",
229 "Cloaking Field (wraith)",
230 "Personal Cloaking (ghost)",
258 0x02 => "Unallowed Move?",
259 0x06 => "Force move",
262 0x0E => "Attack Move",
263 0x13 => "Failed Casting (?)",
267 0x27 => "Clear Rally",
274 0x77 => "Dark Swarm",
276 0x79 => "Spawn Broodling",
278 0x7E => "Launch Nuke",
280 0x8B => "ComSat Scan",
281 0x8D => "Defense Matrix",
282 0x8E => "Psionic Storm",
288 0x94 => "Hallucination",
292 0xB5 => "Disruption Web",
293 0xB6 => "Mind Control",
295 0xB9 => "Optic Flare",
301 0x09 => ["select", 1, 2 | CMD_REPEAT],
302 0x0A => ["add", 1, 2 | CMD_REPEAT],
303 0x0B => ["deselect", 1, 2 | CMD_REPEAT],
304 0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
305 0x0D => ["vision", 2],
306 0x0E => ["ally", 2, 2],
307 0x13 => ["hotkey", 1, [qw"assign select"], 1],
308 0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
309 0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
311 0x19 => ["cancel hatch"],
313 0x1E => ["return cargo", 1],
314 0x1F => ["train", 2, \%unit],
315 0x20 => ["cancel train", 2], # == 254
316 0x21 => ["cloak", 1],
317 0x22 => ["decloak", 1],
318 0x23 => ["hatch", 2, \%unit],
319 0x25 => ["unsiege", 1],
320 0x26 => ["siege", 1],
321 0x27 => ["arm", 0], # scarab/interceptor
322 0x28 => ["unload all", 1],
323 0x29 => ["unload", 2],
324 0x2A => ["merge archon", 0],
325 0x2B => ["hold position", 1],
326 0x2C => ["burrow", 1],
327 0x2D => ["unburrow", 1],
328 0x2E => ["cancel nuke", 0],
329 0x2F => ["lift", 2, 2],
330 0x30 => ["research", 1, \@research],
331 0x31 => ["cancel research", 0],
332 0x32 => ["upgrade", 1, \@upgrade],
333 # 0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
334 0x35 => ["morph", 2, \%unit],
336 0x57 => ["part", 1, {qw"1 quit 6 drop"}],
337 0x5A => ["merge dark archon", 0],
347 my ($fh, $size, $seek) = @_;
348 seek *$fh, $seek, 0 if $seek;
349 read(*$fh, my $in, $size) eq $size or return undef;
357 while (not eof $file) {
358 local $_ = $self->_read($file, 5)
359 and my ($time, $size) = unpack "VC", $_
360 or die "Couldn't read time block head\n";
361 local $_ = $self->_read($file, $size)
362 and my @block = unpack "C*", $_
363 or die "Couldn't read time block data\n";
365 my $player = shift @block;
366 my $cmd = shift @block;
367 if (not defined $cmdread{$cmd}) {
368 warn sprintf "command #%X not defined: %d bytes ignored\n",
370 push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
375 my ($data, $byte) = @_;
376 my $out = shift @$data;
377 if (($byte & 3) == 2) {
378 @$data ? ($out += shift(@$data) << 8)
379 : warn "high byte not present\n";
384 my @format = @{ $cmdread{$cmd} };
385 my $desc = shift @format;
387 for my $bit (@format) {
389 if (ref $bit eq "ARRAY") {
390 $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
393 $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
399 if ($bit & CMD_REPEAT) {
400 push @data, readbyte(\@block, $bit) for 1 .. shift @data;
402 push @data, readbyte(\@block, $bit);
405 $desc eq "move" and $data[2] == 0 and $desc = "rally";
406 push @$self, [$time, $player, $desc, @data];
415 my $time = shift() * .042;
416 my $minutes = int($time / 60);
417 return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
421 my ($template, $expr, @elements) = @_;
422 my @data = unpack $template, $expr;
424 $map{$_} = shift @data for @elements;
425 return (\%map, @data);
428 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
429 and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24Ca26a38a*", $_, qw(
430 engine frames mag1 time mag2 name width height
431 unknown1 creator unknown2 map unknown3
433 or die "Couldn't read replay header\n";
435 $_ eq "\0\0\110" or warn sprintf(
436 "Mismatch in first header constant: %s\n",
437 join ",", map ord, split //, $_
439 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
440 "Mismatch in second header constant: %s\n",
441 join ",", map ord, split //, $_
443 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
445 my @playdata = unpack "a36"x12 . "V8C8", $headdata[0]
446 or die "Couldn't parse player data in replay header\n";
449 push @player, unpackhash("x11Z25", shift @playdata, qw/name/) for 0 .. 11;
450 $player[$_]->{color} = shift @playdata for 0 .. 7;
451 $player[$_]->{index} = shift @playdata for 0 .. 7;
453 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
455 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
456 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
457 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
462 print Dumper \@player;
463 #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
467 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
471 my ($time, $player, $desc, @data) = @$_;
472 printf("@%s #%d %s: %s\n",
473 showtime($time), $player, $desc, join(", ", @data)
478 my %cmdmacro = map {$_ => 1} (
479 (map {$_, "cancel $_"}
480 qw/train build hatch research upgrade arm/,
482 qw/hotkey vision part rally/,
486 my %stats; # player => count
488 $stats{$_->[1]}{actions}++;
489 $stats{$_->[1]}{gameactions}++ if $_->[0] > 80 / .042;
490 $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
491 $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
492 $stats{$_->[1]}{count}{$_->[2]}++;
495 for my $player (sort keys %stats) {
496 my $row = $stats{$player};
497 $row->{last} ||= $map->[-1][0];
498 # printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
499 printf("%d:%6d actions in%7d frames (%s) = %d APM\n",
500 $player, $row->{actions}, $row->{last},
501 showtime($row->{last}),
502 # $row->{micro} / $row->{last} * 60 / .042 * 1.05,
503 # $row->{macro} / $row->{last} * 60 / .042 * 1.05,
504 $row->{gameactions} / $row->{last} * 60 / .042 * 1.042,
505 # $row->{gameactions} / $map->[-1][0] * 60 / .042,
509 my @order; # pos => [ [ pct, cmd ] ]
511 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
512 for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
513 print "build order:\n";
517 my ($pos, $txt) = @$_;
518 print ' ' x ($pos*60 - $lastpos);
519 $txt = substr $txt, 0, 8;
521 $lastpos = $pos + length $txt;
527 printf("action distribution: %s\n",
529 sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
531 sort {$row->{count}{$b} <=> $row->{count}{$a}}
532 keys %{ $row->{count} }