| 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 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 | } |
| … | |
… | |
| 761 | $meta = { |
769 | $meta = { |
| 762 | %{ $meta->{"" } || {} }, |
770 | %{ $meta->{"" } || {} }, |
| 763 | %{ $meta->{$file} || {} }, |
771 | %{ $meta->{$file} || {} }, |
| 764 | }; |
772 | }; |
| 765 | |
773 | |
| 766 | if ($meta->{license} =~ s/^#//) { |
774 | if (exists $meta->{license} && $meta->{license} =~ s/^#//) { # exists == avoid autovivification |
|
|
775 | # all these are acceptable for deliantra - if not specified, agpl 3+ is the default. |
| 767 | $meta->{license} = ({ |
776 | $meta->{license} = ({ |
| 768 | "pd" => "Public Domain", |
777 | "pd" => "Public Domain", |
| 769 | "gpl" => "GNU General Public License, version 3.0 or any later", |
778 | "gpl" => "GNU General Public License, version 3.0 or any later", |
|
|
779 | "2bsd" => "2-clause BSD/MIT style license", |
|
|
780 | "3bsd" => "3-clause BSD style license", |
| 770 | "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/", |
781 | "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/", |
| 771 | "cc/by/2.1" => "Licensed under Creative Commons Attribution 2.1 http://creativecommons.org/licenses/by/2.1/", |
782 | "cc/by/2.1" => "Licensed under Creative Commons Attribution 2.1 http://creativecommons.org/licenses/by/2.1/", |
| 772 | "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/", |
783 | "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/", |
| 773 | "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/", |
784 | "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/", |
| 774 | })->{$meta->{license}} |
785 | })->{$meta->{license}} |
| … | |
… | |
| 782 | $file =~ s/\.res$//; |
793 | $file =~ s/\.res$//; |
| 783 | $file =~ s/\.(ogg|wav|jpg|png)$//; |
794 | $file =~ s/\.(ogg|wav|jpg|png)$//; |
| 784 | |
795 | |
| 785 | if ($file =~ s/\.plt$//) { |
796 | if ($file =~ s/\.plt$//) { |
| 786 | $data = process_plt "$dir/$file", $data; |
797 | $data = process_plt "$dir/$file", $data; |
| 787 | } elsif (my $filter = $meta->{cfutil_filter}) { |
798 | } elsif (my $filter = delete $meta->{cfutil_filter}) { |
| 788 | if ($filter eq "yaml2json") { |
799 | if ($filter eq "yaml2json") { |
| 789 | $data = JSON::XS::encode_json YAML::XS::Load $data; |
800 | $data = JSON::XS::encode_json YAML::XS::Load $data; |
| 790 | } elsif ($filter eq "json2json") { |
801 | } elsif ($filter eq "json2json") { |
| 791 | $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data); |
802 | $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data); |
| 792 | } elsif ($filter eq "perl2json") { |
803 | } elsif ($filter eq "perl2json") { |
| … | |
… | |
| 797 | } |
808 | } |
| 798 | } |
809 | } |
| 799 | |
810 | |
| 800 | substr $dir, 0, 1 + length $PATH, ""; |
811 | substr $dir, 0, 1 + length $PATH, ""; |
| 801 | |
812 | |
| 802 | $RESOURCE{"$dir/$file"} = { |
813 | my %info = ( |
| 803 | type => (exists $meta->{type} ? delete $meta->{type} : $type), |
814 | type => (exists $meta->{type} ? delete $meta->{type} : $type), |
| 804 | data => $data, |
815 | data => $data, |
| 805 | %$meta ? (meta => $meta) : (), |
816 | %$meta ? (meta => $meta) : (), |
| 806 | }; |
817 | ); |
|
|
818 | |
|
|
819 | $RESOURCE{"$dir/$file"} = \%info; |
| 807 | } |
820 | } |
| 808 | |
821 | |
| 809 | sub process_any { |
822 | sub process_any { |
| 810 | while (my ($func, @args) = @{ $c_any->get }) { |
823 | while (my ($func, @args) = @{ $c_any->get }) { |
| 811 | $func->(@args); |
824 | $func->(@args); |
| … | |
… | |
| 844 | if ($file =~ /\.(jpg|png)$/) { |
857 | if ($file =~ /\.(jpg|png)$/) { |
| 845 | $c_any->put ([\&process_res, $path, $file, 0]) # FT_FACE |
858 | $c_any->put ([\&process_res, $path, $file, 0]) # FT_FACE |
| 846 | } elsif ($file =~ /\.(res)$/) { |
859 | } elsif ($file =~ /\.(res)$/) { |
| 847 | $c_any->put ([\&process_res, $path, $file, 6]) # FT_RSRC |
860 | $c_any->put ([\&process_res, $path, $file, 6]) # FT_RSRC |
| 848 | } else { |
861 | } else { |
| 849 | $c_any->put ([\&process_res, $path, $file, undef]); |
862 | $c_any->put ([\&process_res, $path, $file, 6]); # was type undef, but now meta files are mandatory, so any mentioned file surely has a purpose |
| 850 | } |
863 | } |
| 851 | |
864 | |
| 852 | } elsif ($file =~ /\.png$/) { |
865 | } elsif ($file =~ /\.png$/) { |
| 853 | $PNG{$file} = $path; |
866 | $PNG{$file} = $path; |
| 854 | |
867 | |
| … | |
… | |
| 1034 | print $fh $TRS; |
1047 | print $fh $TRS; |
| 1035 | } |
1048 | } |
| 1036 | |
1049 | |
| 1037 | { |
1050 | { |
| 1038 | print "processing facedata...\n" if $VERBOSE; |
1051 | print "processing facedata...\n" if $VERBOSE; |
| 1039 | while (my ($k, $v) = each %FACEINFO) { |
1052 | |
|
|
1053 | for my $k (sort keys %FACEINFO) { |
|
|
1054 | my $v = $FACEINFO{$k}; |
|
|
1055 | |
| 1040 | length $v->{data32} or warn "ERROR: face '$k' has no png32 - this will not work.\n"; |
1056 | 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"; |
1057 | length $v->{data64} or warn "ERROR: face '$k' has no png64 - this will not work.\n"; |
| 1042 | |
1058 | |
| 1043 | make_hash $k, $v->{data32}, $v->{hash32}; |
1059 | make_hash $k, $v->{data32}, $v->{hash32}; |
| 1044 | make_hash $k, $v->{data64}, $v->{hash64}; |
1060 | make_hash $k, $v->{data64}, $v->{hash64}; |
| … | |
… | |
| 1048 | |
1064 | |
| 1049 | $v->{glyph} // warn "ERROR: face '$k' has no glyph - missing faceinfo entry?\n"; |
1065 | $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"; |
1066 | $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"; |
1067 | $v->{magicmap} // warn "ERROR: face '$k' has no foreground colour - missing faceinfo entry?\n"; |
| 1052 | |
1068 | |
|
|
1069 | if (0 && $v->{w} == 1 && $v->{h} == 1) { # texture catalogs |
|
|
1070 | my $id = @TC; |
|
|
1071 | my $n = @{ $TC[-1] }; |
|
|
1072 | my $x = $n % TC_W; |
|
|
1073 | my $y = int $n / TC_W; |
|
|
1074 | |
|
|
1075 | push @{ $TC[-1] }, [$v, $x, $y]; |
|
|
1076 | |
|
|
1077 | $v->{tc} = [$id, $x, $y]; |
|
|
1078 | |
|
|
1079 | push @TC, [] if $n == TC_W * TC_H - 1; # start new texture if full |
|
|
1080 | } |
|
|
1081 | |
| 1053 | delete @$v{qw(arc stem derive)}; # not used by the server |
1082 | delete @$v{qw(w h arc stem derive)}; # not used by the server |
|
|
1083 | } |
|
|
1084 | |
|
|
1085 | if (0) { #d# texture catalogs |
|
|
1086 | print "creating texture catalogs...\n" if $VERBOSE; |
|
|
1087 | |
|
|
1088 | for my $id (0 .. $#TC) { |
|
|
1089 | my $tc = $TC[$id]; |
|
|
1090 | |
|
|
1091 | my $cmd = "$CONVERT -depth 8 -size " . (TC_W * 64) . "x" . (TC_H * 64) . " xc:transparent"; |
|
|
1092 | my $idx = "a"; |
|
|
1093 | |
|
|
1094 | for (@$tc) { |
|
|
1095 | my $path = "$TMPDIR/tc" . $idx++; |
|
|
1096 | |
|
|
1097 | open my $fh, ">:perlio", $path |
|
|
1098 | or die "$path: $!"; |
|
|
1099 | syswrite $fh, $_->[0]{data64}; |
|
|
1100 | |
|
|
1101 | my $x = $_->[1] * 64; |
|
|
1102 | my $y = $_->[2] * 64; |
|
|
1103 | |
|
|
1104 | $cmd .= " png:\Q$path\E -geometry +$x+$y -composite"; |
| 1054 | } |
1105 | } |
|
|
1106 | |
|
|
1107 | system "$cmd png:\Q$TMPDIR/tc$id\E"; |
|
|
1108 | optipng "$TMPDIR/tc$id"; |
|
|
1109 | } |
|
|
1110 | } |
| 1055 | |
1111 | |
| 1056 | print "processing resources...\n" if $VERBOSE; |
1112 | print "processing resources...\n" if $VERBOSE; |
| 1057 | my $enc = JSON::XS->new->utf8->canonical->relaxed; |
1113 | my $enc = JSON::XS->new->utf8->canonical->relaxed; |
| 1058 | while (my ($k, $v) = each %RESOURCE) { |
1114 | for my $k (sort keys %RESOURCE) { |
|
|
1115 | my $v = $RESOURCE{$k}; |
| 1059 | |
1116 | |
| 1060 | if ($v->{meta} && $v->{meta}{datadir}) { |
1117 | if ($v->{meta} && $v->{meta}{datadir}) { |
| 1061 | delete $RESOURCE{$k}; |
1118 | delete $RESOURCE{$k}; |
| 1062 | |
1119 | |
| 1063 | $k =~ s/^res\/// or die "$k: datadir files must be in res/"; |
1120 | $k =~ s/^res\/// or die "$k: datadir files must be in res/"; |
| … | |
… | |
| 1082 | |
1139 | |
| 1083 | make_hash $k, $v->{data}, $v->{hash}, 6; # 6 for the benefit of existing clients |
1140 | make_hash $k, $v->{data}, $v->{hash}, 6; # 6 for the benefit of existing clients |
| 1084 | } |
1141 | } |
| 1085 | } |
1142 | } |
| 1086 | |
1143 | |
|
|
1144 | printf "writing facedata...\n" if $VERBOSE; |
|
|
1145 | |
|
|
1146 | { |
|
|
1147 | open my $fh, ">:perlio", "$DATADIR/facedata~" |
|
|
1148 | or die "$DATADIR/facedata~: $!"; |
|
|
1149 | |
|
|
1150 | print $fh "FACEDATA"; |
|
|
1151 | my $fofs = 8; |
|
|
1152 | |
|
|
1153 | my $put = sub { |
|
|
1154 | my $len = length $_[0]; |
|
|
1155 | my $ofs = $fofs; |
|
|
1156 | |
|
|
1157 | print $fh $_[0]; |
|
|
1158 | $fofs += $len; |
|
|
1159 | |
|
|
1160 | ($len, $ofs) |
|
|
1161 | }; |
|
|
1162 | |
|
|
1163 | for (values %FACEINFO) { |
|
|
1164 | ($_->{size32}, $_->{fofs32}) = $put->(delete $_->{data32}); |
|
|
1165 | ($_->{size64}, $_->{fofs64}) = $put->(delete $_->{data64}); |
|
|
1166 | } |
|
|
1167 | |
|
|
1168 | for (values %RESOURCE) { |
|
|
1169 | ($_->{size}, $_->{fofs}) = $put->(delete $_->{data}); |
|
|
1170 | } |
|
|
1171 | |
|
|
1172 | close $fh; |
|
|
1173 | } |
|
|
1174 | |
| 1087 | printf "writing facedata (%d faces, %d anims, %d resources)...\n", |
1175 | printf "writing faceinfo (%d faces, %d anims, %d resources)...\n", |
| 1088 | scalar keys %FACEINFO, |
1176 | scalar keys %FACEINFO, |
| 1089 | scalar keys %ANIMINFO, |
1177 | scalar keys %ANIMINFO, |
| 1090 | scalar keys %RESOURCE |
1178 | scalar keys %RESOURCE |
| 1091 | if $VERBOSE; |
1179 | if $VERBOSE; |
| 1092 | |
1180 | |
| 1093 | open my $fh, ">:perlio", "$DATADIR/facedata~" |
1181 | open my $fh, ">:perlio", "$DATADIR/faceinfo~" |
| 1094 | or die "$DATADIR/facedata~: $!"; |
1182 | or die "$DATADIR/faceinfo~: $!"; |
| 1095 | |
1183 | |
| 1096 | print $fh nfreeze { |
1184 | print $fh nfreeze { |
| 1097 | version => 2, |
1185 | version => 2, |
| 1098 | faceinfo => \%FACEINFO, |
1186 | faceinfo => \%FACEINFO, |
| 1099 | animinfo => \%ANIMINFO, |
1187 | animinfo => \%ANIMINFO, |
| … | |
… | |
| 1101 | }; |
1189 | }; |
| 1102 | } |
1190 | } |
| 1103 | |
1191 | |
| 1104 | print "committing files...\n" if $VERBOSE; |
1192 | print "committing files...\n" if $VERBOSE; |
| 1105 | |
1193 | |
| 1106 | for (qw(archetypes facedata treasures), @COMMIT) { |
1194 | for (qw(archetypes faceinfo facedata treasures), @COMMIT) { |
| 1107 | chmod 0644, "$DATADIR/$_~"; |
1195 | chmod 0644, "$DATADIR/$_~"; |
| 1108 | rename "$DATADIR/$_~", "$DATADIR/$_" |
1196 | rename "$DATADIR/$_~", "$DATADIR/$_" |
| 1109 | or die "$DATADIR/$_: $!"; |
1197 | or die "$DATADIR/$_: $!"; |
| 1110 | } |
1198 | } |
| 1111 | |
1199 | |
