[ViewVC] Diff of: cvs/cfmaps/cfmap2png

Comparing cfmaps/cfmap2png (file contents):
Revision 1.3 by root, Fri Nov 18 06:57:15 2005 UTC vs.
Revision 1.18 by root, Mon Dec 12 01:41:50 2005 UTC

 #!/opt/bin/perl
-# bugs: http://cfmaps.schmorp.de/brest/apartments/brest_town_house.html <- walls
+# cfarch2png - convert crossfire maps to png+metadata
-# whaling... icecaves... water is red?
+# Copyright (C) 2005      Marc Lehmann <gvpe@schmorp.de>
-# tower of stars: missing craters?
+#
-# http://cfmaps.schmorp.de/pup_land/raffle/raffle3_u2.html <-> yellow "doors" show as grey stone as surrounding
+# CFARCH2PNG is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with gvpe; if not, write to the Free Software
+# Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+our $VERSION = '1.21';
 use strict;
 use Storable;
 use List::Util qw(max);
          $smooth{$1} = $2 if /^(\S+)\s+(\S+)$/;
       }
       Storable::nstore \%smooth, "$path.pst";
+      utime +(stat $path)[8,9], "$path.pst";
       \%smooth
    }
 }
             s/\s+$//;
             if (/^end$/i) {
                last;
             } elsif (/^arch (\S+)$/) {
                push @{ $arc{inventory} }, $parse_block->(_name => $1);
+            } elsif (/^lore$/) {
+               while (<$fh>) {
+                  last if /^endlore\s*$/i;
+                  $arc{lore} .= $_;
+               }
             } elsif (/^msg$/) {
                while (<$fh>) {
                   last if /^endmsg\s*$/i;
                   $arc{msg} .= $_;
                }
             $more = $prev;
          } elsif (/^object (\S+)$/i) {
             my $name = $1;
             my $arc = $parse_block->(_name => $name);
+            if ($more) {
+               $more->{more} = $arc;
+            } else {
-            $arc{$name} = $arc;
+               $arc{$name} = $arc;
-            $more->{more} = $arc if $more;
+            }
             $prev = $arc;
             $more = undef;
          } elsif (/^arch (\S+)$/i) {
             push @{ $arc{arch} }, $parse_block->(_name => $1);
          }
       }
       undef $parse_block; # work around bug in perl not freeing $fh etc.
+      if ($cache) {
-      Storable::nstore \%arc, "$path.pst"
+         Storable::nstore \%arc, "$path.pst";
-         if $cache;
+         utime +(stat $path)[8,9], "$path.pst";
+      }
       \%arc
    }
 }
    my %meta;
    my ($mapx, $mapy);
-   my $map = $meta{map} = [];
+   my $map;
    for (@{ $mapa->{arch} }) {
+      my ($x, $y) = ($_->{x}, $_->{y});
       if ($_->{_name} eq "map") {
          $meta{info} = $_;
-         $mapx = $_->{width}  || $_->{x};
+         $mapx = $_->{width}  || $x;
-         $mapy = $_->{height} || $_->{y};
+         $mapy = $_->{height} || $y;
       } else {
-         push @{ $map->[$_->{x}][$_->{y}] }, $_;
+         push @{ $map->[$x][$y] }, $_;
          # arch map is unreliable w.r.t. width and height
-         $mapx = $_->{x} + 1 if $mapx <= $_->{x};
+         $mapx = $x + 1 if $mapx <= $x;
-         $mapy = $_->{y} + 1 if $mapy <= $_->{y};
+         $mapy = $y + 1 if $mapy <= $y;
          #$mapx = $a->{x} + 1, warn "$mapname: arch '$a->{_name}' outside map width at ($a->{x}|$a->{y})\n" if $mapx <= $a->{x};
          #$mapy = $a->{y} + 1, warn "$mapname: arch '$a->{_name}' outside map height at ($a->{x}|$a->{y})\n" if $mapy <= $a->{y};
       }
    }
    $meta{width}  = $mapx;
    $meta{height} = $mapy;
-   my %map_face;
    my %draw_info;
