1 | #!/opt/bin/perl |
1 | #!/opt/bin/perl |
2 | |
2 | |
3 | # cfarch2png - convert deliantra maps to png+metadata |
3 | # cfmap2png - convert deliantra maps to png+metadata |
4 | # Copyright (C) 2005,2007,2008 Marc Lehmann <cfmaps@schmorp.de> |
4 | # Copyright (C) 2005,2007,2008,2009 Marc Lehmann <cfmaps@schmorp.de> |
5 | # |
5 | # |
6 | # CFARCH2PNG is free software; you can redistribute it and/or modify |
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 |
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 |
8 | # the Free Software Foundation; either version 2 of the License, or |
9 | # (at your option) any later version. |
9 | # (at your option) any later version. |
… | |
… | |
28 | # Bottom object: the highest object that is a floor type object. |
28 | # Bottom object: the highest object that is a floor type object. |
29 | # |
29 | # |
30 | # ... I believe that anytime, but it still doesn't mention the smoothlevel |
30 | # ... I believe that anytime, but it still doesn't mention the smoothlevel |
31 | # interaction :( |
31 | # interaction :( |
32 | |
32 | |
33 | our $VERSION = '2.002'; |
33 | our $VERSION = '2.012'; |
34 | |
34 | |
35 | use strict; |
35 | use strict; |
36 | |
36 | |
37 | use Deliantra; |
37 | use Deliantra; |
38 | use List::Util qw(max); |
38 | use List::Util qw(max); |
… | |
… | |
92 | |
92 | |
93 | my $level = $layer * 256; |
93 | my $level = $layer * 256; |
94 | |
94 | |
95 | while ($o) { |
95 | while ($o) { |
96 | my $face = $a->{face} || $o->{face}; |
96 | my $face = $a->{face} || $o->{face}; |
|
|
97 | |
|
|
98 | $FACE{$face} |
|
|
99 | or $face =~ s/\.1(\d\d)$/.x$1/; |
97 | |
100 | |
98 | $FACE{$face} |
101 | $FACE{$face} |
99 | or (warn "$mapname: face '$face' not found for arch '$a->{_name}' at ($x|$y)\n"), last; |
102 | or (warn "$mapname: face '$face' not found for arch '$a->{_name}' at ($x|$y)\n"), last; |
100 | |
103 | |
101 | my $idx = $FACE{$face}{idx}; |
104 | my $idx = $FACE{$face}{idx}; |
… | |
… | |
217 | |
220 | |
218 | ($map_pb, \%meta) |
221 | ($map_pb, \%meta) |
219 | } |
222 | } |
220 | |
223 | |
221 | for my $file (@ARGV) { |
224 | for my $file (@ARGV) { |
222 | my $mapa = read_arch $file; |
225 | my $stderr; |
|
|
226 | $SIG{__WARN__} = sub { |
|
|
227 | $stderr .= $_[0]; |
|
|
228 | print STDERR $_[0]; |
|
|
229 | }; |
|
|
230 | |
223 | $file =~ s/\.map$//; |
231 | $file =~ s/\.map$//; |
|
|
232 | |
|
|
233 | eval { |
|
|
234 | my $mapa = read_arch "$file.map"; |
224 | my ($pb, $meta) = cfmap_render $mapa, $file; |
235 | my ($pb, $meta) = cfmap_render $mapa, $file; |
225 | $pb->save ("$file.png~~", "png"); |
236 | $pb->save ("$file.png~~", "png"); |
226 | system "gm", "convert", "$file.png~~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg"; |
237 | system "gm", "convert", "$file.png~~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg"; |
227 | #system "mogrify", "-colors" => 65536, "$file.png~"; # destroys transparency |
238 | #system "mogrify", "-colors" => 65536, "$file.png~"; # destroys transparency |
228 | system "optipng", "-q", "-out", "$file.png~", "$file.png~~"; |
239 | system "optipng", "-q", "-out", "$file.png~", "$file.png~~"; |
229 | # system "pngnq <\Q$file.png~\E >\Q$file.png\E"; |
240 | # system "pngnq <\Q$file.png~\E >\Q$file.png\E"; |
230 | unlink "$file.png~~"; |
241 | unlink "$file.png~~"; |
231 | utime +(stat $file)[8,9], "$file.jpg"; |
242 | utime +(stat "$file.map")[8,9], "$file.jpg" or die "$file.jpg: $!"; |
232 | utime +(stat $file)[8,9], "$file.png~"; |
243 | utime +(stat "$file.map")[8,9], "$file.png~" or die "$file.png~: $!"; |
233 | rename "$file.png~", "$file.png"; |
244 | rename "$file.png~", "$file.png"; |
|
|
245 | 1 |
|
|
246 | } or $stderr .= $@; |
|
|
247 | |
|
|
248 | if (length $stderr) { |
|
|
249 | open my $fh, ">$file.png.err~" |
|
|
250 | or die "$file.png.err~: $!"; |
|
|
251 | syswrite $fh, $stderr; |
|
|
252 | close $fh; |
|
|
253 | rename "$file.png.err~", "$file.png.err"; |
|
|
254 | } else { |
|
|
255 | unlink "$file.png.err"; |
|
|
256 | } |
234 | } |
257 | } |
235 | |
258 | |
236 | |
259 | |
237 | |
260 | |
238 | |
261 | |