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

Diff Legend

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