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.66 by root, Thu Dec 27 15:43:11 2007 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::Event;
17use AnyEvent; 18use AnyEvent;
19use YAML::Syck ();
20use JSON::XS ();
18use IO::AIO (); 21use IO::AIO ();
19use File::Temp; 22use File::Temp;
20use Crossfire; 23use Deliantra;
21use Coro; 24use Coro;
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 }); 72Event->signal (signal => "INT", cb => sub { exit 1 });
50Event->signal (signal => "TERM", cb => sub { exit 1 }); 73Event->signal (signal => "TERM", cb => sub { exit 1 });
51 74
… …
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 if ($stem =~ /_S\./ && (-s "$other~") > 10000) {
279 my $ncolor = 256;
280 while () {
281 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
282 system $OPTIPNG, "-i0", "-q", "$other~~";
283 last if 10000 > -s "$other~~";
284 $ncolor = int $ncolor * 0.9;
285 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
286 }
287
288 printf "reduced %s from %d to %d bytes using %d colours.\n",
289 $other, -s "$other~", -s "$other~~", $ncolor
290 if $VERBOSE >= 2;
291 rename "$other~~", "$other~";
292 }
293
175 die "$other~ has zero size, aborting." unless -s "$other~"; 294 die "$other~ has zero size, aborting." unless -s "$other~";
176 rename "$other~", $other; 295 rename "$other~", $other;
177 }; 296 };
178 } 297 }
179 298
180 #warn "scaled down $path to $other\n";#d# 299 #warn "scaled down $path to $other\n";#d#
181 push @png, [$other, !$CACHE]; 300 push @c_png, [$other, !$CACHE];
182 } 301 }
183 } 302 }
184 303
185 (my $face = $stem) =~ s/^.*\///; 304 (my $face = $stem) =~ s/^.*\///;
186 305
… …
247 aio_unlink $path if $delete; 366 aio_unlink $path if $delete;
248 } 367 }
249 } 368 }
250 369
251 sub process_arc { 370 sub process_arc {
252 while (@arc) { 371 while (my $job = $c_arc->get) {
253 my ($dir, $file) = @{pop @arc}; 372 my ($dir, $file) = @$job;
254 373
255 my $arc; 374 my $arc;
256 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 375 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
257 376
258 my $arc = read_arch "$dir/$file"; 377 my $arc = read_arch "$dir/$file";
259 for my $o (values %$arc) { 378 for my $o (values %$arc) {
379 push @ARC, $o;
380 for (my $m = $o; $m; $m = $m->{more}) {
260 $ARC{$o->{_name}} = $o; 381 $ARC{$m->{_name}} = $m;
382 }
261 383
262 $o->{editor_folder} = $dir; 384 $o->{editor_folder} = $dir;
263 385
264 my $visibility = delete $o->{visibility}; 386 my $visibility = delete $o->{visibility};
265 my $magicmap = delete $o->{magicmap}; 387 my $magicmap = delete $o->{magicmap};
… …
278 400
279 my $ext = $x|$y ? "+$x+$y" : ""; 401 my $ext = $x|$y ? "+$x+$y" : "";
280 402
281 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 403 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
282 404
283 my $visibility = delete $o->{visibility} if exists $o->{visibility}; 405 $visibility = delete $o->{visibility} if exists $o->{visibility};
284 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap}; 406 $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
285 407
286 my $anim = delete $o->{anim}; 408 my $anim = delete $o->{anim};
287 409
288 if ($anim) { 410 if ($anim) {
289 # possibly add $ext to the animation name to avoid 411 # possibly add $ext to the animation name to avoid
… …
307 facings => $facings, 429 facings => $facings,
308 frames => \@frames, 430 frames => \@frames,
309 }; 431 };
310 } 432 }
311 433
312 for my $face ($o->{face} || (), @{$anim || []}) { 434 for ($o->{face} || (), @{$anim || []}) {
313 next if $face =~ /^facings\s|^blank.x11$|^empty.x11$/; 435 next if /^facings\s/;
314 436
437 my $face = $_;
438 $face =~ s/\+\d+\+\d+$//; # remove tile offset coordinates
439
315 my $info = $FACEINFO{$face} ||= {}; 440 my $info = $FACEINFO{$face} ||= { };
441 $info->{arc} = $o;
442
443 next if $face =~ /^blank.x11$|^empty.x11$/;
316 444
317 $info->{visibility} = $visibility if defined $visibility; 445 $info->{visibility} = $visibility if defined $visibility;
318 $info->{magicmap} = $magicmap if defined $magicmap; 446 $info->{magicmap} = $magicmap if defined $magicmap;
319 } 447 }
320 448
321 if (my $smooth = delete $o->{smoothface}) { 449 if (my $smooth = delete $o->{smoothface}) {
322 my %kv =split /\s+/, $smooth; 450 my %kv = split /\s+/, $smooth;
323 my $level = $o->{smoothlevel}; #TODO: delete from $o if !gcfclient-support 451 my $level = $o->{smoothlevel}; #TODO: delete from $o if !gcfclient-support
324 while (my ($face, $smooth) = each %kv) { 452 while (my ($face, $smooth) = each %kv) {
453 $FACEINFO{$smooth}{arc} = $o;
454
325 $FACEINFO{$face}{smooth} = $smooth; 455 $FACEINFO{$face}{smooth} = $smooth;
326 $FACEINFO{$face}{smoothlevel} = $level; 456 $FACEINFO{$face}{smoothlevel} = $level;
327 } 457 }
328 } 458 }
329 } 459 }
330 } 460 }
331 } 461 }
332 } 462 }
333 463
334 sub process_trs { 464 sub process_trs {
335 while (@trs) { 465 while (my $job = $c_trs->get) {
336 my ($dir, $file) = @{pop @trs}; 466 my ($dir, $file) = @$job;
337 my $path = "$dir/$file"; 467 my $path = "$dir/$file";
338 468
339 my $trs; 469 my $trs;
340 if (0 > aio_load $path, $trs) { 470 if (0 > aio_load $path, $trs) {
341 warn "$path: $!, skipping.\n"; 471 warn "$path: $!, skipping.\n";
… …
344 474
345 $TRS .= $trs; 475 $TRS .= $trs;
346 } 476 }
347 } 477 }
348 478
479 my %FILECACHE;
480
481 sub load_cached($;$) {
482 unless (exists $FILECACHE{$_[0]}) {
483 my $data;
484 if (0 < aio_load $_[0], $data) {
485 if ($_[1]) {
486 $data = eval { $_[1]->($data) };
487 warn "$_[0]: $@" if $@;
488 }
489 }
490
491 $FILECACHE{$_[0]} = $data;
492 }
493
494 $FILECACHE{$_[0]}
495 }
496
497 sub process_res {
498 while (my $job = $c_res->get) {
499 my ($dir, $file, $type) = @$job;
500
501 my $data;
502 aio_load "$dir/$file", $data;
503
504 my $meta = load_cached "$dir/meta", sub { JSON::XS->new->utf8->relaxed->decode (shift) };
505
506 utf8::decode $dir;
507 utf8::decode $file;
508
509 # a meta file for resources is now mandatory
510 unless (exists $meta->{$file}) {
511 warn "skipping $dir/$file\n" if $VERBOSE >= 3;
512 next;
513 }
514
515 $meta = {
516 %{ $meta->{"" } || {} },
517 %{ $meta->{$file} || {} },
518 };
519
520 if ($meta->{license} =~ s/^#//) {
521 $meta->{license} = ({
522 "pd" => "Public Domain",
523 "gpl" => "GNU General Public License, version 3.0 or any later",
524 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
525 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/",
526 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
527 })->{$meta->{license}}
528 || warn "$dir/$file: license tag '$meta->{license}' not found.";
529 }
530
531 $file =~ s/\.res$//;
532 $file =~ s/\.(ogg|wav|jpg|png)$//;
533
534 substr $dir, 0, 1 + length $PATH, "";
535
536 if (my $filter = $meta->{cfutil_filter}) {
537 if ($filter eq "yaml2json") {
538 $data = JSON::XS::encode_json YAML::Syck::Load $data;
539 } elsif ($filter eq "json2json") {
540 $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data);
541 } elsif ($filter eq "perl2json") {
542 $data = eval $data; die if $@;
543 $data = JSON::XS::encode_json $data;
544 } else {
545 warn "$dir/$file: unknown filter $filter, skipping\n";
546 }
547 }
548
549 $RESOURCE{"$dir/$file"} = {
550 type => (exists $meta->{type} ? delete $meta->{type} : $type),
551 data => $data,
552 %$meta ? (meta => $meta) : (),
553 };
554 }
555 }
556
349 sub find_files; 557 sub find_files;
350 sub find_files { 558 sub find_files {
351 my ($path) = @_; 559 my ($path) = @_;
352 560
353 IO::AIO::aioreq_pri 4; 561 IO::AIO::aioreq_pri 4;
… …
355 my ($dirs, $nondirs) = @_; 563 my ($dirs, $nondirs) = @_;
356 564
357 find_files "$path/$_" 565 find_files "$path/$_"
358 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 566 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;
359 567
568 my $dir = $path;
569 substr $dir, 0, 1 + length $PATH, "";
570
360 for my $file (@$nondirs) { 571 for my $file (@$nondirs) {
572 if ($dir =~ /^music(?:\/|$)/) {
573 $c_res->put ([$path, $file, 3]) # FT_MUSIC
574 if $file =~ /\.(ogg)$/;
575
576 } elsif ($dir =~ /^sound(?:\/|$)/) {
577 $c_res->put ([$path, $file, 5]) # FT_SOUND
578 if $file =~ /\.(wav|ogg)$/;
579
580 } elsif ($dir =~ /^res(?:\/|$)/) {
581 if ($file =~ /\.(jpg|png)$/) {
582 $c_res->put ([$path, $file, 0]) # FT_FACE
583 } elsif ($file =~ /\.(res)$/) {
584 $c_res->put ([$path, $file, 7]) # FT_RSRC
585 } else {
586 $c_res->put ([$path, $file, undef]);
587 }
588
361 if ($file =~ /\.png$/) { 589 } elsif ($file =~ /\.png$/) {
362 push @png, ["$path/$file", 0]; 590 push @c_png, ["$path/$file", 0];
591
363 } elsif ($file =~ /\.trs$/) { 592 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 593 $c_trs->put ([$path, $file]);
594
365 } elsif ($file =~ /\.arc$/) { 595 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 596 $c_arc->put ([$path, $file]);
597
367 } else { 598 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 599 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 600 }
370 } 601 }
371 }; 602 };
372 } 603 }
373 604
374 sub inst_arch($) { 605 sub inst_arch($) {
375 my (undef, $path) = @_; 606 my (undef, $path) = @_;
376 607
608 $PATH = $path;
609
610 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 611 "Installing '$path' to '$DATADIR'\n",
612 "\n",
378 "This can take a long time if you run this\n", 613 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 614 "for the first time or do not use --cache.\n",
380 "\n", 615 "\n",
381 "Unless you run verbosely, all following warning\n", 616 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 617 "or error messages indicate serious problems.\n",
… …
385 if (!-d "$path/treasures") { 620 if (!-d "$path/treasures") {
386 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n"; 621 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
387 exit 1 unless $FORCE; 622 exit 1 unless $FORCE;
388 } 623 }
389 624
625 print "scanning files...\n" if $VERBOSE;
626
390 find_files $path; 627 find_files $path;
628
629 my @a_arc = map +(async \&process_arc), 1..2;
630 my @a_res = map +(async \&process_res), 1..2;
631 my @a_trs = map +(async \&process_trs), 1..2;
632
391 IO::AIO::flush; 633 IO::AIO::flush;
392 634
393 $_->join for ( 635 $c_res->put (undef) for @a_res;
636 $c_arc->put (undef) for @a_arc;
637 $c_trs->put (undef) for @a_trs;
638
639 print "start file scan, arc, res processing...\n" if $VERBOSE;
640
641 $_->join for @a_arc; # need to parse all archetypes before png processing
642
643 print "end arc, start png processing...\n" if $VERBOSE;
644
394 # four png crunchers work fine for my 2x smp machine 645 # four png crunchers work fine for my 2x smp machine
395 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 646 my @a_png = map +(async \&process_png), 1..4;
396 (async \&process_trs), (async \&process_trs),
397 (async \&process_arc), (async \&process_arc),
398 );
399 647
648 $_->join for (@a_trs, @a_res, @a_png);
649
650 print "scanning done, processing results...\n" if $VERBOSE;
400 { 651 {
401 # remove path prefix from editor_folder 652 # remove path prefix from editor_folder
402 substr $_->{editor_folder}, 0, 1 + length $path, "" 653 substr $_->{editor_folder}, 0, 1 + length $path, ""
403 for values %ARC; 654 for values %ARC;
404 655
656 print "resolving inheritance tree...\n" if $VERBOSE;
405 # resolve inherit 657 # resolve inherit
406 while () { 658 while () {
407 my $progress; 659 my $progress;
408 my $loop; 660 my $loop;
409 661
… …
412 if (my $s = $ARC{$other}) { 664 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 665 if ($s->{inherit}) {
414 $loop = $s; 666 $loop = $s;
415 } else { 667 } else {
416 delete $o->{inherit}; 668 delete $o->{inherit};
669 my %s = %$s;
670 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 671 %$o = ( %s, %$o );
418 ++$progress; 672 ++$progress;
419 } 673 }
420 } else { 674 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 675 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 676 delete $ARC{$o->{_name}};
… …
430 684
431 last; 685 last;
432 } 686 }
433 } 687 }
434 688
689 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
690 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
691
692 print "writing archetypes...\n" if $VERBOSE;
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 693 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 694 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 695 print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 696 }
439 697
440 { 698 {
699 print "writing treasures...\n" if $VERBOSE;
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 700 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 701 or die "$DATADIR/treasures~: $!";
443 print $fh $TRS; 702 print $fh $TRS;
444 } 703 }
445 704
446 { 705 {
706 print "processing facedata...\n" if $VERBOSE;
447 while (my ($k, $v) = each %FACEINFO) { 707 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"; 708 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"; 709 length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n";
450 710
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 711 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"; 712 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 713
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 714 if (my $magicmap = $v->{magicmap}) {
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 715 $magicmap =~ y/A-Z_\-/a-z/d;
716 $v->{magicmap} = $COLOR{$magicmap};
456 } 717 }
457 718
719 delete $v->{arc};
720 }
721
722 print "writing facedata...\n" if $VERBOSE;
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 723 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 724 or die "$DATADIR/facedata~: $!";
460 725
461 print $fh freeze { 726 print $fh freeze {
462 version => 2, 727 version => 2,
463 faceinfo => \%FACEINFO, 728 faceinfo => \%FACEINFO,
464 animinfo => \%ANIMINFO, 729 animinfo => \%ANIMINFO,
730 resource => \%RESOURCE,
465 }; 731 };
466 } 732 }
733
734 print "committing files...\n" if $VERBOSE;
467 735
468 for (qw(archetypes facedata treasures)) { 736 for (qw(archetypes facedata treasures)) {
469 chmod 0644, "$DATADIR/$_~"; 737 chmod 0644, "$DATADIR/$_~";
470 rename "$DATADIR/$_~", "$DATADIR/$_" 738 rename "$DATADIR/$_~", "$DATADIR/$_"
471 or die "$DATADIR/$_: $!"; 739 or die "$DATADIR/$_: $!";

Diff Legend

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