sub world {
my $self = shift;
- # ERA: 0 1 2 3 4 5 6 7
- my @worlds = qw(badlands space 0 0 jungle 0 0 twilight);
+ # ERA: 0 1 2 3 4 5 6 7
+ my @worlds = qw(badlands platform install ashworld jungle desert ice twilight);
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
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;
}
}
}
}
+=head1 scmap
+
+From replay:
+
+ old/screptomap somereplay.rep | ./scmap -m=ppm > map.ppm
+
+From map:
+
+ ./scmtomap starcraft/maps/ladder/'(4)Lost Temple.scm'
+ ./scmap -m=ppm < file000001.xxx > map.ppm
+
+=cut