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

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

Diff Legend

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