scmap

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Data::Dumper;
   5
   6 my $SHOWWARN = 0;
   7 my $SHOWMAP = "head"; # ascii, num, ppm
   8 my $SHOWCOL = 0;
   9
  10 use Getopt::Long;
  11 GetOptions(
  12         "verbose|v!" => \$SHOWWARN,
  13         "map|m=s" => \$SHOWMAP,
  14         "color|c" => \$SHOWCOL,
  15 );
  16
  17 use Data::StarCraft::Map;
  18 my $map = Data::StarCraft::Map->new->open(\*STDIN);
  19 $map->{DEBUG} = 1 if $SHOWWARN;
  20
  21 if ($SHOWMAP ne "ppm") {
  22         printf("%s size %dx%d, %d player\n",
  23                 $map->version,
  24                 $map->info->{x}, $map->info->{y},
  25                 scalar grep {$_->{id} == 214} $map->units,
  26         );
  27         print "\n";
  28 }
  29
  30 if ($SHOWMAP eq "head") {
  31         if ($map->{STR}) {
  32                 my @str = split /\0/, substr $map->{STR}, 2051;
  33                 $SHOWCOL ? (
  34                         s/([\001-\007])/sprintf '\e[0;%dm', 30+ord($1)/eg
  35                         and $_ .= "\e[0;37m"
  36                 ) : s/[\001-\017]//g, print "* $_\n" for @str;
  37                 print "\n";
  38         }
  39         printf "%-4s %d\n", $_, defined $map->{$_} ? length $map->{$_} : 0
  40                 for sort keys %$map;
  41         print "\n";
  42         printf "%s: %s\n", $_, join ",", unpack "C*", $map->{$_}
  43                 for sort grep { defined $map->{$_} and length $map->{$_} < 32 }
  44                         keys %$map;
  45         print "\n";
  46 }
  47
  48 sub world {
  49         my $self = shift;
  50         # ERA:          0        1     2 3 4      5 6 7
  51         my @worlds = qw(badlands space 0 0 jungle 0 0 twilight);
  52         return $worlds[$self->era] || "?";
  53 }
  54
  55 my %mapcol = (
  56         # jungle world
  57         '~' => '0 0 3', # water
  58         'W' => '3 3 7', # coast/water object
  59         'D' => '8 7 5', # D shore
  60
  61         'j' => '2 3 0', # jungle
  62         'd' => '3 3 0', # dirt
  63         'm' => '3 3 1', # mud
  64         'o' => '3 3 2', # rocky
  65         'O' => '11 10 6', # object on lower ground
  66         'l' => '4 4 2', # ruins
  67
  68         'R' => '3 9 3',   # raised jungle
  69         'r' => '8 14 8',
  70         'x' => '6 9 2',   # high jungle
  71         'h' => '10 10 4', # high dirt
  72         'q' => '12 11 0', # high ruins
  73         'i' => '13 9 0', # temple
  74
  75         'R' => '2 5 2',   # raised jungle
  76         'r' => '4 6 4',
  77         'x' => '5 7 3',   # high jungle
  78         'h' => '7 7 3', # high dirt
  79         'q' => '8 8 5', # high ruins
  80         'Q' => '15 15 8', # object on higher ground
  81         'i' => '10 9 5', # temple
  82         'b' => '5 4 3', # asphalt/basilica
  83         'a' => '13 11 5', # high basilica
  84         'A' => '13 12 10', # bas. sides
  85
  86         '/' => '15 15 11',
  87         '\\' => '13 13 9',
  88         '=' => '11 12 8',
  89
  90         '7' => '3 3 1', # D>H
  91         '6' => '4 4 1',
  92         '5' => '4 4 2',
  93         '4' => '5 5 2',
  94         '3' => '5 5 3',
  95         '2' => '6 6 3',
  96         '1' => '7 7 4',
  97
  98         # common
  99         '$' => '0 13 15', # mineral patch
 100         '*' => '4 15 8', # gas geyser
 101         '@' => '14 4 3', # start location
 102         '#' => '15 12 0', # unknown unit
 103
 104         ' ' => '15 15 15', # defined unencountered
 105         '?' => '0 0 0',    # undefined
 106         '!' => '15 0 15',  # marked
 107         '-' => '0 15 0',   # debug
 108 );
 109 my @eramapcol = (
 110         { # badlands (era 0)
 111                 # d:   dirt
 112                 # o?:  mud
 113                 # h:   high dirt
 114                 # ~:   water
 115                 # j:   grass
 116                 # x/o: high grass
 117                 # s:   structure
 118                 # b:   asphalt
 119                 # i?:  rocky ground
 120
 121                 'b' => '3 3 2', # asphalt
 122                 'j' => '5 4 0', # grass
 123                 'd' => '4 3 1', # dirt
 124                 'q' => '4 3 2', # dirt ↔ asphalt
 125                 'o' => '8 8 5', # high grass (also mud?)
 126                 'm' => '3 2 14', # ?
 127                 'O' => '11 10 6', # object on lower ground
 128                 'l' => '4 3 2', # asphalt↔dirt
 129
 130                 'h' => '8 7 5', # high dirt
 131                 'x' => '9 8 5', # high grass ↔ high dirt?
 132
 133                 '/' => '15 14 11',
 134                 'r' => '9 9 9', # structure
 135         },
 136
 137         { # space platform
 138         },
 139
 140         { # desert
 141                 #    tar
 142                 #    dirt
 143                 #    dried mud
 144                 #    sand dunes
 145                 #    rocky ground
 146                 #    crags
 147                 #    sandy sunken pit
 148                 #    compound
 149                 #    high dirt
 150                 #    high sand dunes
 151                 #    high crags
 152                 #    high sandy sunken pit
 153                 #    high compound
 154         },
 155
 156         { # ice
 157                 #    ice
 158                 #    snow
 159                 #    moguls
 160                 #    dirt
 161                 #    rocky snow
 162                 #    grass
 163                 #    water
 164                 #    outpost
 165                 #    high snow
 166                 #    high dirt
 167                 #    high grass
 168                 #    high water
 169                 #    high outpost
 170         },
 171
 172         { # jungle (era 4)
 173                 # ~: water
 174                 # d: dirt
 175                 # m: mud
 176                 # j: jungle
 177                 # o: rocky ground
 178                 # l: ruins
 179                 # r: raised jungle
 180                 #    temple
 181                 # h: high dirt
 182                 # x: high jungle
 183                 # q: high ruins
 184                 #    high raised jungle
 185                 # i: high temple
 186         },
 187
 188         { # ash
 189                 #    magma
 190                 # d: dirt
 191                 # l: lava
 192                 # o: shale
 193                 #    broken rock
 194                 #    high dirt
 195                 #    high lava
 196                 #    high shale
 197         },
 198
 199         { # installation
 200         },
 201
 202         { # twilight (era 7)
 203                 #    water
 204                 #    dirt
 205                 #    mud
 206                 #    crushed rock
 207                 #    crevices
 208                 #    flagstones
 209                 #    sunken ground
 210                 #    basilica
 211                 #    high dirt
 212                 #    high crushed rock
 213                 #    high flagstones
 214                 #    high sunken ground
 215                 #    high basilica
 216 #               'b' => '5 4 3', # basilica
 217 #               'p' => '3 3 2', # ?
 218 #               'r' => '3 9 3', # sunken stuff
 219         },
 220 );
 221 my %addmapcol = !$SHOWWARN ? () : (
 222         '?' => '15 0 0',
 223         'm' => '2 2 1',
 224 );
 225
 226 #%mapcol = (%mapcol, %{$eramapcol[$map->era]}, %addmapcol);
 227 %mapcol = (%mapcol, %{$eramapcol[4]}, %addmapcol);
 228
 229 #        MTXM TILE
 230 # ?      ?    yes
 231 # v205 = yes  no
 232
 233 my %mapsep = (
 234         num => ',',
 235         ppm => '  ',
 236         ascii => '',
 237 );
 238
 239 if (defined $mapsep{$SHOWMAP}) {
 240         my $MAPCHARSEP = $mapsep{$SHOWMAP};
 241
 242         my $tiles = $SHOWMAP eq "num" ? [ map sprintf('%5d', $_), @{$map->tiles} ]
 243                 : $map->tiles_parsed;
 244
 245         if ($SHOWMAP eq "ppm") {
 246                 printf "P3\n%d %d\n15\n", $map->info->{x}, $map->info->{y};
 247                 if ($SHOWWARN) {
 248                         my %uncolored;
 249                         defined $mapcol{$_} or $uncolored{$_}++ for @$tiles, '?';
 250                         warn "no color for tile '$_'\n" for keys %uncolored;
 251                 }
 252                 $_ = $mapcol{$_} || $mapcol{'?'} || '0 0 0' for @$tiles;
 253                 if (0){
 254                         sub surround {
 255                                 my ($unit, $match, $color) = @_;
 256                                 my $pos = $unit->{x} + $unit->{y} * $map->width;
 257                                 for my $delta (
 258                                         $pos+1, $pos-1,
 259                                         $pos+$map->width, $pos-$map->width,
 260                                         $pos+1+$map->width, $pos+1-$map->width,
 261                                 ) {
 262                                         $tiles->[$delta] =~ s/($match)/$1 + $color/e
 263                                                 unless $tiles->[$delta] eq $mapcol{$unit->{chr}};
 264                                 }
 265                         }
 266                         for ($map->units_parsed) {
 267                                 if ($_->{chr} eq '$') {
 268                                         surround($_, qr/\d+$/, 7);
 269                                 } elsif ($_->{chr} eq '*') {
 270                                         surround($_, qr/\d+(?= \d+$)/, 3);
 271                                 }
 272                         }
 273                 }
 274         }
 275
 276         while (my @line = splice @$tiles, 0, $map->width) {
 277                 printf "%s\n", join $MAPCHARSEP, @line;
 278         }
 279 }
 280