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.63 by root, Mon Dec 17 08:03:22 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 Crossfire;
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 }
513
514 $meta = {
515 %{ $meta->{"" } || {} },
516 %{ $meta->{$file} || {} },
517 };
518
519 if ($meta->{license} =~ s/^#//) {
520 $meta->{license} = ({
521 "pd" => "Public Domain",
522 "gpl" => "GNU General Public License, version 3.0 or any later",
523 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
524 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/",
525 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
526 })->{$meta->{license}}
527 || warn "$dir/$file: license tag '$meta->{license}' not found.";
528 }
529
530 $file =~ s/\.res$//;
531 $file =~ s/\.(ogg|wav|jpg|png)$//;
532
533 substr $dir, 0, 1 + length $PATH, "";
534
535 if (my $filter = $meta->{cfutil_filter}) {
536 if ($filter eq "yaml2json") {
537 $data = JSON::XS::encode_json YAML::Syck::Load $data;
538 } else {
539 warn "$dir/$file: unknown filter $filter, skipping\n";
540 }
541 }
542
543 $RESOURCE{"$dir/$file"} = {
544 type => (exists $meta->{type} ? delete $meta->{type} : $type),
545 data => $data,
546 %$meta ? (meta => $meta) : (),
547 };
548 }
549 }
550
349 sub find_files; 551 sub find_files;
350 sub find_files { 552 sub find_files {
351 my ($path) = @_; 553 my ($path) = @_;
352 554
353 IO::AIO::aioreq_pri 4; 555 IO::AIO::aioreq_pri 4;
… …
355 my ($dirs, $nondirs) = @_; 557 my ($dirs, $nondirs) = @_;
356 558
357 find_files "$path/$_" 559 find_files "$path/$_"
358 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 560 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;
359 561
562 my $dir = $path;
563 substr $dir, 0, 1 + length $PATH, "";
564
360 for my $file (@$nondirs) { 565 for my $file (@$nondirs) {
566 if ($dir =~ /^music(?:\/|$)/) {
567 $c_res->put ([$path, $file, 3]) # FT_MUSIC
568 if $file =~ /\.(ogg)$/;
569
570 } elsif ($dir =~ /^sound(?:\/|$)/) {
571 $c_res->put ([$path, $file, 5]) # FT_SOUND
572 if $file =~ /\.(wav|ogg)$/;
573
574 } elsif ($dir =~ /^res(?:\/|$)/) {
575 if ($file =~ /\.(jpg|png)$/) {
576 $c_res->put ([$path, $file, 0]) # FT_FACE
577 } elsif ($file =~ /\.(res)$/) {
578 $c_res->put ([$path, $file, 7]) # FT_RSRC
579 } else {
580 $c_res->put ([$path, $file, undef]);
581 }
582
361 if ($file =~ /\.png$/) { 583 } elsif ($file =~ /\.png$/) {
362 push @png, ["$path/$file", 0]; 584 push @c_png, ["$path/$file", 0];
585
363 } elsif ($file =~ /\.trs$/) { 586 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 587 $c_trs->put ([$path, $file]);
588
365 } elsif ($file =~ /\.arc$/) { 589 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 590 $c_arc->put ([$path, $file]);
591
367 } else { 592 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 593 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 594 }
370 } 595 }
371 }; 596 };
372 } 597 }
373 598
374 sub inst_arch($) { 599 sub inst_arch($) {
375 my (undef, $path) = @_; 600 my (undef, $path) = @_;
376 601
602 $PATH = $path;
603
604 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 605 "Installing '$path' to '$DATADIR'\n",
606 "\n",
378 "This can take a long time if you run this\n", 607 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 608 "for the first time or do not use --cache.\n",
380 "\n", 609 "\n",
381 "Unless you run verbosely, all following warning\n", 610 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 611 "or error messages indicate serious problems.\n",
… …
385 if (!-d "$path/treasures") { 614 if (!-d "$path/treasures") {
386 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n"; 615 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
387 exit 1 unless $FORCE; 616 exit 1 unless $FORCE;
388 } 617 }
389 618
619 print "scanning files...\n" if $VERBOSE;
620
390 find_files $path; 621 find_files $path;
622
623 my @a_arc = map +(async \&process_arc), 1..2;
624 my @a_res = map +(async \&process_res), 1..2;
625 my @a_trs = map +(async \&process_trs), 1..2;
626
391 IO::AIO::flush; 627 IO::AIO::flush;
392 628
393 $_->join for ( 629 $c_res->put (undef) for @a_res;
630 $c_arc->put (undef) for @a_arc;
631 $c_trs->put (undef) for @a_trs;
632
633 print "start file scan, arc, res processing...\n" if $VERBOSE;
634
635 $_->join for @a_arc; # need to parse all archetypes before png processing
636
637 print "end arc, start png processing...\n" if $VERBOSE;
638
394 # four png crunchers work fine for my 2x smp machine 639 # four png crunchers work fine for my 2x smp machine
395 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 640 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 641
642 $_->join for (@a_trs, @a_res, @a_png);
643
644 print "scanning done, processing results...\n" if $VERBOSE;
400 { 645 {
401 # remove path prefix from editor_folder 646 # remove path prefix from editor_folder
402 substr $_->{editor_folder}, 0, 1 + length $path, "" 647 substr $_->{editor_folder}, 0, 1 + length $path, ""
403 for values %ARC; 648 for values %ARC;
404 649
650 print "resolving inheritance tree...\n" if $VERBOSE;
405 # resolve inherit 651 # resolve inherit
406 while () { 652 while () {
407 my $progress; 653 my $progress;
408 my $loop; 654 my $loop;
409 655
… …
412 if (my $s = $ARC{$other}) { 658 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 659 if ($s->{inherit}) {
414 $loop = $s; 660 $loop = $s;
415 } else { 661 } else {
416 delete $o->{inherit}; 662 delete $o->{inherit};
663 my %s = %$s;
664 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 665 %$o = ( %s, %$o );
418 ++$progress; 666 ++$progress;
419 } 667 }
420 } else { 668 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 669 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 670 delete $ARC{$o->{_name}};
… …
430 678
431 last; 679 last;
432 } 680 }
433 } 681 }
434 682
683 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
684 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
685
686 print "writing archetypes...\n" if $VERBOSE;
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 687 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 688 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 689 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 690 }
439 691
440 { 692 {
693 print "writing treasures...\n" if $VERBOSE;
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 694 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 695 or die "$DATADIR/treasures~: $!";
443 print $fh $TRS; 696 print $fh $TRS;
444 } 697 }
445 698
446 { 699 {
700 print "processing facedata...\n" if $VERBOSE;
447 while (my ($k, $v) = each %FACEINFO) { 701 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"; 702 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"; 703 length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n";
450 704
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 705 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"; 706 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 707
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 708 if (my $magicmap = $v->{magicmap}) {
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 709 $magicmap =~ y/A-Z_\-/a-z/d;
710 $v->{magicmap} = $COLOR{$magicmap};
456 } 711 }
457 712
713 delete $v->{arc};
714 }
715
716 print "writing facedata...\n" if $VERBOSE;
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 717 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 718 or die "$DATADIR/facedata~: $!";
460 719
461 print $fh freeze { 720 print $fh freeze {
462 version => 2, 721 version => 2,
463 faceinfo => \%FACEINFO, 722 faceinfo => \%FACEINFO,
464 animinfo => \%ANIMINFO, 723 animinfo => \%ANIMINFO,
724 resource => \%RESOURCE,
465 }; 725 };
466 } 726 }
727
728 print "committing files...\n" if $VERBOSE;
467 729
468 for (qw(archetypes facedata treasures)) { 730 for (qw(archetypes facedata treasures)) {
469 chmod 0644, "$DATADIR/$_~"; 731 chmod 0644, "$DATADIR/$_~";
470 rename "$DATADIR/$_~", "$DATADIR/$_" 732 rename "$DATADIR/$_~", "$DATADIR/$_"
471 or die "$DATADIR/$_: $!"; 733 or die "$DATADIR/$_: $!";

Diff Legend

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