graphplay

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4
   5 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
   6 use Template;
   7 use List::Util;
   8 use Data::Dumper;
   9
  10 our $VERSION = '1.00';
  11
  12 GetOptions(
  13         "verbose|v!" => \our $DEBUG,
  14 ) or HelpMessage(-exitval => 2);
  15
  16 my %area = (
  17         fieldxmin => 45,
  18         fieldxmax => 1590,
  19         fieldymin => 10,
  20         fieldymax => 575,
  21         xmax => 1600,
  22         ymax => 600,
  23 );
  24 $area{fieldxsize} = $area{fieldxmax} - $area{fieldxmin};
  25 $area{fieldysize} = $area{fieldymax} - $area{fieldymin};
  26
  27 my @lines;
  28 my @max = (0) x 4;
  29 my $maxtime = 0;
  30 my $player = 0;
  31
  32 for my $input (@ARGV) {
  33         open my $datafile, '<', $input or next;
  34         my @data;
  35         my $lasttime;
  36         while (defined ($_ = readline $datafile)) {
  37                 my ($frame, $time, @vars) = split /\t/, $_;
  38                 $frame =~ /^\d+:$/ or next;
  39                 if ($time !~ /^\d+$/) {
  40                         defined $lasttime or next;
  41                         $time = $lasttime + 1;
  42                         $lasttime = undef;
  43                 } else {
  44                         $lasttime = $time;
  45                 }
  46                 /^\d+$/ or $_ = undef for @vars;
  47                 push @{$data[$time]} => \@vars;
  48                 defined $vars[$_] and $vars[$_] > $max[$_] and $max[$_] = $vars[$_]
  49                         for 0 .. $#vars;
  50         }
  51         $maxtime = $#data if $#data > $maxtime;
  52         close $datafile;
  53
  54         for my $time (0 .. $#data) {
  55                 my $vals = $data[$time];
  56                 for my $subtime (0 .. $#$vals) {
  57                         defined $vals->[$subtime]->[$_] and push @{$lines[$_][$player]} => [
  58                                 ($time + $subtime/@$vals), # x
  59                                 $vals->[$subtime]->[$_] # y
  60                         ] for 0 .. 3;
  61                 }
  62         }
  63
  64         for (0 .. 3) {
  65                 my $line = $lines[$_][$player];
  66                 my $start;
  67                 my $lasty;
  68                 for (my $i = 1; $i <= $#$line; $i++) {
  69                         defined $line->[$i] or next;
  70                         if ($line->[$i][1] == $line->[$i - 1][1]) {
  71                                 $start = $i unless defined $start;
  72                         } elsif (defined $start) {
  73                                 delete @$line[$start .. $i-2];
  74                                 undef $start;
  75                         }
  76                 }
  77                 delete @$line[$start .. $#$line-2] if defined $start; # or -1
  78         }
  79
  80         $player++;
  81 }
  82
  83 $max[2] = $max[3];
  84 my @norm = ((map {$area{fieldysize} / $_} @max), $area{fieldxsize} / $maxtime);
  85
  86 my $xsteps = 25;
  87 my $xstep = $maxtime / $xsteps;
  88 my @xaxis = map [$area{fieldxmin} + $_ * $norm[4], sprintf '%d:%02d', $_/3600, $_/60%60],
  89         map $_*$xstep, 0 .. $xsteps-1;
  90
  91 my $ysteps = 10;
  92 my @yaxis;
  93 for my $i (0 .. 3) {
  94         my $ystep = $max[$i] / $ysteps;
  95         $ystep = 10 ** int (log($ystep * 4) / log(10));
  96         $ystep /= 2 while $ystep * $ysteps > $max[$i];
  97         $yaxis[$i] = [
  98                 map [$area{fieldymax} - $_ * $norm[$i], $_],
  99                         map $_*$ystep, 0 .. int $max[$i] / $ystep
 100         ];
 101 }
 102
 103 undef $/;
 104 my $svg = Template->new({POST_CHOMP => 1, BLOCKS => {timeline => readline DATA}});
 105
 106 for ([0 => "min", "Minerals"], [1 => "gas", "Gas"], [2 => "unit", "Units"]) {
 107         my ($line, $filename, $title) = @$_;
 108         open my $output, '>', "$filename.svg";
 109         $svg->process('timeline', {
 110                 title => "$title timeline for /replay/20080201md4x4",
 111                 fill => $line == 2 && [
 112                         map { "\n\tM " . join "\tL ", map sprintf("%s %s\n",
 113                                 $area{fieldxmin} + $_->[0] * $norm[4],
 114                                 $area{fieldymax} - $_->[1] * $norm[$line+1]
 115                         ), grep defined, @{$lines[$line][$_]}, reverse @{$lines[$line+1][$_]} } 0 .. $#{$lines[$line]}
 116                 ],
 117                 paths => [
 118                         map { "\n\tM " . join "\tL ", map sprintf("%s %s\n",
 119                                 $area{fieldxmin} + $_->[0] * $norm[4],
 120                                 $area{fieldymax} - $_->[1] * $norm[$line]
 121                         ), grep defined, @$_ } @{$lines[$line]}
 122                 ],
 123                 xaxis => \@xaxis,
 124                 yaxis => $yaxis[$line],
 125                 area => \%area,
 126         }, $output) or die $svg->error;
 127 }
 128
 129 __DATA__
 130 <?xml version="1.0"?>
 131 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN"
 132  "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
 133
 134 <?xml-stylesheet href="http://sc.shiar.net/apm.css" type="text/css"?>
 135
 136 <svg width="100%" height="100%" viewBox="0 0 [% area.xmax %] [% area.ymax %]"
 137  xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
 138 <title>[% title %]</title>
 139
 140 <rect x="0" y="0" width="[% area.xmax %]" height="[% area.ymax %]" class="svgBackground" />
 141 <rect x="[% area.fieldxmin %]" y="[% area.fieldymin %]" width="[% area.fieldxsize %]" height="[% area.fieldysize %]" class="graphBackground" />
 142
 143 <path d="M[% area.fieldxmin %] [% area.fieldymin %] v[% area.fieldysize %]" class="axis" id="xAxis"/>
 144 [% FOREACH entry = xaxis %]
 145 <text x="[% entry.0 %]" y="[% area.fieldymax + 15 %]" class="xAxisLabels"> [% entry.1 %]</text>
 146 [% END %]
 147
 148 <path d="M[% area.fieldxmin %] [% area.fieldymax %] h[% area.fieldxsize %]" class="axis" id="yAxis"/>
 149 [% FOREACH entry = yaxis %]
 150 <path d="M[% area.fieldxmin %] [% entry.0 %] h[% area.fieldxsize %]" class="guideLines" />
 151 <text x="[% area.fieldxmin - 5 %]" y="[% entry.0 %]" class="yAxisLabels">[% entry.1 %]</text>
 152 [% END %]
 153
 154 <g class="data">
 155 [% count = 0 %]
 156 [% FOREACH path = paths %][% count = count + 1 %]
 157 <path d="[% path %]" class="line[% count %]" />
 158 [% END %]
 159 </g>
 160
 161 [% IF fill %]
 162 <g class="data">
 163 [% count = 0 %]
 164 [% FOREACH path = fill %][% count = count + 1 %]
 165 <path d="[% path %]" class="fill[% count %]" />
 166 [% END %]
 167 </g>
 168 [% END %]
 169
 170 </svg>
 171