+   my %map_info;
    # first pass, gather face stacking order, border and corner info
    for my $x (0 .. $mapx - 1) {
       my $col = $map->[$x];
       for my $y (0 .. $mapy - 1) {
          my $as = $col->[$y] || [];
+         my $minsmooth = 0;
          for my $layer (0 .. $#$as) {
             my $a = $as->[$layer];
             my $o = $arch->{$a->{_name}}
                or (warn "$mapname: arch '$a->{_name}' not found at ($x|$y)\n"), next;
-            my $A = { %$o, %$a };
+            my $smoothlevel = exists $a->{smoothlevel} ? $a->{smoothlevel} : $o->{smoothlevel};
-            my $smoothlevel = $A->{smoothlevel};
+            # hack to ensure somewhat correct ordering in case of conflicting
-            my $level       = $smoothlevel   ? $smoothlevel
+            # smoothlevel/stacking order
-                            : $A->{is_floor} ? 0
+            $smoothlevel = $minsmooth + 0.01 if $minsmooth >= $smoothlevel;
-                            :                  256 + $layer;
+            $minsmooth = $smoothlevel;
+            #my $is_floor = exists $a->{is_floor}    ? $a->{is_floor}    : $o->{is_floor};
+            my $level = $smoothlevel + $layer * 256;
+            $level -= 100 * 256 if $o->{_name} eq "blocked";
             while ($o) {
+               my $face = $a->{face} || $o->{face};
-               my $pb = tile $A->{face}
+               my $pb = tile $face
-                  or (warn "$mapname: face '$A->{face}' not found for arch '$a->{_name}' at ($x|$y)\n"), last;
+                  or (warn "$mapname: face '$face' not found for arch '$a->{_name}' at ($x|$y)\n"), last;
                my $mx = $x + $o->{x};
                my $my = $y + $o->{y};
                last if 0 > $mx || $mx >= $mapx
                     || 0 > $my || $my >= $mapy;
                # this is very ugly (some tiles are 32x33 or worse)
                my $bigface = $pb->get_width >= T*2 || $pb->get_height >= T*2;
+               my $dx = $bigface ? $o->{x} : 0;
+               my $dy = $bigface ? $o->{y} : 0;
+               push @{ $map_info{$level}{$mx, $my} }, $a;
+               $draw_info{$level}{$face}{$mx, $my} |= 0x2000 | (($dx + 128) << 24) | (($dy + 128) << 16);
-               if (my $sface = $smooth->{$A->{face}}) {
+               if (my $sface = $smooth->{$face}) {
-                  $bigface and die "can't handle bigfaces with smoothing ($A->{face})\n";
+                  $bigface and die "can't handle bigfaces with smoothing ($face)\n";
                   # full tile
                   $draw_info{$smoothlevel}{$sface}{$mx    , $my    } |= 0x1000;
                   # borders
                   $draw_info{$smoothlevel}{$sface}{$mx - 1, $my + 1} |= 0x0200;
                   $draw_info{$smoothlevel}{$sface}{$mx - 1, $my - 1} |= 0x0400;
                   $draw_info{$smoothlevel}{$sface}{$mx + 1, $my - 1} |= 0x0800;
                }
-               my $dx = $bigface ? $o->{x} : 0;
-               my $dy = $bigface ? $o->{y} : 0;
-               $draw_info{$level}{$o->{face}}{$mx, $my} |= 0x2000 | (($dx + 128) << 24) | (($dy + 128) << 16);
                $o = $o->{more};
+               $level = ($layer + 1000) * 2; # put "big things" on top, no matter what
             }
          }
       }
    }
    my $map_pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, $mapx * T, $mapy * T
          or die;
-   $map_pb->fill (0x00000000);
+   $map_pb->fill (0xffffff00);
-   # second pass, render all the stuff
+   # second pass, render the map
    for my $level (sort { $a <=> $b } keys %draw_info) {
       my $v = $draw_info{$level};
       while (my ($sface, $info) = each %$v) {
          my $pb = tile $sface
             or die "no smooth face $sface\n";
             my ($x, $y) = split $;, $xy;
             next if $x < 0 || $x >= $mapx
                  || $y < 0 || $y >= $mapy;
-            # bits is 00XX XXXX YYYY YYFX cccc CCCC BBBB
+            # bits is xxxx xxxx yyyy yyyy __fn cccc CCCC bbbb
-            # X  don't draw
-            # F  full tile draw with x|y bigface displacement
+            # f  full tile draw with x|y bigface displacement
-            # c  maybe draw these corners
-            # C  do not draw these corners
+            # n  do not draw borders&corners
+            # c  draw these corners, but...
+            # C  ... not these
             # b  draw these borders
             if ($bits & 0x2000) {
                my $dx = (($bits >> 24) & 0xff) - 128;
                my $dy = (($bits >> 16) & 0xff) - 128;
             }
          }
       }
    }
+   # third pass, gather meta info
+   for my $level (sort { $a <=> $b } keys %map_info) {
+      my $info = $map_info{$level};
+         while (my ($xy, $as) = each %$info) {
+            my ($x, $y) = split $;, $xy;
+            next if $x < 0 || $x >= $mapx
+                 || $y < 0 || $y >= $mapy;
+            push @{ $meta{map}[$x][$y] }, $_ for @$as;
+         }
+   }
    ($map_pb, \%meta)
 }
 for my $file (@ARGV) {
    my $mapa = read_arch $file;
    my ($pb, $meta) = cfmap_render $mapa, $file;
-   $pb->save ("$file.png~", "png");
+   $pb->save ("$file.png~~", "png");
-   system "convert", "$file.png~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg";
+   system "convert", "$file.png~~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg";
-   system "mogrify", "-colors" => 65536, "$file.png~";
+   #system "mogrify", "-colors" => 65536, "$file.png~"; # destroys transparency
-   system "pngcrush", "-q", "-m" => 7, "-rem" => "alla", "-reduce", "$file.png~", "$file.png";
+   system "pngcrush", "-q", "-m" => 7, "-rem", "alla", "-cc", "-reduce", "$file.png~~", "$file.png~";
+#   system "pngnq <\Q$file.png~\E >\Q$file.png\E";
-   unlink "$file.png~";
+   unlink "$file.png~~";
    Storable::nstore $meta, "$file.pst";
+   utime +(stat $file)[8,9], "$file.pst";
+   utime +(stat $file)[8,9], "$file.jpg";
+   utime +(stat $file)[8,9], "$file.png~";
+   rename "$file.png~", "$file.png";
 }

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing cfmaps/cfmap2png (file contents): Revision 1.3 by root, Fri Nov 18 06:57:15 2005 UTC vs. Revision 1.18 by root, Mon Dec 12 01:41:50 2005 UTC

Diff Legend

Comparing cfmaps/cfmap2png (file contents):
Revision 1.3 by root, Fri Nov 18 06:57:15 2005 UTC vs.
Revision 1.18 by root, Mon Dec 12 01:41:50 2005 UTC