| 1 | #!@PERL@ |
1 | #!@PERL@ |
| 2 | |
2 | |
| 3 | # |
3 | # |
| 4 | # This file is part of Deliantra, the Roguelike Realtime MMORPG. |
4 | # This file is part of Deliantra, the Roguelike Realtime MMORPG. |
| 5 | # |
5 | # |
| 6 | # Copyright (©) 2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team |
6 | # Copyright (©) 2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team |
| 7 | # |
7 | # |
| 8 | # Deliantra is free software: you can redistribute it and/or modify it under |
8 | # Deliantra is free software: you can redistribute it and/or modify it under |
| 9 | # the terms of the Affero GNU General Public License as published by the |
9 | # the terms of the Affero GNU General Public License as published by the |
| 10 | # Free Software Foundation, either version 3 of the License, or (at your |
10 | # Free Software Foundation, either version 3 of the License, or (at your |
| 11 | # option) any later version. |
11 | # option) any later version. |
| 12 | # |
12 | # |
| 13 | # This program is distributed in the hope that it will be useful, |
13 | # This program is distributed in the hope that it will be useful, |
| 14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 16 | # GNU General Public License for more details. |
16 | # GNU General Public License for more details. |
| 17 | # |
17 | # |
| 18 | # You should have received a copy of the Affero GNU General Public License |
18 | # You should have received a copy of the Affero GNU General Public License |
| 19 | # and the GNU General Public License along with this program. If not, see |
19 | # and the GNU General Public License along with this program. If not, see |
| 20 | # <http://www.gnu.org/licenses/>. |
20 | # <http://www.gnu.org/licenses/>. |
| 21 | # |
21 | # |
| 22 | # The authors can be reached via e-mail to <support@deliantra.net> |
22 | # The authors can be reached via e-mail to <support@deliantra.net> |
| 23 | # |
23 | # |
| 24 | |
24 | |
| 25 | use common::sense; |
25 | use common::sense; |
| 26 | |
26 | |
| … | |
… | |
| 221 | our $c_arc = new Coro::Channel; |
221 | our $c_arc = new Coro::Channel; |
| 222 | our $c_any = new Coro::Channel; |
222 | our $c_any = new Coro::Channel; |
| 223 | |
223 | |
| 224 | our @c_png; |
224 | our @c_png; |
| 225 | |
225 | |
|
|
226 | # texture catalog size, in 64x64 tiles |
|
|
227 | sub TC_W() { 1024 / 64 } |
|
|
228 | sub TC_H() { 1024 / 64 } |
|
|
229 | |
|
|
230 | our @TC = ([]); # texture catalogs |
|
|
231 | |
| 226 | sub commit_png($$$$) { |
232 | sub commit_png($$$$$$) { |
| 227 | my ($stem, $name, $data, $T) = @_; |
233 | my ($stem, $name, $data, $T, $w, $h) = @_; |
| 228 | |
234 | |
| 229 | $FACEINFO{$name}{"stem"} = substr $stem, 1 + length $PATH; |
235 | $FACEINFO{$name}{stem} = substr $stem, 1 + length $PATH; |
| 230 | $FACEINFO{$name}{"data$T"} = $data; |
236 | $FACEINFO{$name}{"data$T"} = $data; |
|
|
237 | $FACEINFO{$name}{w} = $w; |
|
|
238 | $FACEINFO{$name}{h} = $h; |
| 231 | } |
239 | } |
| 232 | |
240 | |
| 233 | sub process_png { |
241 | sub process_png { |
| 234 | while (@c_png) { |
242 | while (@c_png) { |
| 235 | my ($path, $delete) = @{pop @c_png}; |
243 | my ($path, $delete) = @{pop @c_png}; |
| … | |
… | |
| 347 | $x * ($w - 8) + 4, |
355 | $x * ($w - 8) + 4, |
| 348 | $y * ($h - 8) + 4; |
356 | $y * ($h - 8) + 4; |
| 349 | } |
357 | } |
| 350 | } |
358 | } |
| 351 | |
359 | |
| 352 | system "convert -depth 8 $SRC rgba:-" |
360 | system "$CONVERT -depth 8 $SRC rgba:-" |
| 353 | . "| $exec_prefix/bin/cfhq2xa $w $h 0" |
361 | . "| $exec_prefix/bin/cfhq2xa $w $h 0" |
| 354 | . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $CROP $QUANTIZE -quality 00 png32:\Q$other\E~" |
362 | . "| $CONVERT -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $CROP $QUANTIZE -quality 00 png32:\Q$other\E~" |
| 355 | and die "convert/cfhq2xa pipeline error: status $? ($!)"; |
363 | and die "convert/cfhq2xa pipeline error: status $? ($!)"; |
| 356 | optipng "$other~"; |
364 | optipng "$other~"; |
| 357 | rename "$other~", $other; |
365 | rename "$other~", $other; |
| 358 | }; |
366 | }; |
| 359 | }; |
367 | }; |
| … | |
… | |
| 365 | if (0 > aio_stat "$stem.32x32.png") { |
373 | if (0 > aio_stat "$stem.32x32.png") { |
| 366 | my $other = "$stem.32x32.png~"; |
374 | my $other = "$stem.32x32.png~"; |
| 367 | |
375 | |
| 368 | make_file $path, $other, sub { |
376 | make_file $path, $other, sub { |
| 369 | fork_exec { |
377 | fork_exec { |
| 370 | system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; |
378 | system "$CONVERT png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; |
| 371 | optipng "$other~"; |
379 | optipng "$other~"; |
| 372 | |
380 | |
| 373 | # reduce smoothfaces >10000 bytes |
381 | # reduce smoothfaces >10000 bytes |
| 374 | # obsolete, no longer required |
382 | # obsolete, no longer required |
| 375 | if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) { |
383 | if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) { |
| … | |
… | |
| 445 | warn "ERROR: facename $type:$face contains unsupported derivation type.\n"; |
453 | warn "ERROR: facename $type:$face contains unsupported derivation type.\n"; |
| 446 | } |
454 | } |
| 447 | |
455 | |
| 448 | aio_load $dpath, my $png; |
456 | aio_load $dpath, my $png; |
| 449 | IO::AIO::aio_unlink $dpath unless $CACHE; |
457 | IO::AIO::aio_unlink $dpath unless $CACHE; |
| 450 | commit_png "$dir/$type:$face", "$type:$face", $png, $T; |
458 | commit_png "$dir/$type:$face", "$type:$face", $png, $T, 1, 1; |
| 451 | } |
459 | } |
| 452 | |
460 | |
| 453 | # split all bigfaces, but avoid smoothfaces (*_S) |
461 | # split all bigfaces, but avoid smoothfaces (*_S) |
| 454 | if (($w > $T || $h > $T) && $face !~ /_S\./) { |
462 | if (($w > $T || $h > $T) && $face !~ /_S\./) { |
| 455 | # split |
463 | # split |
| … | |
… | |
| 500 | |
508 | |
| 501 | if (0 > aio_load $file, $tile) { |
509 | if (0 > aio_load $file, $tile) { |
| 502 | die "$path: unable to read tile +$x+$y, aborting.\n"; |
510 | die "$path: unable to read tile +$x+$y, aborting.\n"; |
| 503 | } |
511 | } |
| 504 | IO::AIO::aio_unlink $file unless $CACHE; |
512 | IO::AIO::aio_unlink $file unless $CACHE; |
| 505 | commit_png $stem, $x|$y ? "$face+$x+$y" : $face, $tile, $T; |
513 | commit_png $stem, $x|$y ? "$face+$x+$y" : $face, $tile, $T, 1, 1; |
| 506 | } |
514 | } |
| 507 | } else { |
515 | } else { |
| 508 | # use as-is (either small, use smooth) |
516 | # use as-is (either small, use smooth) |
| 509 | commit_png $stem, $face, $png, $T; |
517 | commit_png $stem, $face, $png, $T, $w / $T, $h / $T; |
| 510 | } |
518 | } |
| 511 | |
519 | |
| 512 | IO::AIO::aio_unlink $path if $delete; |
520 | IO::AIO::aio_unlink $path if $delete; |
| 513 | } |
521 | } |
| 514 | } |
522 | } |
| … | |
… | |
| 1034 | print $fh $TRS; |
1042 | print $fh $TRS; |
| 1035 | } |
1043 | } |
| 1036 | |
1044 | |
| 1037 | { |
1045 | { |
| 1038 | print "processing facedata...\n" if $VERBOSE; |
1046 | print "processing facedata...\n" if $VERBOSE; |
| 1039 | while (my ($k, $v) = each %FACEINFO) { |
1047 | |
|
|
1048 | for my $k (sort keys %FACEINFO) { |
|
|
1049 | my $v = $FACEINFO{$k}; |
|
|
1050 | |
| 1040 | length $v->{data32} or warn "ERROR: face '$k' has no png32 - this will not work.\n"; |
1051 | length $v->{data32} or warn "ERROR: face '$k' has no png32 - this will not work.\n"; |
| 1041 | length $v->{data64} or warn "ERROR: face '$k' has no png64 - this will not work.\n"; |
1052 | length $v->{data64} or warn "ERROR: face '$k' has no png64 - this will not work.\n"; |
| 1042 | |
1053 | |
| 1043 | make_hash $k, $v->{data32}, $v->{hash32}; |
1054 | make_hash $k, $v->{data32}, $v->{hash32}; |
| 1044 | make_hash $k, $v->{data64}, $v->{hash64}; |
1055 | make_hash $k, $v->{data64}, $v->{hash64}; |
| … | |
… | |
| 1048 | |
1059 | |
| 1049 | $v->{glyph} // warn "ERROR: face '$k' has no glyph - missing faceinfo entry?\n"; |
1060 | $v->{glyph} // warn "ERROR: face '$k' has no glyph - missing faceinfo entry?\n"; |
| 1050 | $v->{visibility} // warn "ERROR: face '$k' has no visibility info - missing faceinfo entry?\n"; |
1061 | $v->{visibility} // warn "ERROR: face '$k' has no visibility info - missing faceinfo entry?\n"; |
| 1051 | $v->{magicmap} // warn "ERROR: face '$k' has no foreground colour - missing faceinfo entry?\n"; |
1062 | $v->{magicmap} // warn "ERROR: face '$k' has no foreground colour - missing faceinfo entry?\n"; |
| 1052 | |
1063 | |
|
|
1064 | if (0 && $v->{w} == 1 && $v->{h} == 1) { # texture catalogs |
|
|
1065 | my $id = @TC; |
|
|
1066 | my $n = @{ $TC[-1] }; |
|
|
1067 | my $x = $n % TC_W; |
|
|
1068 | my $y = int $n / TC_W; |
|
|
1069 | |
|
|
1070 | push @{ $TC[-1] }, [$v, $x, $y]; |
|
|
1071 | |
|
|
1072 | $v->{tc} = [$id, $x, $y]; |
|
|
1073 | |
|
|
1074 | push @TC, [] if $n == TC_W * TC_H - 1; # start new texture if full |
|
|
1075 | } |
|
|
1076 | |
| 1053 | delete @$v{qw(arc stem derive)}; # not used by the server |
1077 | delete @$v{qw(w h arc stem derive)}; # not used by the server |
|
|
1078 | } |
|
|
1079 | |
|
|
1080 | if (0) { #d# texture catalogs |
|
|
1081 | print "creating texture catalogs...\n" if $VERBOSE; |
|
|
1082 | |
|
|
1083 | for my $id (0 .. $#TC) { |
|
|
1084 | my $tc = $TC[$id]; |
|
|
1085 | |
|
|
1086 | my $cmd = "$CONVERT -depth 8 -size " . (TC_W * 64) . "x" . (TC_H * 64) . " xc:transparent"; |
|
|
1087 | my $idx = "a"; |
|
|
1088 | |
|
|
1089 | for (@$tc) { |
|
|
1090 | my $path = "$TMPDIR/tc" . $idx++; |
|
|
1091 | |
|
|
1092 | open my $fh, ">:perlio", $path |
|
|
1093 | or die "$path: $!"; |
|
|
1094 | syswrite $fh, $_->[0]{data64}; |
|
|
1095 | |
|
|
1096 | my $x = $_->[1] * 64; |
|
|
1097 | my $y = $_->[2] * 64; |
|
|
1098 | |
|
|
1099 | $cmd .= " png:\Q$path\E -geometry +$x+$y -composite"; |
| 1054 | } |
1100 | } |
|
|
1101 | |
|
|
1102 | system "$cmd png:\Q$TMPDIR/tc$id\E"; |
|
|
1103 | optipng "$TMPDIR/tc$id"; |
|
|
1104 | } |
|
|
1105 | } |
| 1055 | |
1106 | |
| 1056 | print "processing resources...\n" if $VERBOSE; |
1107 | print "processing resources...\n" if $VERBOSE; |
| 1057 | my $enc = JSON::XS->new->utf8->canonical->relaxed; |
1108 | my $enc = JSON::XS->new->utf8->canonical->relaxed; |
| 1058 | while (my ($k, $v) = each %RESOURCE) { |
1109 | while (my ($k, $v) = each %RESOURCE) { |
| 1059 | |
1110 | |
