complete tile drawing support in Data::StarCraft::Tileset
[perl/schtarr.git] / scmap
diff --git a/scmap b/scmap
index cd564d3280463b40483164248593cc37754729ce..3e7cee029284064e03abd8195d74a5c6a98f4896 100755 (executable)
--- a/scmap
+++ b/scmap
@@ -52,180 +52,6 @@ sub world {
        return $worlds[$self->era] || "?";
 }
 
-my %mapcol = (
-       # jungle world
-       '~' => '0 0 3', # water
-       'W' => '3 3 7', # coast/water object
-       'D' => '8 7 5', # D shore
-
-       'j' => '2 3 0', # jungle
-       'd' => '3 3 0', # dirt
-       'm' => '3 3 1', # mud
-       'o' => '3 3 2', # rocky
-       'O' => '11 10 6', # object on lower ground
-       'l' => '4 4 2', # ruins
-
-       'R' => '3 9 3',   # raised jungle
-       'r' => '8 14 8',
-       'x' => '6 9 2',   # high jungle
-       'h' => '10 10 4', # high dirt
-       'q' => '12 11 0', # high ruins
-       'i' => '13 9 0', # temple
-
-       'R' => '2 5 2',   # raised jungle
-       'r' => '4 6 4',
-       'x' => '5 7 3',   # high jungle
-       'h' => '7 7 3', # high dirt
-       'q' => '8 8 5', # high ruins
-       'Q' => '15 15 8', # object on higher ground
-       'i' => '10 9 5', # temple
-       'b' => '5 4 3', # asphalt/basilica
-       'a' => '13 11 5', # high basilica
-       'A' => '13 12 10', # bas. sides
-
-       '/' => '15 15 11',
-       '\\' => '13 13 9',
-       '=' => '11 12 8',
-
-       '7' => '3 3 1', # D>H
-       '6' => '4 4 1',
-       '5' => '4 4 2',
-       '4' => '5 5 2',
-       '3' => '5 5 3',
-       '2' => '6 6 3',
-       '1' => '7 7 4',
-
-       # common
-       '$' => '0 13 15', # mineral patch
-       '*' => '4 15 8', # gas geyser
-       '@' => '14 4 3', # start location
-       '#' => '15 12 0', # unknown unit
-
-       ' ' => '15 15 15', # defined unencountered
-       '?' => '0 0 0',    # undefined
-       '!' => '15 0 15',  # marked
-       '-' => '0 15 0',   # debug
-);
-my @eramapcol = (
-       { # badlands (era 0)
-               # d:   dirt
-               # o?:  mud 
-               # h:   high dirt
-               # ~:   water
-               # j:   grass
-               # x/o: high grass
-               # s:   structure
-               # b:   asphalt
-               # i?:  rocky ground
-
-               'b' => '3 3 2', # asphalt
-               'j' => '5 4 0', # grass
-               'd' => '4 3 1', # dirt
-               'q' => '4 3 2', # dirt ↔ asphalt
-               'o' => '8 8 5', # high grass (also mud?)
-               'm' => '3 2 14', # ?
-               'O' => '11 10 6', # object on lower ground
-               'l' => '4 3 2', # asphalt↔dirt
-
-               'h' => '8 7 5', # high dirt
-               'x' => '9 8 5', # high grass ↔ high dirt?
-
-               '/' => '15 14 11',
-               'r' => '9 9 9', # structure
-       },
-
-       { # space platform
-       },
-
-       { # desert
-               #    tar
-               #    dirt
-               #    dried mud
-               #    sand dunes
-               #    rocky ground
-               #    crags
-               #    sandy sunken pit
-               #    compound
-               #    high dirt
-               #    high sand dunes
-               #    high crags
-               #    high sandy sunken pit
-               #    high compound
-       },
-
-       { # ice
-               #    ice
-               #    snow
-               #    moguls
-               #    dirt
-               #    rocky snow
-               #    grass
-               #    water
-               #    outpost
-               #    high snow
-               #    high dirt
-               #    high grass
-               #    high water
-               #    high outpost
-       },
-
-       { # jungle (era 4)
-               # ~: water
-               # d: dirt
-               # m: mud
-               # j: jungle
-               # o: rocky ground
-               # l: ruins
-               # r: raised jungle
-               #    temple
-               # h: high dirt
-               # x: high jungle
-               # q: high ruins
-               #    high raised jungle
-               # i: high temple
-       },
-
-       { # ash
-               #    magma
-               # d: dirt
-               # l: lava
-               # o: shale
-               #    broken rock
-               #    high dirt
-               #    high lava
-               #    high shale
-       },
-
-       { # installation
-       },
-
-       { # twilight (era 7)
-               #    water
-               #    dirt
-               #    mud
-               #    crushed rock
-               #    crevices
-               #    flagstones
-               #    sunken ground
-               #    basilica
-               #    high dirt
-               #    high crushed rock
-               #    high flagstones
-               #    high sunken ground
-               #    high basilica
-#              'b' => '5 4 3', # basilica
-#              'p' => '3 3 2', # ?
-#              'r' => '3 9 3', # sunken stuff
-       },
-);
-my %addmapcol = !$SHOWWARN ? () : (
-       '?' => '15 0 0',
-       'm' => '2 2 1',
-);
-
-#%mapcol = (%mapcol, %{$eramapcol[$map->era]}, %addmapcol);
-%mapcol = (%mapcol, %{$eramapcol[4]}, %addmapcol);
-
 #        MTXM TILE
 # ?      ?    yes
 # v205 = yes  no
