XXX: scmap: literal map image
authorMischa POSLAWSKY <perl@shiar.org>
Thu, 12 Feb 2009 02:32:56 +0000 (03:32 +0100)
committerMischa POSLAWSKY <perl@shiar.org>
Thu, 12 Feb 2009 02:33:21 +0000 (03:33 +0100)
scmap

diff --git a/scmap b/scmap
index 06b5ebecb1b1bd3d2a790d642097435670ac5121..e5a2798665d04d132b23f200632b14902b88005b 100755 (executable)
--- a/scmap
+++ b/scmap
@@ -69,6 +69,9 @@ if (defined $mapsep{$SHOWMAP}) {
                : $map->tiles;#_parsed;
 
        if ($SHOWMAP eq "ppm") {
+               use Imager;
+               my $img = Imager->new(xsize => $map->width * 4, ysize => $map->width * 4);
+
                use Data::StarCraft::Tileset;
                my $era = world($map);
                if ($era eq '?') {
@@ -78,33 +81,45 @@ if (defined $mapsep{$SHOWMAP}) {
                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};
+               my ($x, $y) = (0, 0);
                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} & 16) {
-                               $rgb[1] += 48;  # green for ramps
-                       }
-                       elsif ($tile->{walk} & 8) {
-                               $rgb[0] = 255;  # red for obstructions
-                       }
-                       elsif (($tile->{walk} & 1) == 0) {
-#                              $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;
+                       # 128x128 ~ 6s
+#                      my $tile = $tileset->tileavg($_);
+#                      $img->setpixel(x => $x, y => $y, color => $tile->{col});
+
+                       # 512x512 ~ 7s
+                       my $tile = $tileset->tile($_);
+                       $img->setscanline(
+                               x => $x*4, y => $y*4 + $_, pixels => pack('(CCCx)*',
+                                       map { @$_ } @{ $tile->{subcol} }[$_*4 .. $_*4 + 3]
+                               ),
+                       ) for 0..3;
+
+                       # 4096x4096 ~ 75s
+#                      my $tile = $tileset->sprite($tileset->{map}->[$_]);
+#                      $img->setscanline(
+#                              x => $x*32, y => $y*32 + $_, pixels => pack('(CCCx)*',
+#                                      map { @{ $tileset->{palette}->[$_] } } @$tile[$_*32 .. $_*32+31]
+#                              ),
+#                      ) for 0..31;
+               }
+               continue {
+                       $x++;
+                       if ($x >= $map->width) {
+                               $y++;
+                               $x = 0;
                        }
-                       $_ = join ' ', @rgb;
                }
+
+               $img->write(fd => fileno(STDOUT), type => 'png')
+                       or die 'Cannot output image: ', $img->errstr;
        }
 
+=cut
        while (my @line = splice @$tiles, 0, $map->width) {
                printf "%s\n", join $MAPCHARSEP, @line;
        }
+=cut
 }
 
 =head1 scmap