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

Diff Legend

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