[ViewVC] Annotation of: cvs/cfmaps/cfmap2png

#!/opt/bin/perl

# cfarch2png - convert deliantra maps to png+metadata
# Copyright (C) 2005,2007,2008 Marc Lehmann <cfmaps@schmorp.de>
#
# 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

# Quoth The master himself:
#
# Object ordering is basically like this:
# top face: players or monsters.  If none on the space, object with highest
# visibility value - if equal, then top object in terms of object stacking on the map.
# middle face: Object with highest visibility (of monster/player on a space).  If
# no monster/player, then object with second highest visibility, or if all equal,
# second top object relative to map stacking.
# Bottom object: the highest object that is a floor type object. 
#
# ... I believe that anytime, but it still doesn't mention the smoothlevel
# interaction :(

our $VERSION = '2.002';

use strict;

use Deliantra;
use List::Util qw(max);

use Gtk2;

sub T (){ 32 }

Deliantra::load_archetypes;
Deliantra::load_tilecache;

sub cfmap_render($;$) {
   my ($mapa, $mapname) = @_;

   my %meta;

   my ($mapx, $mapy);

   my $map;

   for (@{ $mapa->{arch} }) {
      my ($x, $y) = ($_->{x}, $_->{y});

      if ($_->{_name} eq "map") {
         $meta{info} = $_;

         $mapx = $_->{width}  || $x;
         $mapy = $_->{height} || $y;
      } else {
         push @{ $map->[$x][$y] }, $_;

         # arch map is unreliable w.r.t. width and height
         $mapx = $x + 1 if $mapx <= $x;
         $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 %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] || [];

         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 $level = $layer * 256;

            while ($o) {
               my $face = $a->{face} || $o->{face};

               $FACE{$face}
                  or (warn "$mapname: face '$face' not found for arch '$a->{_name}' at ($x|$y)\n"), last;

               my $idx = $FACE{$face}{idx};

               my $mx = $x + $o->{x};
               my $my = $y + $o->{y};

               last if 0 > $mx || $mx >= $mapx
                    || 0 > $my || $my >= $mapy;

               push @{ $map_info{$level}{$mx, $my} }, $a;

               $draw_info{$level}{$idx}{$mx, $my} |= 0x2000;

               if (0) { # disable smoothing for the time being
               if (my $sface = $FACEDATA{faceinfo}{$face}{smooth}) {
                  $FACE{$sface}
                     or (warn "$mapname: smoothface '$sface' not found for arch '$a->{_name}' at ($x|$y)\n"), last;
                  my $idx = $FACE{$sface}{idx};
                  my $level = $layer * 256 + $FACEDATA{faceinfo}{$face}{smoothlevel};

                  # full tile
                  $draw_info{$level}{$idx}{$mx    , $my    } |= 0x1000;

                  # borders
                  $draw_info{$level}{$idx}{$mx + 1, $my    } |= 0x0091;
                  $draw_info{$level}{$idx}{$mx    , $my + 1} |= 0x0032;
                  $draw_info{$level}{$idx}{$mx - 1, $my    } |= 0x0064;
                  $draw_info{$level}{$idx}{$mx    , $my - 1} |= 0x00c8;

                  # corners
                  $draw_info{$level}{$idx}{$mx + 1, $my + 1} |= 0x0100;
                  $draw_info{$level}{$idx}{$mx - 1, $my + 1} |= 0x0200;
                  $draw_info{$level}{$idx}{$mx - 1, $my - 1} |= 0x0400;
                  $draw_info{$level}{$idx}{$mx + 1, $my - 1} |= 0x0800;
               }
               }

               $o = $o->{more};
            }
         }
      }
   }

   my $map_pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, $mapx * T, $mapy * T
      or die;
   $map_pb->fill (0xffffff00);

   # second pass, render the map
   for my $level (sort { $a <=> $b } keys %draw_info) {
      my $v = $draw_info{$level};
      while (my ($face, $info) = each %$v) {
         while (my ($xy, $bits) = each %$info) {
            my ($x, $y) = split $;, $xy;

            next if $x < 0 || $x >= $mapx
                 || $y < 0 || $y >= $mapy;

            # bits is __fn cccc CCCC bbbb
            # f  full tile draw with x|y bigface displacement
            # n  do not draw borders&corners
            # c  draw these corners, but...
            # C  ... not these
            # b  draw these borders

            if ($bits & 0x2000) {
               my $ix =     $face % CACHESTRIDE;
               my $iy = int $face / CACHESTRIDE;

               $TILE->composite ($map_pb,
                  $x * T, $y * T,
                  T, T,
                  ($x - $ix) * T, ($y - $iy) * T, 1, 1,
                  "nearest",
                  255
               );
            }

            unless ($bits & 0x1000) {
               my $border = $face + ($bits & 0xf);
               my $bx =     $border % CACHESTRIDE;
               my $by = int $border / CACHESTRIDE;
               $TILE->composite ($map_pb,
                  $x * T, $y * T,
                  T, T,
                  ($x - $bx) * T, ($y - $by) * T, 1, 1,
                  "nearest",
                  255
               ) if $border;

               my $corner = $face + (($bits >> 8) & ~($bits >> 4) & 0xf);
               my $cx =     $corner % CACHESTRIDE;
               my $cy = int $corner / CACHESTRIDE;
               $TILE->composite ($map_pb,
                  $x * T, $y * T,
                  T, T,
                  ($x - $cx) * T, ($y - $cy) * T, 1, 1,
                  "nearest",
                  255
               ) if $corner;
            }
         }
      }
   }

   # 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;
   $file =~ s/\.map$//;
   my ($pb, $meta) = cfmap_render $mapa, $file;
   $pb->save ("$file.png~~", "png");
   system "gm", "convert", "$file.png~~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg";
   #system "mogrify", "-colors" => 65536, "$file.png~"; # destroys transparency
   system "optipng", "-q", "-out", "$file.png~", "$file.png~~";
