12 "verbose|v!" => \$SHOWWARN,
13 "apm|a=s" => \$APMSVG,
17 use constant { APM_FIRSTFRAME => 80 / .042 };
21 package Data::StarCraft::Replay;
47 0x09 => "Science Vessel",
50 0x0C => "Battlecruiser",
72 0x32 => "Infested Terran",
77 0x3D => "Dark Templar",
83 0x43 => "High Templar",
96 0x6A => "Command Center",
98 0x6C => "Nuclear Silo",
99 0x6D => "Supply Depot",
100 0x6E => "Refinery", # refinery?
102 0x70 => "Academy", # Academy?
105 0x73 => "Control Tower",
106 0x74 => "Science Facility",
107 0x75 => "Covert Ops",
108 0x76 => "Physics Lab",
110 0x78 => "Machine Shop",
112 0x7A => "Engineering Bay",
114 0x7C => "Missile Turret",
117 0x82 => "Infested CC",
121 0x86 => "Nydus Canal",
122 0x87 => "Hydralisk Den",
123 0x88 => "Defiler Mound",
124 0x89 => "Greater Spire",
125 0x8A => "Queens Nest",
126 0x8B => "Evolution Chamber",
127 0x8C => "Ultralisk Cavern",
129 0x8E => "Spawning Pool",
130 0x8F => "Creep Colony",
131 0x90 => "Spore Colony",
133 0x92 => "Sunken Colony",
139 0x9B => "Robotics Facility",
141 0x9D => "Assimilator",
143 0x9F => "Observatory",
146 0xA2 => "Photon Cannon",
147 0xA3 => "Citadel of Adun",
148 0xA4 => "Cybernetics Core",
149 0xA5 => "Templar Archives",
153 0xA9 => "Fleet Beacon",
154 0xAA => "Arbiter Tribunal",
155 0xAB => "Robotics Support Bay",
156 0xAC => "Shield Battery",
160 0xC2 => "Dark Archon",
163 0xC5 => "Interceptor",
164 0xC6 => "Interceptor/Scarab",
167 "Terran Infantry Armor",
168 "Terran Vehicle Plating",
169 "Terran Ship Plating",
171 "Zerg Flyer Carapace",
172 "Protoss Ground Armor",
174 "Terran Infantry Weapons",
175 "Terran Vehicle Weapons",
176 "Terran Ship Weapons",
177 "Zerg Melee Attacks",
178 "Zerg Missile Attacks",
179 "Zerg Flyer Attacks",
180 "Protoss Ground Weapons",
181 "Protoss Air Weapons",
182 "Protoss Plasma Shields",
184 "U-238 Shells (Marine Range)",
185 "Ion Thrusters (Vulture Speed)",
187 "Titan Reactor (Science Vessel Energy)",
188 "Ocular Implants (Ghost Sight)",
189 "Moebius Reactor (Ghost Energy)",
190 "Apollo Reactor (Wraith Energy)",
191 "Colossus Reactor (Battle Cruiser Energy)",
192 "Ventral Sacs (Overlord Transport)",
193 "Antennae (Overlord Sight)",
194 "Pneumatized Carapace (Overlord Speed)",
195 "Metabolic Boost (Zergling Speed)",
196 "Adrenal Glands (Zergling Attack)",
197 "Muscular Augments (Hydralisk Speed)",
198 "Grooved Spines (Hydralisk Range)",
199 "Gamete Meiosis (Queen Energy)",
202 "Singularity Charge (Dragoon Range)",
203 "Leg Enhancement (Zealot Speed)",
206 "Gravitic Drive (Shuttle Speed)",
207 "Sensor Array (Observer Sight)",
208 "Gravitic Booster (Observer Speed)",
209 "Khaydarin Amulet (Templar Energy)",
210 "Apial Sensors (Scout Sight)",
211 "Gravitic Thrusters (Scout Speed)",
213 "Khaydarin Core (Arbiter Energy)",
216 "Argus Jewel (Corsair Energy)",
219 "Argus Talisman (Dark Archon Energy)",
220 "Caduceus Reactor (Medic Energy)",
221 "Chitinous Plating (Ultralisk Armor)",
222 "Anabolic Synthesis (Ultralisk Speed)",
223 "Charon Boosters (Goliath Range)",
235 "Cloaking Field (wraith)",
236 "Personal Cloaking (ghost)",
264 0x02 => "Unallowed Move?",
265 0x06 => "Force move",
268 0x0E => "Attack Move",
269 0x13 => "Failed Casting (?)",
273 0x27 => "Clear Rally",
280 0x77 => "Dark Swarm",
282 0x79 => "Spawn Broodling",
284 0x7E => "Launch Nuke",
286 0x8B => "ComSat Scan",
287 0x8D => "Defense Matrix",
288 0x8E => "Psionic Storm",
294 0x94 => "Hallucination",
298 0xB5 => "Disruption Web",
299 0xB6 => "Mind Control",
301 0xB9 => "Optic Flare",
307 0x09 => ["select", 1, 2 | CMD_REPEAT],
308 0x0A => ["add", 1, 2 | CMD_REPEAT],
309 0x0B => ["deselect", 1, 2 | CMD_REPEAT],
310 0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
311 0x0D => ["vision", 2],
312 0x0E => ["ally", 2, 2],
313 0x13 => ["hotkey", 1, [qw"assign select"], 1],
314 0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
315 0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
317 0x19 => ["cancel hatch"],
319 # 0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
320 0x1E => ["return cargo", 1],
321 0x1F => ["train", 2, \%unit],
322 0x20 => ["cancel train", 2], # == 254
323 0x21 => ["cloak", 1],
324 0x22 => ["decloak", 1],
325 0x23 => ["hatch", 2, \%unit],
326 0x25 => ["unsiege", 1],
327 0x26 => ["siege", 1],
328 0x27 => ["arm", 0], # scarab/interceptor
329 0x28 => ["unload all", 1],
330 0x29 => ["unload", 2],
331 0x2A => ["merge archon", 0],
332 0x2B => ["hold position", 1],
333 0x2C => ["burrow", 1],
334 0x2D => ["unburrow", 1],
335 0x2E => ["cancel nuke", 0],
336 0x2F => ["lift", 2, 2],
337 0x30 => ["research", 1, \@research],
338 0x31 => ["cancel research", 0],
339 0x32 => ["upgrade", 1, \@upgrade],
340 # 0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
341 0x35 => ["morph", 2, \%unit],
343 0x57 => ["part", 1, {qw"1 quit 6 drop"}],
344 0x5A => ["merge dark archon", 0],
354 my ($fh, $size, $seek) = @_;
355 seek *$fh, $seek, 0 if $seek;
356 read(*$fh, my $in, $size) eq $size or return undef;
364 while (not eof $file) {
365 local $_ = $self->_read($file, 5)
366 and my ($time, $size) = unpack "VC", $_
367 or die "Couldn't read time block head\n";
368 local $_ = $self->_read($file, $size)
369 and my @block = unpack "C*", $_
370 or die "Couldn't read time block data\n";
372 my $player = shift @block;
373 my $cmd = shift @block;
374 if (not defined $cmdread{$cmd}) {
375 warn sprintf "command #%X not defined: %d bytes ignored\n",
377 push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
382 my ($data, $byte) = @_;
383 my $out = shift @$data;
384 if (($byte & 3) == 2) {
385 @$data ? ($out += shift(@$data) << 8)
386 : warn "high byte not present\n";
391 my @format = @{ $cmdread{$cmd} };
392 my $desc = shift @format;
394 for my $bit (@format) {
396 if (ref $bit eq "ARRAY") {
397 $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
400 $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
406 if ($bit & CMD_REPEAT) {
407 push @data, readbyte(\@block, $bit) for 1 .. shift @data;
409 push @data, readbyte(\@block, $bit);
412 $desc eq "move" and $data[2] == 0 and $desc = "rally";
413 push @$self, [$time, $player, $desc, @data];
421 my @race = (qw(Z T P), (undef) x 3, '-');
424 my $time = shift() * .042;
425 my $minutes = int($time / 60);
426 return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
430 my ($template, $expr, @elements) = @_;
431 my @data = unpack $template, $expr;
433 $map{$_} = shift @data for @elements;
434 return (\%map, @data);
437 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
438 and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24CZ26a38a*", $_, qw(
439 engine frames mag1 time mag2 name width height
440 unknown1 creator unknown2 map unknown3
442 or die "Couldn't read replay header\n";
444 $_ eq "\0\0\110" or warn sprintf(
445 "Mismatch in first header constant: %s\n",
446 join ",", map ord, split //, $_
448 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
449 "Mismatch in second header constant: %s\n",
450 join ",", map ord, split //, $_
452 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
454 my @playdata = unpack "Va32"x12 . "V8C8", $headdata[0]
455 or die "Couldn't parse player data in replay header\n";
459 my $number = shift @playdata;
460 defined $player[$number] and warn "Player #$number redefined";
461 my ($data) = unpackhash("VcccZ25", shift @playdata, qw(
462 slot type race unknown name
464 defined $race[$_] ? ($data->{race} = $race[$_]) :
465 warn "Unknown race #$_ for player $number"
467 $slot[$data->{slot}] = $number if $data->{slot} < 16;
468 $player[$number] = $data;
470 $player[$_]->{color} = shift @playdata for 0 .. 7;
471 $player[$_]->{index} = shift @playdata for 0 .. 7;
475 my $playdata = $player[$slot[$id]];
476 return defined $playdata ?
477 sprintf '%s (%s)', $playdata->{name}, $playdata->{race} : "#$id";
480 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
482 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
483 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
484 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
489 print Dumper \@player;
490 #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
494 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
498 my ($time, $player, $desc, @data) = @$_;
499 printf("@%s #%d %s: %s\n",
500 showtime($time), $player, $desc, join(", ", @data)
505 my %cmdmacro = map {$_ => 1} (
506 (map {$_, "cancel $_"}
507 qw/train build hatch research upgrade arm/,
509 qw/hotkey vision part rally/,
513 my %stats; # player => count
515 $stats{$_->[1]}{actions}++;
516 $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
517 $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
518 $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
519 $stats{$_->[1]}{count}{$_->[2]}++;
522 for my $player (sort keys %stats) {
523 my $row = $stats{$player};
524 $row->{last} ||= $map->[-1][0];
525 # printf("%-16s%6d actions (%3d micro,%4d macro);%4d APM\n",
526 my $name = showplayer($player);
527 printf("%-16s%6d actions in%7d frames (%s) = %d APM\n",
528 $name, $row->{actions}, $row->{last},
529 showtime($row->{last}),
530 # $row->{micro} / $row->{last} * 60 / .042 * 1.05,
531 # $row->{macro} / $row->{last} * 60 / .042 * 1.05,
532 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
536 my @order; # pos => [ [ pct, cmd ] ]
538 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
539 for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
540 print "build order:\n";
544 my ($pos, $txt) = @$_;
545 print ' ' x ($pos*60 - $lastpos);
546 $txt = substr $txt, 0, 8;
548 $lastpos = $pos + length $txt;
554 printf("action distribution: %s\n",
556 sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
558 sort {$row->{count}{$b} <=> $row->{count}{$a}}
559 keys %{ $row->{count} }
565 open my $imgfile, '>', "test.gif" or die;
570 my $ani = GD::Image->new($head->{width}, $head->{height});
571 my $bg = $ani->colorAllocate(0, 0, 0);
573 $ani->colorAllocate(255, 0, 0),
574 $ani->colorAllocate(255, 255, 0),
575 $ani->colorAllocate(0, 255, 0),
576 $ani->colorAllocate(0, 255, 255),
577 $ani->colorAllocate(0, 0, 255),
578 $ani->colorAllocate(255, 0, 255),
581 print $ani->gifanimbegin;
582 # print $ani->gifanimadd;
584 my $frame = GD::Image->new($ani->getBounds);
585 print $frame->gifanimadd;
586 my $length = 30 / .042;
589 my ($time, $player, $cmd, @data) = @$_;
590 #$time < $length * 10 or last;
591 while ($time > $last + $length) {
593 print $frame->gifanimadd(0, 0, 0, 32);
594 # $frame = GD::Image->new($ani->getBounds);
596 if ($cmd eq "build") {
597 $frame->setPixel($data[1]>>5, $data[2]>>5, $plot[$player]);
599 elsif ($cmd eq "move" or $cmd eq "attack") {
600 $frame->setPixel($data[0]>>5, $data[1]>>5, $plot[$player]);
601 # if $data[2] == 0xFFFF_FFFF;
604 # add_frame_data($frame);
605 print $frame->gifanimadd;
607 print $ani->gifanimend;
612 my @seq; # player => time (s) => actions
613 $seq[$_->[1]][$_->[0] * .042]++ for @$map;
616 for my $player (0 .. $#seq) {
618 $range += $seq[$player][$_] || 0 for 0 .. $flatten - 1;
619 my $leadfill = $range / $flatten;
620 for my $frame (0 .. $#{$seq[$player]}) {
621 $range += $seq[$player][$frame] || 0;
622 $range -= $frame < $flatten ? $leadfill :
623 $seq[$player][$frame - $flatten] || 0;
624 $apm[$player][$frame] = $range / $flatten;
628 BEGIN { unshift @INC, '.' }
629 use SVG::TT::Graph::TimeSeries;
630 my $graph = SVG::TT::Graph::TimeSeries->new({
633 style_sheet => "apm.css",
634 show_data_values => 0,
635 show_data_points => 0,
636 x_label_format => '%k:%M',
638 timescale_divisions => "5 minutes",
642 for my $player (0 .. $#apm) {
645 time2str('%Y-%m-%d %X', 946681200 + $_),
646 $apm[$player][$_] * 60
647 } 0 .. $#{$apm[$player]} ],
648 title => showplayer($player),
652 my ($name) = $APMSVG =~ /([^.]+)/;
653 my $title = "APM timeline" . ($name && " for $name");
654 my $lead = sprintf "\n<title>%s</title>", $title;
656 my $svg = $graph->burn();
657 s/^[ \t\r]+\n//gm, # remove lines with only whitespace (many useless ^M)
658 s/[ \t\r]+$//gm, # trailing whitespace
659 s/ {4}\r*/\t/g, # tabs for indenting
660 s/^(<svg width=")1600(" height=")1200("[^>]*>)/${1}100%${2}100%$3$lead/m,
661 for $svg; # cleanup xml
663 open my $apmfile, '>', "$APMSVG.svg";