@@ -240,36 +66,33 @@ if (defined $mapsep{$SHOWMAP}) {
        my $MAPCHARSEP = $mapsep{$SHOWMAP};
 
        my $tiles = $SHOWMAP eq "num" ? [ map sprintf('%5d', $_), @{$map->tiles} ]
-               : $map->tiles_parsed;
+               : $map->tiles;#_parsed;
 
        if ($SHOWMAP eq "ppm") {
-               printf "P3\n%d %d\n15\n", $map->info->{x}, $map->info->{y};
-               if ($SHOWWARN) {
-                       my %uncolored;
-                       defined $mapcol{$_} or $uncolored{$_}++ for @$tiles, '?';
-                       warn "no color for tile '$_'\n" for keys %uncolored;
+               use Data::StarCraft::Tileset;
+               my $era = world($map);
+               if ($era eq '?') {
+                       warn 'Tileset '.$map->era.' not recognized; fallback to jungle';
+                       $era = 'jungle';
                }
-               $_ = $mapcol{$_} || $mapcol{'?'} || '0 0 0' for @$tiles;
-               if (0){
-                       sub surround {
-                               my ($unit, $match, $color) = @_;
-                               my $pos = $unit->{x} + $unit->{y} * $map->width;
-                               for my $delta (
-                                       $pos+1, $pos-1,
-                                       $pos+$map->width, $pos-$map->width,
-                                       $pos+1+$map->width, $pos+1-$map->width,
-                               ) {
-                                       $tiles->[$delta] =~ s/($match)/$1 + $color/e
-                                               unless $tiles->[$delta] eq $mapcol{$unit->{chr}};
-                               }
-                       }
-                       for ($map->units_parsed) {
-                               if ($_->{chr} eq '$') {
-                                       surround($_, qr/\d+$/, 7);
-                               } elsif ($_->{chr} eq '*') {
-                                       surround($_, qr/\d+(?= \d+$)/, 3);
-                               }
+               my $tileset = Data::StarCraft::Tileset->open("/home/shiar/sc/tileset_$era")
+                       or die "No tileset for world $era";
+
+               printf "P3\n%d %d\n255\n", $map->info->{x}, $map->info->{y};
+               for (@$tiles) {
+                       my $tile = $tileset->tileavg($_);
+                       my $div = 1;#$tile->{walk} > 1 ? 1 : 1.8;
+                       my @rgb = map {int($_ / $div)} @{ $tile->{col} };
+                       if (($tile->{walk} & 1) == 0 and $tile->{walk} < 10) {
+#                              $rgb[2] += 128;
+                               $rgb[0] *= 3;
+                               $rgb[1] *= 3;
+                               $rgb[2] *= 3;
+                       } elsif ($tile->{build}) {
+                               $rgb[0] += 48;
+#                              $rgb[$_] = int($rgb[$_] / 1.5) for 0..2;
                        }
+                       $_ = join ' ', @rgb;
                }
        }