#   system "pngnq <\Q$file.png~\E >\Q$file.png\E";
   unlink "$file.png~~";
   utime +(stat $file)[8,9], "$file.jpg";
   utime +(stat $file)[8,9], "$file.png~";
   rename "$file.png~", "$file.png";
}


Revision:	1.25
Committed:	Sun Jan 6 21:12:00 2008 UTC (16 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.24:	+6 -6 lines
Log Message:	deliantrify
#	User	Rev	Content
1	root	1.1	#!/opt/bin/perl
2
3	root	1.25	# cfarch2png - convert deliantra maps to png+metadata
4			# Copyright (C) 2005,2007,2008 Marc Lehmann <cfmaps@schmorp.de>
5	root	1.8	#
6			# CFARCH2PNG is free software; you can redistribute it and/or modify
7			# it under the terms of the GNU General Public License as published by
8			# the Free Software Foundation; either version 2 of the License, or
9			# (at your option) any later version.
10			#
11			# This program is distributed in the hope that it will be useful,
12			# but WITHOUT ANY WARRANTY; without even the implied warranty of
13			# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14			# GNU General Public License for more details.
15			#
16			# You should have received a copy of the GNU General Public License
17			# along with gvpe; if not, write to the Free Software
18			# Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19
20	root	1.19	# Quoth The master himself:
21			#
22			# Object ordering is basically like this:
23			# top face: players or monsters. If none on the space, object with highest
24			# visibility value - if equal, then top object in terms of object stacking on the map.
25			# middle face: Object with highest visibility (of monster/player on a space). If
26			# no monster/player, then object with second highest visibility, or if all equal,
27			# second top object relative to map stacking.
28			# Bottom object: the highest object that is a floor type object.
29			#
30	root	1.23	# ... I believe that anytime, but it still doesn't mention the smoothlevel
31	root	1.19	# interaction :(
32
33	root	1.25	our $VERSION = '2.002';
34	root	1.9
35	root	1.1	use strict;
36
37	root	1.25	use Deliantra;
38	root	1.1	use List::Util qw(max);
39
40			use Gtk2;
41
42			sub T (){ 32 }
43
44	root	1.25	Deliantra::load_archetypes;
45			Deliantra::load_tilecache;
46	root	1.1
47			sub cfmap_render($;$) {
48			my ($mapa, $mapname) = @_;
49
50			my %meta;
51
52			my ($mapx, $mapy);
53
54	root	1.10	my $map;
55	root	1.1
56			for (@{ $mapa->{arch} }) {
57	root	1.10	my ($x, $y) = ($_->{x}, $_->{y});
58
59	root	1.1	if ($_->{_name} eq "map") {
60			$meta{info} = $_;
61
62	root	1.10	$mapx = $_->{width} \|\| $x;
63			$mapy = $_->{height} \|\| $y;
64	root	1.1	} else {
65	root	1.10	push @{ $map->[$x][$y] }, $_;
66	root	1.1
67			# arch map is unreliable w.r.t. width and height
68	root	1.10	$mapx = $x + 1 if $mapx <= $x;
69			$mapy = $y + 1 if $mapy <= $y;
70	root	1.1	#$mapx = $a->{x} + 1, warn "$mapname: arch '$a->{_name}' outside map width at ($a->{x}\|$a->{y})\n" if $mapx <= $a->{x};
71			#$mapy = $a->{y} + 1, warn "$mapname: arch '$a->{_name}' outside map height at ($a->{x}\|$a->{y})\n" if $mapy <= $a->{y};
72			}
73			}
74
75			$meta{width} = $mapx;
76			$meta{height} = $mapy;
77
78			my %draw_info;
79	root	1.10	my %map_info;
80	root	1.1
81			# first pass, gather face stacking order, border and corner info
82			for my $x (0 .. $mapx - 1) {
83			my $col = $map->[$x];
84			for my $y (0 .. $mapy - 1) {
85			my $as = $col->[$y] \|\| [];
86	root	1.16
87	root	1.1	for my $layer (0 .. $#$as) {
88			my $a = $as->[$layer];
89
90	root	1.23	my $o = $ARCH{$a->{_name}}
91	root	1.1	or (warn "$mapname: arch '$a->{_name}' not found at ($x\|$y)\n"), next;
92
93	root	1.23	my $level = $layer * 256;
94	root	1.1
95	root	1.5	while ($o) {
96			my $face = $a->{face} \|\| $o->{face};
97	root	1.1
98	root	1.23	$FACE{$face}
99	root	1.5	or (warn "$mapname: face '$face' not found for arch '$a->{_name}' at ($x\|$y)\n"), last;
100	root	1.1
101	root	1.23	my $idx = $FACE{$face}{idx};
102
103	root	1.1	my $mx = $x + $o->{x};
104			my $my = $y + $o->{y};
105
106	root	1.2	last if 0 > $mx \|\| $mx >= $mapx
107			\|\| 0 > $my \|\| $my >= $mapy;
108	root	1.1
109	root	1.10	push @{ $map_info{$level}{$mx, $my} }, $a;
110
111	root	1.23	$draw_info{$level}{$idx}{$mx, $my} \|= 0x2000;
112	root	1.10
113	root	1.23	if (0) { # disable smoothing for the time being
114			if (my $sface = $FACEDATA{faceinfo}{$face}{smooth}) {
115			$FACE{$sface}
116			or (warn "$mapname: smoothface '$sface' not found for arch '$a->{_name}' at ($x\|$y)\n"), last;
117			my $idx = $FACE{$sface}{idx};
118			my $level = $layer * 256 + $FACEDATA{faceinfo}{$face}{smoothlevel};
119	root	1.1
120			# full tile
121	root	1.23	$draw_info{$level}{$idx}{$mx , $my } \|= 0x1000;
122	root	1.1
123			# borders
124	root	1.23	$draw_info{$level}{$idx}{$mx + 1, $my } \|= 0x0091;
125			$draw_info{$level}{$idx}{$mx , $my + 1} \|= 0x0032;
126			$draw_info{$level}{$idx}{$mx - 1, $my } \|= 0x0064;
127			$draw_info{$level}{$idx}{$mx , $my - 1} \|= 0x00c8;
128	root	1.1
129			# corners
130	root	1.23	$draw_info{$level}{$idx}{$mx + 1, $my + 1} \|= 0x0100;
131			$draw_info{$level}{$idx}{$mx - 1, $my + 1} \|= 0x0200;
132			$draw_info{$level}{$idx}{$mx - 1, $my - 1} \|= 0x0400;
133			$draw_info{$level}{$idx}{$mx + 1, $my - 1} \|= 0x0800;
134			}
135	root	1.1	}
136
137			$o = $o->{more};
138			}
139			}
140			}
141			}
142
143			my $map_pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, $mapx * T, $mapy * T
144	root	1.23	or die;
145	root	1.7	$map_pb->fill (0xffffff00);
146	root	1.1
147	root	1.10	# second pass, render the map
148	root	1.1	for my $level (sort { $a <=> $b } keys %draw_info) {
149			my $v = $draw_info{$level};
150	root	1.23	while (my ($face, $info) = each %$v) {
151	root	1.1	while (my ($xy, $bits) = each %$info) {
152			my ($x, $y) = split $;, $xy;
153
154			next if $x < 0 \|\| $x >= $mapx
155			\|\| $y < 0 \|\| $y >= $mapy;
156
157	root	1.23	# bits is __fn cccc CCCC bbbb
158	root	1.13	# f full tile draw with x\|y bigface displacement
159			# n do not draw borders&corners
160			# c draw these corners, but...
161			# C ... not these
162	root	1.1	# b draw these borders
163
164			if ($bits & 0x2000) {
165	root	1.23	my $ix = $face % CACHESTRIDE;
166			my $iy = int $face / CACHESTRIDE;
167	root	1.1
168	root	1.23	$TILE->composite ($map_pb,
169	root	1.1	$x * T, $y * T,
170			T, T,
171	root	1.23	($x - $ix) * T, ($y - $iy) * T, 1, 1,
172	root	1.1	"nearest",
173			255
174			);
175			}
176
177			unless ($bits & 0x1000) {
178	root	1.23	my $border = $face + ($bits & 0xf);
179			my $bx = $border % CACHESTRIDE;
180			my $by = int $border / CACHESTRIDE;
181			$TILE->composite ($map_pb,
182	root	1.1	$x * T, $y * T,
183			T, T,
184	root	1.23	($x - $bx) * T, ($y - $by) * T, 1, 1,
185	root	1.1	"nearest",
186			255
187			) if $border;
188
189	root	1.23	my $corner = $face + (($bits >> 8) & ~($bits >> 4) & 0xf);
190			my $cx = $corner % CACHESTRIDE;
191			my $cy = int $corner / CACHESTRIDE;
192			$TILE->composite ($map_pb,
193	root	1.1	$x * T, $y * T,
194			T, T,
195	root	1.23	($x - $cx) * T, ($y - $cy) * T, 1, 1,
196	root	1.1	"nearest",
197			255
198			) if $corner;
199			}
200			}
201			}
202			}
203
204	root	1.10	# third pass, gather meta info
205			for my $level (sort { $a <=> $b } keys %map_info) {
206			my $info = $map_info{$level};
207
208			while (my ($xy, $as) = each %$info) {
209			my ($x, $y) = split $;, $xy;
210
211			next if $x < 0 \|\| $x >= $mapx
212			\|\| $y < 0 \|\| $y >= $mapy;
213
214			push @{ $meta{map}[$x][$y] }, $_ for @$as;
215			}
216			}
217
218	root	1.1	($map_pb, \%meta)
219			}
220
221			for my $file (@ARGV) {
222			my $mapa = read_arch $file;
223	root	1.21	$file =~ s/\.map$//;
224	root	1.1	my ($pb, $meta) = cfmap_render $mapa, $file;
225	root	1.16	$pb->save ("$file.png~~", "png");
226	root	1.20	system "gm", "convert", "$file.png~~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg";
227	root	1.6	#system "mogrify", "-colors" => 65536, "$file.png~"; # destroys transparency
228	root	1.23	system "optipng", "-q", "-out", "$file.png~", "$file.png~~";
229	root	1.15	# system "pngnq <\Q$file.png~\E >\Q$file.png\E";
230	root	1.16	unlink "$file.png~~";
231	root	1.18	utime +(stat $file)[8,9], "$file.jpg";
232	root	1.16	utime +(stat $file)[8,9], "$file.png~";
233			rename "$file.png~", "$file.png";
234	root	1.1	}
235
236
237
238
239
240