ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/utils/cfutil.in
(Generate patch)

Comparing deliantra/server/utils/cfutil.in (file contents):
Revision 1.27 by root, Wed Apr 18 07:59:03 2007 UTC vs.
Revision 1.72 by root, Mon Oct 12 14:01:00 2009 UTC

… …
6my $exec_prefix = "@exec_prefix@"; 6my $exec_prefix = "@exec_prefix@";
7my $datarootdir = "@datarootdir@"; 7my $datarootdir = "@datarootdir@";
8my $DATADIR = "@datadir@/@PACKAGE@"; 8my $DATADIR = "@datadir@/@PACKAGE@";
9 9
10my $CONVERT = "@CONVERT@"; 10my $CONVERT = "@CONVERT@";
11my $IDENTIFY = "@IDENTIFY@"; 11#my $IDENTIFY = "@IDENTIFY@";
12my $OPTIPNG = "@OPTIPNG@"; 12my $OPTIPNG = "@OPTIPNG@";
13my $RSYNC = "@RSYNC@"; 13my $RSYNC = "@RSYNC@";
14my $PNGNQ = "@PNGNQ@";
14 15
15use Getopt::Long; 16use Getopt::Long;
16use Coro::Event; 17use Coro::EV;
17use AnyEvent; 18use AnyEvent;
19use YAML::XS ();
20use JSON::XS ();
18use IO::AIO (); 21use IO::AIO ();
19use File::Temp; 22use File::Temp;
20use Crossfire; 23use Deliantra;
21use Coro; 24use Coro 5.12;
22use Coro::AIO; 25use Coro::AIO;
26use Coro::Util;
23use POSIX (); 27use POSIX ();
24use Digest::MD5; 28use Carp;
29use Coro::Channel;
25use Coro::Storable; $Storable::canonical = 1; 30use Coro::Storable; $Storable::canonical = 1;
31
32$SIG{QUIT} = sub { Carp::cluck "QUIT" };
26 33
27sub usage { 34sub usage {
28 warn <<EOF; 35 warn <<EOF;
29Usage: cfutil [-v] [-q] [--force] [--cache] 36Usage: cfutil [-v] [-q] [--force] [--cache]
30 [--install-arch path] 37 [--install-arch path]
… …
42my $CACHE = 0; 49my $CACHE = 0;
43my $FORCE; 50my $FORCE;
44my $TMPDIR = "/tmp/cfutil$$~"; 51my $TMPDIR = "/tmp/cfutil$$~";
45my $TMPFILE = "aaaa0"; 52my $TMPFILE = "aaaa0";
46 53
54our %COLOR = (
55 black => 0,
56 white => 1,
57 navy => 2,
58 red => 3,
59 orange => 4,
60 blue => 5,
61 darkorange => 6,
62 green => 7,
63 lightgreen => 8,
64 grey => 9,
65 brown => 10,
66 gold => 11,
67 tan => 12,
68);
69
47END { system "rm", "-rf", $TMPDIR } 70END { system "rm", "-rf", $TMPDIR }
48 71
49Event->signal (signal => "INT", cb => sub { exit 1 }); 72my $s_INT = EV::signal INT => sub { exit 1 };
50Event->signal (signal => "TERM", cb => sub { exit 1 }); 73my $s_TERM = EV::signal TERM => sub { exit 1 };
51 74
52mkdir $TMPDIR, 0700 75mkdir $TMPDIR, 0700
53 or die "$TMPDIR: $!"; 76 or die "$TMPDIR: $!";
54 77
55sub fork_sub(&) { 78sub fork_sub(&) {
… …
68} 91}
69 92
70sub inst_maps($) { 93sub inst_maps($) {
71 my (undef, $path) = @_; 94 my (undef, $path) = @_;
72 95
73 print "installing '$path' to '$DATADIR/maps'\n"; 96 print "\nInstalling '$path' to '$DATADIR/maps'\n\n";
74 97
75 if (!-f "$path/regions") { 98 if (!-f "$path/regions") {
76 warn "'$path' does not look like a maps directory ('regions' file is missing).\n"; 99 warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
77 exit 1 unless $FORCE; 100 exit 1 unless $FORCE;
78 } 101 }
79 102
80 system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded" 103 system $RSYNC, "-av", "--chmod=u=rwX,go=rX",
104 "$path/.", "$DATADIR/maps/.",
105 "--exclude", "CVS", "--exclude", "/world-precomposed",
106 "--delete", "--delete-excluded"
81 and die "map installation failed.\n"; 107 and die "map installation failed.\n";
82 108
83 print "maps installed successfully.\n"; 109 print "maps installed successfully.\n";
84} 110}
85 111
86{ 112{
87 our %ANIMINFO; 113 our %ANIMINFO;
88 our %FACEINFO; 114 our %FACEINFO;
115 our %RESOURCE;
116 our @ARC;
89 our %ARC; 117 our %ARC;
90 our $TRS; 118 our $TRS;
91 our $NFILE; 119 our $NFILE;
120 our $PATH;
92 121
93 our $QUANTIZE = "+dither -colorspace RGB -colors 256"; 122 our $QUANTIZE = "+dither -colorspace RGB -colors 256";
94 123
95 our (@png, @trs, @arc); # files we are interested in 124 our $c_arc = new Coro::Channel;
125 our $c_trs = new Coro::Channel;
126 our $c_res = new Coro::Channel;
127
128 our @c_png;
96 129
97 sub commit_png($$$) { 130 sub commit_png($$$) {
98 my ($name, $data, $T) = @_; 131 my ($name, $data, $T) = @_;
99 132
100 $FACEINFO{$name}{"data$T"} = $data; 133 $FACEINFO{$name}{"data$T"} = $data;
101 } 134 }
102 135
103 sub process_png { 136 sub process_png {
104 while (@png) { 137 while (@c_png) {
105 my ($path, $delete) = @{pop @png}; 138 my ($path, $delete) = @{pop @c_png};
106 139
107 my $png; 140 my $png;
108 aio_lstat $path; 141 aio_lstat $path;
109 my ($size, $mtime) = (stat _)[7,9]; 142 my ($size, $mtime) = (stat _)[7,9];
110 143
… …
141 if ($w % $T || $h % $T) { 174 if ($w % $T || $h % $T) {
142 warn "$path: weird png size ($w $h), skipping.\n"; 175 warn "$path: weird png size ($w $h), skipping.\n";
143 next; 176 next;
144 } 177 }
145 178
179 (my $base = $stem) =~ s/^.*\///;
180
181 my $fi = $FACEINFO{$base};
182 unless ($fi) {
183 #warn "$path: <$base> not referenced by any archetype, skipping.\n";
184 #next;
185 }
186
187 my $arc = $fi->{arc} || { };
188
146 unless ($path =~ /~$/) { 189 unless ($path =~ /~$/) {
147 # possibly enlarge 190 # possibly enlarge
148 if (0 > aio_stat "$stem.64x64.png") { 191 if (0 > aio_stat "$stem.64x64.png") {
149 my $other = "$stem.64x64.png~"; 192 my $other = "$stem.64x64.png~";
150 193
151 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 194 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
152 my $wrap = 0; # for the time being
153 fork_sub { 195 fork_sub {
196 my $CROP;
197 my $SRC = "png:\Q$path\E";
198
199 my $is_floor = $arc->{is_floor};
200 my $is_wall = 0;
201
202 my ($wall_pfx, $wall_dir, $wall_sfx);
203
204 if (
205 !$is_floor
206 && !$arc->{alive}
207 && $arc->{move_block} eq "all"
208 && $path =~ /^(.*_)([0-9A-F])(\.x11.*\.png)$/
209 ) {
210 ($wall_pfx, $wall_dir, $wall_sfx) = ($1, hex $2, $3);
211
212 unless (grep { !-e sprintf "%s%X%s", $wall_pfx, $_, $wall_sfx } 0..15) {
213 $is_wall = 1;
214 }
215 }
216
217 if ($is_wall || $is_floor) {
218 # add a 4px border and add other images around it
219 $CROP = "-shave 8x8 +repage";
220
221 $w += 8;
222 $h += 8;
223
224 $SRC = "-size ${w}x${h} xc:transparent";
225 $SRC .= " png:\Q$path\E -geometry +4+4 -composite";
226
227 # 8 surrounding images
228 for (
229 # x y b r0 r1
230 [-1, -1, 0, 6],
231 [ 0, -1, 1, 10, 14],
232 [+1, -1, 0, 12],
233
234 [-1, 0, 8, 5, 7],
235 #
236 [+1, 0, 2, 5, 13],
237
238 [-1, +1, 0, 3],
239 [ 0, +1, 4, 10, 11],
240 [+1, +1, 0, 9],
241 ) {
242 my ($x, $y, $d, $r0, $r1) = @$_;
243
244 my $tile = $is_floor ? $path
245 : $is_wall ? sprintf "%s%X%s", $wall_pfx, ($wall_dir & $d) ? $r1 : $r0, $wall_sfx
246 : die;
247
248 $SRC .= sprintf " png:%s -geometry %+d%+d -composite",
249 "\Q$tile",
250 $x * ($w - 8) + 4,
251 $y * ($h - 8) + 4;
252 }
253 }
254
154 system "convert png:\Q$path\E -depth 8 rgba:-" 255 system "convert -depth 8 $SRC rgba:-"
155 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap" 256 . "| $exec_prefix/bin/cfhq2xa $w $h 0"
156 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~" 257 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $CROP $QUANTIZE -quality 00 png32:\Q$other\E~"
157 and die "convert/hq2xa pipeline error: status $? ($!)"; 258 and die "convert/cfhq2xa pipeline error: status $? ($!)";
158 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 259 system $OPTIPNG, "-i0", "-q", "$other~";
159 die "$other~ has zero size, aborting." unless -s "$other~"; 260 die "$other~ has zero size, aborting." unless -s "$other~";
160 rename "$other~", $other; 261 rename "$other~", $other;
161 }; 262 };
162 } 263 }
163 264
164 push @png, [$other, !$CACHE]; 265 push @c_png, [$other, !$CACHE];
165 } 266 }
166 267
167 # possibly scale down 268 # possibly scale down
168 if (0 > aio_stat "$stem.32x32.png") { 269 if (0 > aio_stat "$stem.32x32.png") {
169 my $other = "$stem.32x32.png~"; 270 my $other = "$stem.32x32.png~";
170 271
171 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 272 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
172 fork_sub { 273 fork_sub {
173 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 274 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
174 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 275 system $OPTIPNG, "-i0", "-q", "$other~";
276
277 # reduce smoothfaces >10000 bytes
278 # obsolete, no longer required
279 if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) {
280 my $ncolor = 256;
281 while () {
282 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
283 system $OPTIPNG, "-i0", "-q", "$other~~";
284 last if 10000 > -s "$other~~";
285 $ncolor = int $ncolor * 0.9;
286 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
287 }
288
289 printf "reduced %s from %d to %d bytes using %d colours.\n",
290 $other, -s "$other~", -s "$other~~", $ncolor
291 if $VERBOSE >= 2;
292 rename "$other~~", "$other~";
293 }
294
175 die "$other~ has zero size, aborting." unless -s "$other~"; 295 die "$other~ has zero size, aborting." unless -s "$other~";
176 rename "$other~", $other; 296 rename "$other~", $other;
177 }; 297 };
178 } 298 }
179 299
180 #warn "scaled down $path to $other\n";#d# 300 #warn "scaled down $path to $other\n";#d#
181 push @png, [$other, !$CACHE]; 301 push @c_png, [$other, !$CACHE];
182 } 302 }
183 } 303 }
184 304
185 (my $face = $stem) =~ s/^.*\///; 305 (my $face = $stem) =~ s/^.*\///;
186 306
… …
247 aio_unlink $path if $delete; 367 aio_unlink $path if $delete;
248 } 368 }
249 } 369 }
250 370
251 sub process_arc { 371 sub process_arc {
252 while (@arc) { 372 while (my $job = $c_arc->get) {
253 my ($dir, $file) = @{pop @arc}; 373 my ($dir, $file) = @$job;
254 374
255 my $arc; 375 my $arc;
256 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 376 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
257 377
258 my $arc = read_arch "$dir/$file"; 378 my $arc = read_arch "$dir/$file";
259 for my $o (values %$arc) { 379 for my $o (values %$arc) {
380 push @ARC, $o;
381 for (my $m = $o; $m; $m = $m->{more}) {
260 $ARC{$o->{_name}} = $o; 382 $ARC{$m->{_name}} = $m;
383 }
261 384
262 $o->{editor_folder} = $dir; 385 $o->{editor_folder} = $dir;
263 386
264 my $visibility = delete $o->{visibility}; 387 my $visibility = delete $o->{visibility};
265 my $magicmap = delete $o->{magicmap}; 388 my $magicmap = delete $o->{magicmap};
… …
278 401
279 my $ext = $x|$y ? "+$x+$y" : ""; 402 my $ext = $x|$y ? "+$x+$y" : "";
280 403
281 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 404 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
282 405
283 my $visibility = delete $o->{visibility} if exists $o->{visibility}; 406 $visibility = delete $o->{visibility} if exists $o->{visibility};
284 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap}; 407 $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
285 408
286 my $anim = delete $o->{anim}; 409 my $anim = delete $o->{anim};
287 410
288 if ($anim) { 411 if ($anim) {
289 # possibly add $ext to the animation name to avoid 412 # possibly add $ext to the animation name to avoid
… …
307 facings => $facings, 430 facings => $facings,
308 frames => \@frames, 431 frames => \@frames,
309 }; 432 };
310 } 433 }
311 434
312 for my $face ($o->{face} || (), @{$anim || []}) { 435 for ($o->{face} || (), @{$anim || []}) {
313 next if $face =~ /^facings\s|^blank.x11$|^empty.x11$/; 436 next if /^facings\s/;
314 437
438 my $face = $_;
439 $face =~ s/\+\d+\+\d+$//; # remove tile offset coordinates
440
315 my $info = $FACEINFO{$face} ||= {}; 441 my $info = $FACEINFO{$face} ||= { };
442 $info->{arc} = $o;
443
444 next if $face =~ /^blank.x11$|^empty.x11$/;
316 445
317 $info->{visibility} = $visibility if defined $visibility; 446 $info->{visibility} = $visibility if defined $visibility;
318 $info->{magicmap} = $magicmap if defined $magicmap; 447 $info->{magicmap} = $magicmap if defined $magicmap;
319 } 448 }
320 449
321 if (my $smooth = delete $o->{smoothface}) { 450 if (my $smooth = delete $o->{smoothface}) {
322 my %kv =split /\s+/, $smooth; 451 my %kv = split /\s+/, $smooth;
323 my $level = $o->{smoothlevel}; #TODO: delete from $o if !gcfclient-support 452 my $level = $o->{smoothlevel}; #TODO: delete from $o if !gcfclient-support
324 while (my ($face, $smooth) = each %kv) { 453 while (my ($face, $smooth) = each %kv) {
454 $FACEINFO{$smooth}{arc} = $o;
455
325 $FACEINFO{$face}{smooth} = $smooth; 456 $FACEINFO{$face}{smooth} = $smooth;
326 $FACEINFO{$face}{smoothlevel} = $level; 457 $FACEINFO{$face}{smoothlevel} = $level;
327 } 458 }
328 } 459 }
329 } 460 }
330 } 461 }
331 } 462 }
332 } 463 }
333 464
334 sub process_trs { 465 sub process_trs {
335 while (@trs) { 466 while (my $job = $c_trs->get) {
336 my ($dir, $file) = @{pop @trs}; 467 my ($dir, $file) = @$job;
337 my $path = "$dir/$file"; 468 my $path = "$dir/$file";
338 469
339 my $trs; 470 my $trs;
340 if (0 > aio_load $path, $trs) { 471 if (0 > aio_load $path, $trs) {
341 warn "$path: $!, skipping.\n"; 472 warn "$path: $!, skipping.\n";
… …
344 475
345 $TRS .= $trs; 476 $TRS .= $trs;
346 } 477 }
347 } 478 }
348 479
480 my %FILECACHE;
481
482 sub load_cached($;$) {
483 unless (exists $FILECACHE{$_[0]}) {
484 my $data;
485 if (0 < aio_load $_[0], $data) {
486 if ($_[1]) {
487 $data = eval { $_[1]->($data) };
488 warn "$_[0]: $@" if $@;
489 }
490 }
491
492 $FILECACHE{$_[0]} = $data;
493 }
494
495 $FILECACHE{$_[0]}
496 }
497
498 sub process_res {
499 while (my $job = $c_res->get) {
500 my ($dir, $file, $type) = @$job;
501
502 my $data;
503 aio_load "$dir/$file", $data;
504
505 my $meta = load_cached "$dir/meta", sub { JSON::XS->new->utf8->relaxed->decode (shift) };
506
507 utf8::decode $dir;
508 utf8::decode $file;
509
510 # a meta file for resources is now mandatory
511 unless (exists $meta->{$file}) {
512 warn "skipping $dir/$file\n" if $VERBOSE >= 3;
513 next;
514 }
515
516 $meta = {
517 %{ $meta->{"" } || {} },
518 %{ $meta->{$file} || {} },
519 };
520
521 if ($meta->{license} =~ s/^#//) {
522 $meta->{license} = ({
523 "pd" => "Public Domain",
524 "gpl" => "GNU General Public License, version 3.0 or any later",
525 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
526 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/",
527 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
528 })->{$meta->{license}}
529 || warn "$dir/$file: license tag '$meta->{license}' not found.";
530 }
531
532 $file =~ s/\.res$//;
533 $file =~ s/\.(ogg|wav|jpg|png)$//;
534
535 substr $dir, 0, 1 + length $PATH, "";
536
537 if (my $filter = $meta->{cfutil_filter}) {
538 if ($filter eq "yaml2json") {
539 $data = JSON::XS::encode_json YAML::XS::Load $data;
540 } elsif ($filter eq "json2json") {
541 $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data);
542 } elsif ($filter eq "perl2json") {
543 $data = eval $data; die if $@;
544 $data = JSON::XS::encode_json $data;
545 } else {
546 warn "$dir/$file: unknown filter $filter, skipping\n";
547 }
548 }
549
550 $RESOURCE{"$dir/$file"} = {
551 type => (exists $meta->{type} ? delete $meta->{type} : $type),
552 data => $data,
553 %$meta ? (meta => $meta) : (),
554 };
555 }
556 }
557
349 sub find_files; 558 sub find_files;
350 sub find_files { 559 sub find_files {
351 my ($path) = @_; 560 my ($path) = @_;
352 561
353 IO::AIO::aioreq_pri 4; 562 IO::AIO::aioreq_pri 4;
… …
355 my ($dirs, $nondirs) = @_; 564 my ($dirs, $nondirs) = @_;
356 565
357 find_files "$path/$_" 566 find_files "$path/$_"
358 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 567 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;
359 568
569 my $dir = $path;
570 substr $dir, 0, 1 + length $PATH, "";
571
360 for my $file (@$nondirs) { 572 for my $file (@$nondirs) {
573 if ($dir =~ /^music(?:\/|$)/) {
574 $c_res->put ([$path, $file, 3]) # FT_MUSIC
575 if $file =~ /\.(ogg)$/;
576
577 } elsif ($dir =~ /^sound(?:\/|$)/) {
578 $c_res->put ([$path, $file, 5]) # FT_SOUND
579 if $file =~ /\.(wav|ogg)$/;
580
581 } elsif ($dir =~ /^res(?:\/|$)/) {
582 if ($file =~ /\.(jpg|png)$/) {
583 $c_res->put ([$path, $file, 0]) # FT_FACE
584 } elsif ($file =~ /\.(res)$/) {
585 $c_res->put ([$path, $file, 6]) # FT_RSRC
586 } else {
587 $c_res->put ([$path, $file, undef]);
588 }
589
361 if ($file =~ /\.png$/) { 590 } elsif ($file =~ /\.png$/) {
362 push @png, ["$path/$file", 0]; 591 push @c_png, ["$path/$file", 0];
592
363 } elsif ($file =~ /\.trs$/) { 593 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 594 $c_trs->put ([$path, $file]);
595
365 } elsif ($file =~ /\.arc$/) { 596 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 597 $c_arc->put ([$path, $file]);
598
367 } else { 599 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 600 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 601 }
370 } 602 }
371 }; 603 };
372 } 604 }
373 605
374 sub inst_arch($) { 606 sub inst_arch($) {
375 my (undef, $path) = @_; 607 my (undef, $path) = @_;
376 608
609 $PATH = $path;
610
611 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 612 "Installing '$path' to '$DATADIR'\n",
613 "\n",
378 "This can take a long time if you run this\n", 614 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 615 "for the first time or do not use --cache.\n",
380 "\n", 616 "\n",
381 "Unless you run verbosely, all following warning\n", 617 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 618 "or error messages indicate serious problems.\n",
… …
385 if (!-d "$path/treasures") { 621 if (!-d "$path/treasures") {
386 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n"; 622 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
387 exit 1 unless $FORCE; 623 exit 1 unless $FORCE;
388 } 624 }
389 625
626 print "scanning files...\n" if $VERBOSE;
627
390 find_files $path; 628 find_files $path;
629
630 my @a_arc = map +(async \&process_arc), 1..2;
631 my @a_res = map +(async \&process_res), 1..2;
632 my @a_trs = map +(async \&process_trs), 1..2;
633
391 IO::AIO::flush; 634 IO::AIO::flush;
392 635
393 $_->join for ( 636 $c_res->shutdown;
637 $c_arc->shutdown;
638 $c_trs->shutdown;
639
640 print "start file scan, arc, res processing...\n" if $VERBOSE;
641
642 $_->join for @a_arc; # need to parse all archetypes before png processing
643
644 print "end arc, start png processing...\n" if $VERBOSE;
645
394 # four png crunchers work fine for my 2x smp machine 646 # eight png crunchers work fine for my 4x smp machine
395 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 647 my @a_png = map +(async \&process_png), 1..8;
396 (async \&process_trs), (async \&process_trs),
397 (async \&process_arc), (async \&process_arc),
398 );
399 648
649 $_->join for (@a_trs, @a_res, @a_png);
650
651 print "scanning done, processing results...\n" if $VERBOSE;
400 { 652 {
401 # remove path prefix from editor_folder 653 # remove path prefix from editor_folder
402 substr $_->{editor_folder}, 0, 1 + length $path, "" 654 substr $_->{editor_folder}, 0, 1 + length $path, ""
403 for values %ARC; 655 for values %ARC;
404 656
657 print "resolving inheritance tree...\n" if $VERBOSE;
405 # resolve inherit 658 # resolve inherit
406 while () { 659 while () {
407 my $progress; 660 my $progress;
408 my $loop; 661 my $loop;
409 662
… …
412 if (my $s = $ARC{$other}) { 665 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 666 if ($s->{inherit}) {
414 $loop = $s; 667 $loop = $s;
415 } else { 668 } else {
416 delete $o->{inherit}; 669 delete $o->{inherit};
670 my %s = %$s;
671 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 672 %$o = ( %s, %$o );
418 ++$progress; 673 ++$progress;
419 } 674 }
420 } else { 675 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 676 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 677 delete $ARC{$o->{_name}};
… …
430 685
431 last; 686 last;
432 } 687 }
433 } 688 }
434 689
690 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
691 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
692
693 print "writing archetypes...\n" if $VERBOSE;
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 694 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 695 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 696 print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 697 }
439 698
440 { 699 {
700 print "writing treasures...\n" if $VERBOSE;
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 701 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 702 or die "$DATADIR/treasures~: $!";
443 print $fh $TRS; 703 print $fh $TRS;
444 } 704 }
445 705
446 { 706 {
707 print "processing facedata...\n" if $VERBOSE;
447 while (my ($k, $v) = each %FACEINFO) { 708 while (my ($k, $v) = each %FACEINFO) {
448 length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n"; 709 length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n";
449 length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n"; 710 length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n";
450 711
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 712 #length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n";
452 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n"; 713 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 714
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 715 if (my $magicmap = $v->{magicmap}) {
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 716 $magicmap =~ y/A-Z_\-/a-z/d;
717 $v->{magicmap} = $COLOR{$magicmap};
456 } 718 }
457 719
720 delete $v->{arc};
721 }
722
723 print "writing facedata...\n" if $VERBOSE;
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 724 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 725 or die "$DATADIR/facedata~: $!";
460 726
461 print $fh freeze { 727 print $fh freeze {
462 version => 2, 728 version => 2,
463 faceinfo => \%FACEINFO, 729 faceinfo => \%FACEINFO,
464 animinfo => \%ANIMINFO, 730 animinfo => \%ANIMINFO,
731 resource => \%RESOURCE,
465 }; 732 };
466 } 733 }
734
735 print "committing files...\n" if $VERBOSE;
467 736
468 for (qw(archetypes facedata treasures)) { 737 for (qw(archetypes facedata treasures)) {
469 chmod 0644, "$DATADIR/$_~"; 738 chmod 0644, "$DATADIR/$_~";
470 rename "$DATADIR/$_~", "$DATADIR/$_" 739 rename "$DATADIR/$_~", "$DATADIR/$_"
471 or die "$DATADIR/$_: $!"; 740 or die "$DATADIR/$_: $!";

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines