ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cfmaps/cfmap2png
(Generate patch)

Comparing cfmaps/cfmap2png (file contents):
Revision 1.2 by root, Thu Nov 17 12:15:19 2005 UTC vs.
Revision 1.6 by root, Fri Nov 18 12:50:24 2005 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3# bugs: http://cfmaps.schmorp.de/brest/apartments/brest_town_house.html <- walls
4# whaling... icecaves... water is red?
5# tower of stars: missing craters? 3# tower of stars: missing craters?
6# http://cfmaps.schmorp.de/pup_land/raffle/raffle3_u2.html <-> yellow "doors" show as grey stone as surrounding
7 4
8use strict; 5use strict;
9 6
10use Storable; 7use Storable;
11use List::Util qw(max); 8use List::Util qw(max);
12 9
13use Gtk2; 10use Gtk2;
11
12our $VERSION = '1.0';
14 13
15#init Gtk2::Gdk; 14#init Gtk2::Gdk;
16 15
17my $LIB = $ENV{CROSSFIRE_LIBDIR} 16my $LIB = $ENV{CROSSFIRE_LIBDIR}
18 or die "\$CROSSFIRE_LIBDIR must be set\n"; 17 or die "\$CROSSFIRE_LIBDIR must be set\n";
85 while (<$fh>) { 84 while (<$fh>) {
86 s/\s+$//; 85 s/\s+$//;
87 if (/^end$/i) { 86 if (/^end$/i) {
88 last; 87 last;
89 } elsif (/^arch (\S+)$/) { 88 } elsif (/^arch (\S+)$/) {
90 push @{ $arc{subarch} }, $parse_block->(_name => $1); 89 push @{ $arc{inventory} }, $parse_block->(_name => $1);
90 } elsif (/^lore$/) {
91 while (<$fh>) {
92 last if /^endlore\s*$/i;
93 $arc{lore} .= $_;
94 }
91 } elsif (/^msg$/) { 95 } elsif (/^msg$/) {
92 while (<$fh>) { 96 while (<$fh>) {
93 last if /^endmsg\s*$/i; 97 last if /^endmsg\s*$/i;
94 $arc{msg} .= $_; 98 $arc{msg} .= $_;
95 } 99 }
111 $more = $prev; 115 $more = $prev;
112 } elsif (/^object (\S+)$/i) { 116 } elsif (/^object (\S+)$/i) {
113 my $name = $1; 117 my $name = $1;
114 my $arc = $parse_block->(_name => $name); 118 my $arc = $parse_block->(_name => $name);
115 119
120 if ($more) {
121 $more->{more} = $arc;
122 } else {
116 $arc{$name} = $arc; 123 $arc{$name} = $arc;
117 $more->{more} = $arc if $more; 124 }
118 125
119 $prev = $arc; 126 $prev = $arc;
120 $more = undef; 127 $more = undef;
121 } elsif (/^arch (\S+)$/i) { 128 } elsif (/^arch (\S+)$/i) {
122 push @{ $arc{arch} }, $parse_block->(_name => $1); 129 push @{ $arc{arch} }, $parse_block->(_name => $1);
188 } 195 }
189 196
190 $meta{width} = $mapx; 197 $meta{width} = $mapx;
191 $meta{height} = $mapy; 198 $meta{height} = $mapy;
192 199
193 my %map_face;
194 my %draw_info; 200 my %draw_info;
195
196 my $OBJ_LEVEL = 2**32; # higher than any valid (or in-use) smooth_level
197 201
198 # first pass, gather face stacking order, border and corner info 202 # first pass, gather face stacking order, border and corner info
199 for my $x (0 .. $mapx - 1) { 203 for my $x (0 .. $mapx - 1) {
200 my $col = $map->[$x]; 204 my $col = $map->[$x];
201 for my $y (0 .. $mapy - 1) { 205 for my $y (0 .. $mapy - 1) {
202 my $as = $col->[$y] || []; 206 my $as = $col->[$y] || [];
203 207
204 for my $layer (0 .. $#$as) { 208 for my $layer (0 .. $#$as) {
205 my $a = $as->[$layer]; 209 my $a = $as->[$layer];
206 210
207 my $o = $a;
208 delete $o->{x};
209 delete $o->{y};
210
211 my $os = $arch->{$a->{_name}} 211 my $o = $arch->{$a->{_name}}
212 or (warn "$mapname: arch '$a->{_name}' not found at ($x|$y)\n"), next; 212 or (warn "$mapname: arch '$a->{_name}' not found at ($x|$y)\n"), next;
213 213
214 for (1..10) { 214 my $smoothlevel = exists $a->{smoothlevel} ? $a->{smoothlevel} : $o->{smoothlevel};
215 $o = { %$os, %$o }; 215 my $is_floor = exists $a->{is_floor} ? $a->{is_floor} : $o->{is_floor};
216 last unless exists $os->{other_arch};
217 $o = $arch->{$os->{other_arch}};
218 }
219
220 my $smooth_level = $o->{smoothlevel};
221 my $level = $smooth_level ? $smooth_level 216 my $level = $smoothlevel ? $smoothlevel
222 : $o->{is_floor} ? 0 217 : $is_floor ? 0
223 : $OBJ_LEVEL + $layer; 218 : 256 + $layer;
224 219
225 while ($o) { 220 while ($o) {
221 my $face = $a->{face} || $o->{face};
222
226 my $pb = tile $o->{face} 223 my $pb = tile $face
227 or (warn "$mapname: face '$o->{face}' not found for arch '$a->{_name}' at ($x|$y)\n"), last; 224 or (warn "$mapname: face '$face' not found for arch '$a->{_name}' at ($x|$y)\n"), last;
228 225
229 my $mx = $x + $o->{x}; 226 my $mx = $x + $o->{x};
230 my $my = $y + $o->{y}; 227 my $my = $y + $o->{y};
231 228
232 last if 0 > $mx || $mx >= $mapx 229 last if 0 > $mx || $mx >= $mapx
233 || 0 > $my || $my >= $mapy; 230 || 0 > $my || $my >= $mapy;
234 231
235 # this is very ugly (some tiles are 32x33 or worse) 232 # this is very ugly (some tiles are 32x33 or worse)
236 my $bigface = $pb->get_width >= T*2 || $pb->get_height >= T*2; 233 my $bigface = $pb->get_width >= T*2 || $pb->get_height >= T*2;
237 234
238 if (my $sface = $smooth->{$o->{face}}) { 235 if (my $sface = $smooth->{$face}) {
239 $bigface and die "can't handle big faces with smoothing ($o->{face})\n"; 236 $bigface and die "can't handle bigfaces with smoothing ($face)\n";
240 237
241 # full tile 238 # full tile
242 $draw_info{$smooth_level}{$sface}{$mx , $my } |= 0x1000; 239 $draw_info{$smoothlevel}{$sface}{$mx , $my } |= 0x1000;
243 240
244 # borders 241 # borders
245 $draw_info{$smooth_level}{$sface}{$mx + 1, $my } |= 0x0031; 242 $draw_info{$smoothlevel}{$sface}{$mx + 1, $my } |= 0x0031;
246 $draw_info{$smooth_level}{$sface}{$mx , $my + 1} |= 0x0092; 243 $draw_info{$smoothlevel}{$sface}{$mx , $my + 1} |= 0x0092;
247 $draw_info{$smooth_level}{$sface}{$mx - 1, $my } |= 0x0064; 244 $draw_info{$smoothlevel}{$sface}{$mx - 1, $my } |= 0x0064;
248 $draw_info{$smooth_level}{$sface}{$mx , $my - 1} |= 0x00c8; 245 $draw_info{$smoothlevel}{$sface}{$mx , $my - 1} |= 0x00c8;
249 246
250 # corners 247 # corners
251 $draw_info{$smooth_level}{$sface}{$mx + 1, $my + 1} |= 0x0100; 248 $draw_info{$smoothlevel}{$sface}{$mx + 1, $my + 1} |= 0x0100;
252 $draw_info{$smooth_level}{$sface}{$mx - 1, $my + 1} |= 0x0200; 249 $draw_info{$smoothlevel}{$sface}{$mx - 1, $my + 1} |= 0x0200;
253 $draw_info{$smooth_level}{$sface}{$mx - 1, $my - 1} |= 0x0400; 250 $draw_info{$smoothlevel}{$sface}{$mx - 1, $my - 1} |= 0x0400;
254 $draw_info{$smooth_level}{$sface}{$mx + 1, $my - 1} |= 0x0800; 251 $draw_info{$smoothlevel}{$sface}{$mx + 1, $my - 1} |= 0x0800;
255 } else {
256 $smooth_level = 0;
257 } 252 }
258 253
259 my $dx = $bigface ? $o->{x} : 0; 254 my $dx = $bigface ? $o->{x} : 0;
260 my $dy = $bigface ? $o->{y} : 0; 255 my $dy = $bigface ? $o->{y} : 0;
261 256
262 $draw_info{$level}{$o->{face}}{$mx, $my} |= 0x2000 | (($dx + 128) << 24) | (($dy + 128) << 16); 257 $draw_info{$level}{$face}{$mx, $my} |= 0x2000 | (($dx + 128) << 24) | (($dy + 128) << 16);
263 258
264 $o = $o->{more}; 259 $o = $o->{more};
265 } 260 }
266 } 261 }
267 } 262 }
332} 327}
333 328
334for my $file (@ARGV) { 329for my $file (@ARGV) {
335 my $mapa = read_arch $file; 330 my $mapa = read_arch $file;
336 my ($pb, $meta) = cfmap_render $mapa, $file; 331 my ($pb, $meta) = cfmap_render $mapa, $file;
337 $pb->save ("$file.png", "png"); 332 $pb->save ("$file.png~", "png");
333 system "convert", "$file.png~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg";
334 #system "mogrify", "-colors" => 65536, "$file.png~"; # destroys transparency
335 system "pngcrush", "-q", "-m" => 7, "-rem", "alla", "-cc", "-reduce", "$file.png~", "$file.png";
336 unlink "$file.png~";
338 Storable::nstore $meta, "$file.pst"; 337 Storable::nstore $meta, "$file.pst";
339} 338}
340 339
341 340
342 341

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines