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.30 by root, Sat Apr 21 11:55:36 2007 UTC vs.
Revision 1.117 by root, Sat Oct 15 05:06:49 2011 UTC

1#!@PERL@ 1#!@PERL@
2 2
3use strict; 3#
4# This file is part of Deliantra, the Roguelike Realtime MMORPG.
5#
6# Copyright (©) 2007,2008,2009,2010,2011 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
7#
8# Deliantra is free software: you can redistribute it and/or modify it under
9# the terms of the Affero GNU General Public License as published by the
10# Free Software Foundation, either version 3 of the License, or (at your
11# option) any later version.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the Affero GNU General Public License
19# and the GNU General Public License along with this program. If not, see
20# <http://www.gnu.org/licenses/>.
21#
22# The authors can be reached via e-mail to <support@deliantra.net>
23#
24
25use common::sense;
4 26
5my $prefix = "@prefix@"; 27my $prefix = "@prefix@";
6my $exec_prefix = "@exec_prefix@"; 28my $exec_prefix = "@exec_prefix@";
7my $datarootdir = "@datarootdir@"; 29my $datarootdir = "@datarootdir@";
8my $DATADIR = "@datadir@/@PACKAGE@"; 30my $DATADIR = "@datadir@/@PACKAGE@";
9 31
10my $CONVERT = "@CONVERT@"; 32my $CONVERT = "@CONVERT@";
11my $IDENTIFY = "@IDENTIFY@"; 33my $IDENTIFY = "@IDENTIFY@";
12my $OPTIPNG = "@OPTIPNG@"; 34my $OPTIPNG = "@OPTIPNG@";
13my $RSYNC = "@RSYNC@"; 35my $RSYNC = "@RSYNC@";
36my $PNGNQ = "@PNGNQ@";
14 37
15use Getopt::Long; 38use Getopt::Long;
16use Coro::Event; 39use File::Temp;
40use POSIX ();
41use Carp;
42
43use YAML::XS ();
44use Digest::MD5 ();
45use Storable ();
46use JSON::XS ();
47use IO::AIO ();
48use Compress::LZF ();
49
17use AnyEvent; 50use AnyEvent;
18use IO::AIO (); 51use Coro 5.12;
19use File::Temp;
20use Crossfire;
21use Coro; 52use Coro::EV;
22use Coro::AIO; 53use Coro::AIO;
23use POSIX (); 54use Coro::Util;
24use Digest::MD5; 55use Coro::Channel;
56use Coro::AnyEvent;
25use Coro::Storable; $Storable::canonical = 1; 57use Coro::Storable; $Storable::canonical = 1;
58
59use Deliantra;
60
61$SIG{QUIT} = sub { Carp::cluck "QUIT" };
26 62
27sub usage { 63sub usage {
28 warn <<EOF; 64 warn <<EOF;
29Usage: cfutil [-v] [-q] [--force] [--cache] 65Usage: cfutil [-v] [-q] [--force] [--cache]
30 [--install-arch path] 66 [--install-arch path]
… …
41my $VERBOSE = 1; 77my $VERBOSE = 1;
42my $CACHE = 0; 78my $CACHE = 0;
43my $FORCE; 79my $FORCE;
44my $TMPDIR = "/tmp/cfutil$$~"; 80my $TMPDIR = "/tmp/cfutil$$~";
45my $TMPFILE = "aaaa0"; 81my $TMPFILE = "aaaa0";
82my @COMMIT;
83
84our %COLOR = (
85 # original cf colours
86 black => 0,
87 white => 1,
88 navy => 2, # "dark blue"
89 red => 3,
90 orange => 4,
91 blue => 5, # "light blue"
92 darkorange => 6,
93 green => 7,
94 lightgreen => 8,
95 grey => 9,
96 brown => 10, # "yellow"
97 gold => 11, # "light yellow"
98 tan => 12, # yellowish gray
99
100 # new for deliantra
101 none => 13,
102
103 # compatibility to existing archetypes
104 lightblue => 5,
105 gray => 9,
106 yellow => 11,
107 khaki => 12,
108);
46 109
47END { system "rm", "-rf", $TMPDIR } 110END { system "rm", "-rf", $TMPDIR }
48 111
49Event->signal (signal => "INT", cb => sub { exit 1 }); 112my $s_INT = AE::signal INT => sub { exit 1 };
50Event->signal (signal => "TERM", cb => sub { exit 1 }); 113my $s_TERM = AE::signal TERM => sub { exit 1 };
114
115our %hash;
116
117# here we could try to avoid collisions and reduce chksum size further
118sub make_hash($\$\$;$) {
119 my ($id, $dataref, $hashref, $clen) = @_;
120
121 my $hash = substr +(Digest::MD5::md5 $$dataref), 0, $clen || 5;
122
123 if (exists $hash{$hash}) {
124 # hash collision, but some files are simply identical
125 if (${$hash{$hash}[1]} ne $$dataref) {
126 warn "ERROR: hash collision $hash{$hash}[0] vs. $id (increase the default \$clen in make_hash?)\n";
127 exit 1;
128 } else {
129 print "$hash{$hash}[0] and $id are identical (which is fine).\n" if $VERBOSE >= 3;
130 }
131 }
132 $hash{$hash} = [$id, $dataref, $hashref];
133
134 $$hashref = $hash;
135}
136
137sub optipng($) {
138 system $OPTIPNG, "-o5", "-i0", "-q", $_[0];
139 die "$_[0] has zero size, aborting." unless -s $_[0];
140}
51 141
52mkdir $TMPDIR, 0700 142mkdir $TMPDIR, 0700
53 or die "$TMPDIR: $!"; 143 or die "$TMPDIR: $!";
54 144
55sub fork_sub(&) { 145sub fork_exec(&) {
56 my ($cb) = @_; 146 my ($cb) = @_;
57 147
58 if (my $pid = fork) { 148 if (my $pid = fork) {
59 my $current = $Coro::current; 149 my $current = $Coro::current;
60 my $w = AnyEvent->child (pid => $pid, cb => sub { $current->ready }); 150 my $w = AnyEvent->child (pid => $pid, cb => sub { $current->ready });
… …
65 warn $@; 155 warn $@;
66 POSIX::_exit 1; 156 POSIX::_exit 1;
67 } 157 }
68} 158}
69 159
160sub imgsize($) {
161 open my $fh, "-|", $IDENTIFY, qw(-ping -format %w,%h --), $_[0]
162 or die "$IDENTIFY: $!";
163
164 Coro::AnyEvent::readable $fh;
165
166 my ($w, $h) = split /,/, <$fh>;
167
168 ($w+0, $h+0)
169}
170
171# make $dst from $src, if not uptodate, by calling $how
172sub make_file($$$) {
173 my ($src, $dst, $how) = @_;
174
175 my $t = (aio_stat $dst) ? -1 : (stat _)[9];
176
177 for (ref $src ? @$src : $src) {
178 aio_stat $_
179 and die "$_: $!";
180
181 if ((stat _)[9] > $t) {
182 # outdated, redo
183 $how->();
184 last;
185 }
186 }
187}
188
70sub inst_maps($) { 189sub inst_maps($) {
71 my (undef, $path) = @_; 190 my (undef, $path) = @_;
72 191
73 print "\nInstalling '$path' to '$DATADIR/maps'\n\n"; 192 print "\nInstalling '$path' to '$DATADIR/maps'\n\n";
74 193
75 if (!-f "$path/regions") { 194 if (!-f "$path/regions") {
76 warn "'$path' does not look like a maps directory ('regions' file is missing).\n"; 195 warn "ERROR: '$path' does not look like a maps directory ('regions' file is missing).\n";
77 exit 1 unless $FORCE; 196 exit 1 unless $FORCE;
78 } 197 }
79 198
80 system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded" 199 system $RSYNC, "-av", "--chmod=u=rwX,go=rX",
200 "$path/.", "$DATADIR/maps/.",
201 "--exclude", "CVS", "--exclude", "/world-precomposed",
202 "--delete", "--delete-excluded"
81 and die "map installation failed.\n"; 203 and die "map installation failed.\n";
82 204
83 print "maps installed successfully.\n"; 205 print "maps installed successfully.\n";
84} 206}
85 207
86{ 208{
87 our %ANIMINFO; 209 our %ANIMINFO;
88 our %FACEINFO; 210 our %FACEINFO;
211 our %RESOURCE;
89 our @ARC; 212 our @ARC;
90 our %ARC; 213 our %ARC;
91 our $TRS; 214 our $TRS;
215 our %PNG;
92 our $NFILE; 216 our $NFILE;
217 our $PATH;
93 218
94 our $QUANTIZE = "+dither -colorspace RGB -colors 256"; 219 our $QUANTIZE = "+dither -colorspace RGB -colors 256";
95 220
96 our (@png, @trs, @arc); # files we are interested in 221 our $c_arc = new Coro::Channel;
222 our $c_any = new Coro::Channel;
97 223
224 our @c_png;
225
98 sub commit_png($$$) { 226 sub commit_png($$$$) {
99 my ($name, $data, $T) = @_; 227 my ($stem, $name, $data, $T) = @_;
100 228
229 $FACEINFO{$name}{"stem"} = substr $stem, 1 + length $PATH;
101 $FACEINFO{$name}{"data$T"} = $data; 230 $FACEINFO{$name}{"data$T"} = $data;
102 } 231 }
103 232
104 sub process_png { 233 sub process_png {
105 while (@png) { 234 while (@c_png) {
106 my ($path, $delete) = @{pop @png}; 235 my ($path, $delete) = @{pop @c_png};
107 236
108 my $png; 237 my $png;
109 aio_lstat $path; 238 aio_lstat $path;
110 my ($size, $mtime) = (stat _)[7,9]; 239 my ($size, $mtime) = (stat _)[7,9];
111 240
112 if (0 > aio_load $path, $png) { 241 if (0 > aio_load $path, $png) {
113 warn "$path: $!, skipping.\n"; 242 warn "ERROR: $path: $!, skipping.\n";
114 next; 243 next;
115 } 244 }
116 245
117 my $stem = $path; 246 my $stem = $path;
118 my $T; 247 my $T;
… …
120 if ($stem =~ s/\.32x32\.png~?$//) { 249 if ($stem =~ s/\.32x32\.png~?$//) {
121 $T = 32; 250 $T = 32;
122 } elsif ($stem =~ s/\.64x64\.png~?$//) { 251 } elsif ($stem =~ s/\.64x64\.png~?$//) {
123 $T = 64; 252 $T = 64;
124 } else { 253 } else {
125 warn "$path: weird filename, skipping.\n"; 254 warn "ERROR: $path: weird filename, skipping.\n";
126 next; 255 next;
127 } 256 }
128 257
129 # quickly extract width and height of the (necessarily PNG) image 258 # quickly extract width and height of the (necessarily PNG) image
130 unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) { 259 unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) {
131 warn "$path: not a recognized png file, skipping.\n"; 260 warn "ERROR: $path: not a recognized png file, skipping.\n";
132 next; 261 next;
133 } 262 }
134 263
135 my ($w, $h) = unpack "NN", $1; 264 my ($w, $h) = unpack "NN", $1;
136 265
137 if ($w < $T || $h < $T) { 266 if ($w < $T || $h < $T) {
138 warn "$path: too small ($w $h), skipping.\n"; 267 warn "ERROR: $path: too small ($w $h), skipping.\n";
139 next; 268 next;
140 } 269 }
141 270
142 if ($w % $T || $h % $T) { 271 if ($w % $T || $h % $T) {
143 warn "$path: weird png size ($w $h), skipping.\n"; 272 warn "ERROR: $path: weird png size ($w $h), skipping.\n";
144 next; 273 next;
145 } 274 }
275
276 (my $base = $stem) =~ s/^.*\///;
277
278 my $fi = $FACEINFO{$base};
279 unless ($fi) {
280 #warn "$path: <$base> not referenced by any archetype, skipping.\n";
281 #next;
282 }
283
284 my $arc = $fi->{arc} || { };
146 285
147 unless ($path =~ /~$/) { 286 unless ($path =~ /~$/) {
148 # possibly enlarge 287 # possibly enlarge
149 if (0 > aio_stat "$stem.64x64.png") { 288 if (0 > aio_stat "$stem.64x64.png") {
150 my $other = "$stem.64x64.png~"; 289 my $other = "$stem.64x64.png~";
151 290
152 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 291 make_file $path, $other, sub {
153 my $wrap = 0; # for the time being
154 fork_sub { 292 fork_exec {
293 my $CROP;
294 my $SRC = "png:\Q$path\E";
295
296 my $is_floor = $arc->{is_floor};
297 my $is_wall = 0;
298
299 my ($wall_pfx, $wall_dir, $wall_sfx);
300
301 if (
302 !$is_floor
303 && !$arc->{alive}
304 && $arc->{move_block} eq "all"
305 && $path =~ /^(.*_)([0-9A-F])(\.x11.*\.png)$/
306 ) {
307 ($wall_pfx, $wall_dir, $wall_sfx) = ($1, hex $2, $3);
308
309 unless (grep { !-e sprintf "%s%X%s", $wall_pfx, $_, $wall_sfx } 0..15) {
310 $is_wall = 1;
311 }
312 }
313
314 if ($is_wall || $is_floor) {
315 # add a 4px border and add other images around it
316 $CROP = "-shave 8x8 +repage";
317
318 $w += 8;
319 $h += 8;
320
321 $SRC = "-size ${w}x${h} xc:transparent";
322 $SRC .= " png:\Q$path\E -geometry +4+4 -composite";
323
324 # 8 surrounding images
325 for (
326 # x y b r0 r1
327 [-1, -1, 0, 6],
328 [ 0, -1, 1, 10, 14],
329 [+1, -1, 0, 12],
330
331 [-1, 0, 8, 5, 7],
332 #
333 [+1, 0, 2, 5, 13],
334
335 [-1, +1, 0, 3],
336 [ 0, +1, 4, 10, 11],
337 [+1, +1, 0, 9],
338 ) {
339 my ($x, $y, $d, $r0, $r1) = @$_;
340
341 my $tile = $is_floor ? $path
342 : $is_wall ? sprintf "%s%X%s", $wall_pfx, ($wall_dir & $d) ? $r1 : $r0, $wall_sfx
343 : die;
344
345 $SRC .= sprintf " png:%s -geometry %+d%+d -composite",
346 "\Q$tile",
347 $x * ($w - 8) + 4,
348 $y * ($h - 8) + 4;
349 }
350 }
351
155 system "convert png:\Q$path\E -depth 8 rgba:-" 352 system "convert -depth 8 $SRC rgba:-"
156 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap" 353 . "| $exec_prefix/bin/cfhq2xa $w $h 0"
157 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~" 354 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $CROP $QUANTIZE -quality 00 png32:\Q$other\E~"
158 and die "convert/hq2xa pipeline error: status $? ($!)"; 355 and die "convert/cfhq2xa pipeline error: status $? ($!)";
159 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 356 optipng "$other~";
357 rename "$other~", $other;
358 };
359 };
360
361 push @c_png, [$other, !$CACHE];
362 }
363
364 # possibly scale down
365 if (0 > aio_stat "$stem.32x32.png") {
366 my $other = "$stem.32x32.png~";
367
368 make_file $path, $other, sub {
369 fork_exec {
370 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
371 optipng "$other~";
372
373 # reduce smoothfaces >10000 bytes
374 # obsolete, no longer required
375 if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) {
376 my $ncolor = 256;
377 while () {
378 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
379 optipng "$other~~";
380 last if 10000 > -s "$other~~";
381 $ncolor = int $ncolor * 0.9;
382 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
383 }
384
385 printf "reduced %s from %d to %d bytes using %d colours.\n",
386 $other, -s "$other~", -s "$other~~", $ncolor
387 if $VERBOSE >= 2;
388 rename "$other~~", "$other~";
389 }
390
160 die "$other~ has zero size, aborting." unless -s "$other~"; 391 die "$other~ has zero size, aborting." unless -s "$other~";
161 rename "$other~", $other; 392 rename "$other~", $other;
162 }; 393 };
163 } 394 };
164 395
396 #warn "scaled down $path to $other\n";#d#
165 push @png, [$other, !$CACHE]; 397 push @c_png, [$other, !$CACHE];
398 }
166 } 399 }
167 400
168 # possibly scale down 401 (my $face = $stem) =~ s/^.*\///;
169 if (0 > aio_stat "$stem.32x32.png") {
170 my $other = "$stem.32x32.png~";
171 402
172 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 403 for (@{ $fi->{derive} }) {
404 my ($dir, $type) = @$_;
405
406 my $geom = "${T}x${T}";
407 my $dpath = "$dir/$type:$face.$geom.png~";
408
409 if ($type eq "buildmaterial") {
410 my $ov = "$PATH/mapbuilding/buildmaterial.png";
411 make_file [$path, $ov], $dpath, sub {
173 fork_sub { 412 fork_exec {
174 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 413 system "$CONVERT -size 64x64 xc:transparent \\( \Q$path\E -geometry 52x52+6+6 \\) -composite \Q$ov\E -composite -geometry $geom png:\Q$dpath\E~";
175 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 414 optipng "$dpath~";
176 die "$other~ has zero size, aborting." unless -s "$other~";
177 rename "$other~", $other; 415 rename "$dpath~", $dpath;
178 }; 416 };
179 } 417 };
180 418 } elsif ($type eq "buildmaterial-box") {
181 #warn "scaled down $path to $other\n";#d# 419 my $ov = "$PATH/mapbuilding/buildmaterial-box.png";
182 push @png, [$other, !$CACHE]; 420 make_file [$path, $ov], $dpath, sub {
421 fork_exec {
422 system "$CONVERT \Q$ov\E "
423 . "\\( \Q$path\E -trim -geometry 34x31\\> "
424 . "-gravity center -background transparent -extent 37x34 +gravity "
425 . "-geometry +22+6 \\) -composite "
426 . "-geometry $geom png:\Q$dpath\E~";
427 optipng "$dpath~";
428 rename "$dpath~", $dpath;
429 };
183 } 430 };
431 } elsif ($type eq "buildmaterial-sbox") {
432 my $ov = "$PATH/mapbuilding/buildmaterial-sbox.png";
433 make_file [$path, $ov], $dpath, sub {
434 fork_exec {
435 system "$CONVERT \Q$ov\E "
436 . "\\( \Q$path\E -trim -geometry 16x24\\> "
437 . "-gravity center -background transparent -extent 18x26 +gravity "
438 . "-geometry +26+16 \\) -composite "
439 . "-geometry $geom png:\Q$dpath\E~";
440 optipng "$dpath~";
441 rename "$dpath~", $dpath;
442 };
443 };
444 } else {
445 warn "ERROR: facename $type:$face contains unsupported derivation type.\n";
184 } 446 }
185 447
186 (my $face = $stem) =~ s/^.*\///; 448 aio_load $dpath, my $png;
449 IO::AIO::aio_unlink $dpath unless $CACHE;
450 commit_png "$dir/$type:$face", "$type:$face", $png, $T;
451 }
187 452
188 # split all bigfaces, but avoid smoothfaces (*_S) 453 # split all bigfaces, but avoid smoothfaces (*_S)
189 if (($w > $T || $h > $T) && $face !~ /_S\./) { 454 if (($w > $T || $h > $T) && $face !~ /_S\./) {
190 # split 455 # split
191 my @tile; 456 my @tile;
… …
196 push @tile, [$x, $y, $file, (stat _)[9]]; 461 push @tile, [$x, $y, $file, (stat _)[9]];
197 } 462 }
198 } 463 }
199 464
200 my $mtime = (lstat $path)[9]; 465 my $mtime = (lstat $path)[9];
201 my @todo = grep { $_->[3] <= $mtime } @tile; 466 my @todo = grep { $_->[3] < $mtime } @tile;
202 if (@todo) { 467 if (@todo) {
203 fork_sub { 468 fork_exec {
204 open my $convert, "|-", $CONVERT, 469 open my $convert, "|-", $CONVERT,
205 "png:-", 470 "png:-",
206 (map { 471 (map {
207 ( 472 (
208 "(", 473 "(",
… …
221 print $convert $png; 486 print $convert $png;
222 close $convert; 487 close $convert;
223 488
224 # pass 2, optimise, and rename 489 # pass 2, optimise, and rename
225 for (@todo) { 490 for (@todo) {
226 system $OPTIPNG, "-o5", "-i0", "-q", "$_->[2]~"; 491 optipng "$_->[2]~";
227 die "$_->[2]~ has zero size, aborting." unless -s "$_->[2]~";
228 rename "$_->[2]~", $_->[2]; 492 rename "$_->[2]~", $_->[2];
229 } 493 }
230 }; 494 };
231 } 495 }
232 496
… …
236 500
237 if (0 > aio_load $file, $tile) { 501 if (0 > aio_load $file, $tile) {
238 die "$path: unable to read tile +$x+$y, aborting.\n"; 502 die "$path: unable to read tile +$x+$y, aborting.\n";
239 } 503 }
240 IO::AIO::aio_unlink $file unless $CACHE; 504 IO::AIO::aio_unlink $file unless $CACHE;
241 commit_png $x|$y ? "$face+$x+$y" : $face, $tile, $T; 505 commit_png $stem, $x|$y ? "$face+$x+$y" : $face, $tile, $T;
242 } 506 }
243 } else { 507 } else {
244 # use as-is (either small, use smooth) 508 # use as-is (either small, use smooth)
245 commit_png $face, $png, $T; 509 commit_png $stem, $face, $png, $T;
246 } 510 }
247 511
248 aio_unlink $path if $delete; 512 IO::AIO::aio_unlink $path if $delete;
513 }
514 }
515
516 sub process_faceinfo {
517 my ($dir, $file) = @_;
518 my $path = "$dir/$file";
519
520 my $data;
521 if (0 > aio_load $path, $data) {
522 warn "ERROR: $path: $!, skipping.\n";
523 return;
524 }
525
526 for (split /\n/, $data) {
527 chomp;
528 my ($face, $visibility, $fg, $bg, $glyph) = split /\s+/, $_, 5;
529 # bg not used except for text clients
530
531 utf8::decode $glyph;
532 $glyph =~ s/^\?(?=.)//; # remove "autoglyph" flag
533 $glyph =~ s/^"(.+)"$/$1/; # allow for ""-style quoting
534
535 $fg = "white" if $fg eq "none"; # lots of faces have no fg colour yet
536
537 (my $fgi = $COLOR{$fg})
538 // warn "ERROR: $path: $face specifies unknown foreground colour '$fg'.\n";
539 (my $bgi = $COLOR{$bg})
540 // warn "ERROR: $path: $face specifies unknown background colour '$bg'.\n";
541
542 my $fi = $FACEINFO{$face} ||= { };
543 $fi->{visibility} = $visibility * 1;
544 $fi->{magicmap} = $fgi; # foreground colour becomes magicmap
545
546 $glyph .= " " if 2 > length $glyph; # TODO kanji
547 die "glyph $face too long" if 2 < length $glyph;
548
549 $fi->{glyph} = "";
550 for (split //, $glyph) {
551 utf8::encode $_;
552 $fi->{glyph} .= (chr $fgi) . (chr $bgi) . $_;
553 }
249 } 554 }
250 } 555 }
251 556
252 sub process_arc { 557 sub process_arc {
253 while (@arc) { 558 while (my ($dir, $file) = @{ $c_arc->get }) {
254 my ($dir, $file) = @{pop @arc};
255
256 my $arc; 559 my $arc;
257 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 560 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
258 561
259 my $arc = read_arch "$dir/$file"; 562 my $arc = read_arch "$dir/$file";
260 for my $o (values %$arc) { 563 for my $o (values %$arc) {
261 push @ARC, $o; 564 push @ARC, $o;
262 for (my $m = $o; $m; $m = $m->{more}) { 565 for (my $m = $o; $m; $m = $m->{more}) {
263 $ARC{$m->{_name}} = $m; 566 $ARC{$m->{_name}} = $m;
264 } 567 }
265 568
266 $o->{editor_folder} = $dir; 569 $o->{editor_folder} ||= "\x00$dir"; # horrible kludge
267
268 my $visibility = delete $o->{visibility};
269 my $magicmap = delete $o->{magicmap};
270 570
271 # find upper left corner :/ 571 # find upper left corner :/
272 # omg, this is sooo broken 572 # omg, this is sooo broken
273 my ($dx, $dy); 573 my ($dx, $dy);
274 for (my $o = $o; $o; $o = $o->{more}) { 574 for (my $o = $o; $o; $o = $o->{more}) {
… …
281 my $y = $o->{y} - $dy; 581 my $y = $o->{y} - $dy;
282 582
283 my $ext = $x|$y ? "+$x+$y" : ""; 583 my $ext = $x|$y ? "+$x+$y" : "";
284 584
285 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 585 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
286
287 my $visibility = delete $o->{visibility} if exists $o->{visibility};
288 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
289 586
290 my $anim = delete $o->{anim}; 587 my $anim = delete $o->{anim};
291 588
292 if ($anim) { 589 if ($anim) {
293 # possibly add $ext to the animation name to avoid 590 # possibly add $ext to the animation name to avoid
… …
311 facings => $facings, 608 facings => $facings,
312 frames => \@frames, 609 frames => \@frames,
313 }; 610 };
314 } 611 }
315 612
316 for my $face ($o->{face} || (), @{$anim || []}) { 613 for ($o->{face} || (), @{$anim || []}) {
614 next if /^facings\s/;
615
616 my $face = $_;
617 $face =~ s/\+\d+\+\d+$//; # remove tile offset coordinates
618
619 # handle derived faces
620 if ($face =~ /^([^:]+):(.*)/) {
621 my ($type, $base) = ($1, $2);
622 push @{ $FACEINFO{$base}{derive} }, [$dir, $type];
623 }
624
625 $FACEINFO{$face}{arc} = $o;
626
317 next if $face =~ /^facings\s|^blank.x11$|^empty.x11$/; 627 next if $face =~ /^blank.x11$|^empty.x11$/;
318
319 my $info = $FACEINFO{$face} ||= {};
320
321 $info->{visibility} = $visibility if defined $visibility;
322 $info->{magicmap} = $magicmap if defined $magicmap;
323 } 628 }
324 629
325 if (my $smooth = delete $o->{smoothface}) { 630 if (my $smooth = delete $o->{smoothface}) {
326 my %kv =split /\s+/, $smooth; 631 my %kv = split /\s+/, $smooth;
327 my $level = $o->{smoothlevel}; #TODO: delete from $o if !gcfclient-support 632 my $level = $o->{smoothlevel}; #TODO: delete from $o if !gcfclient-support
328 while (my ($face, $smooth) = each %kv) { 633 while (my ($face, $smooth) = each %kv) {
634 $FACEINFO{$smooth}{arc} = $o;
635
329 $FACEINFO{$face}{smooth} = $smooth; 636 $FACEINFO{$face}{smooth} = $smooth;
330 $FACEINFO{$face}{smoothlevel} = $level; 637 $FACEINFO{$face}{smoothlevel} = $level;
331 } 638 }
332 } 639 }
333 } 640 }
334 } 641 }
335 } 642 }
336 } 643 }
337 644
338 sub process_trs { 645 sub process_trs {
339 while (@trs) {
340 my ($dir, $file) = @{pop @trs}; 646 my ($dir, $file) = @_;
341 my $path = "$dir/$file"; 647 my $path = "$dir/$file";
342 648
343 my $trs; 649 my $trs;
344 if (0 > aio_load $path, $trs) { 650 if (0 > aio_load $path, $trs) {
345 warn "$path: $!, skipping.\n"; 651 warn "ERROR: $path: $!, skipping.\n";
652 return;
653 }
654
655 $TRS .= $trs;
656 }
657
658 my %FILECACHE;
659
660 sub load_cached($;$) {
661 unless (exists $FILECACHE{$_[0]}) {
662 my $data;
663 if (0 < aio_load $_[0], $data) {
664 if ($_[1]) {
665 $data = eval { $_[1]->($data) };
666 warn "ERROR: $_[0]: $@" if $@;
346 next; 667 }
668 }
669
670 $FILECACHE{$_[0]} = $data;
671 }
672
673 $FILECACHE{$_[0]}
674 }
675
676 # convert an image and a palette to some indexed 2d-matrix structure
677 sub process_plt {
678 my ($base, $plt) = @_;
679
680 my ($w, $h) = imgsize "$base.png";
681
682 $w * $h
683 or die "$base.png: unable to identify correct size\n";
684
685 my @plt;
686 my %map;
687
688 for (split /\n/, $plt) {
689 next unless /\S/;
690 next if /^\s*#/;
691
692 /^([0-9a-fA-F]{3,6})\s*(.*?)\s*$/
693 or die "unparseable palette entry for $base.plt: $_";
694
695 my ($rgb, $name) = ($1, $2);
696
697 $rgb =~ s/^(.)(.)(.)$/$1$1$2$2$3$3/;
698
699 $map{pack "H*", $rgb} = chr @plt;
700 push @plt, $name;
701 }
702
703 make_file ["$base.plt", "$base.png"], "$base.tbl~", sub {
704 warn "building $base\n" if $VERBOSE >= 3;
705
706 fork_exec {
707 open my $png, "-|", $CONVERT, qw(-depth 8 --), "$base.png", "rgb:"
708 or die "$base.png: $!";
709
710 local $/;
711 $png = <$png>;
712
713 $w * $h * 3 == length $png
714 or die "$base.png: failed to read enough data from file\n";
715
716 $png =~ s/(...)/$map{$1}/ge;
717
718 $w * $h == length $png
719 or die "$base.png: failed to map all data - wrong palette?\n";
720
721 {
722 open my $fh, ">:raw", "$base.tbl~~"
723 or die "$base.tbl~~: $!";
724 syswrite $fh, $png;
725 }
726
727 rename "$base.tbl~~", "$base.tbl~";
347 } 728 };
729 };
348 730
349 $TRS .= $trs; 731 0 <= aio_load "$base.tbl~", my $tbl
732 or die "$base.tbl~: $!";
733
734 IO::AIO::aio_unlink "$base.tbl~" unless $CACHE;
735
736 Compress::LZF::compress nfreeze {
737 w => $w,
738 h => $h,
739 plt => \@plt,
740 tbl => $tbl,
741 }
742 }
743
744 sub process_res {
745 my ($dir, $file, $type) = @_;
746
747 0 <= aio_load "$dir/$file", my $data
748 or die "$dir/$file: $!";
749
750 my $meta = load_cached "$dir/meta", sub { JSON::XS->new->utf8->relaxed->decode (shift) };
751
752 utf8::decode $dir;
753 utf8::decode $file;
754
755 # a meta file for resources is now mandatory
756 unless (exists $meta->{$file}) {
757 warn "skipping $dir/$file\n" if $VERBOSE >= 3;
758 return;
759 }
760
761 $meta = {
762 %{ $meta->{"" } || {} },
763 %{ $meta->{$file} || {} },
764 };
765
766 if ($meta->{license} =~ s/^#//) {
767 $meta->{license} = ({
768 "pd" => "Public Domain",
769 "gpl" => "GNU General Public License, version 3.0 or any later",
770 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
771 "cc/by/2.1" => "Licensed under Creative Commons Attribution 2.1 http://creativecommons.org/licenses/by/2.1/",
772 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/",
773 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
774 })->{$meta->{license}}
775 || warn "ERROR: $dir/$file: license tag '$meta->{license}' not found.";
776 }
777
778 if (!exists $meta->{author} && $meta->{source} =~ m%^http://www.jamendo.com/en/artist/(.*)$%) {
779 ($meta->{author} = $1) =~ s/_/ /g;
780 }
781
782 $file =~ s/\.res$//;
783 $file =~ s/\.(ogg|wav|jpg|png)$//;
784
785 if ($file =~ s/\.plt$//) {
786 $data = process_plt "$dir/$file", $data;
787 } elsif (my $filter = $meta->{cfutil_filter}) {
788 if ($filter eq "yaml2json") {
789 $data = JSON::XS::encode_json YAML::XS::Load $data;
790 } elsif ($filter eq "json2json") {
791 $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data);
792 } elsif ($filter eq "perl2json") {
793 $data = eval $data; die if $@;
794 $data = JSON::XS::encode_json $data;
795 } else {
796 warn "ERROR: $dir/$file: unknown filter $filter, skipping\n";
797 }
798 }
799
800 substr $dir, 0, 1 + length $PATH, "";
801
802 $RESOURCE{"$dir/$file"} = {
803 type => (exists $meta->{type} ? delete $meta->{type} : $type),
804 data => $data,
805 %$meta ? (meta => $meta) : (),
806 };
807 }
808
809 sub process_any {
810 while (my ($func, @args) = @{ $c_any->get }) {
811 $func->(@args);
350 } 812 }
351 } 813 }
352 814
353 sub find_files; 815 sub find_files;
354 sub find_files { 816 sub find_files {
355 my ($path) = @_; 817 my ($path) = @_;
356 818
819 my $grp = IO::AIO::aio_group;
820
821 my $scandir; $scandir = sub {
822 my ($path) = @_;
823
357 IO::AIO::aioreq_pri 4; 824 IO::AIO::aioreq_pri 4;
358 IO::AIO::aio_scandir $path, 4, sub { 825 add $grp IO::AIO::aio_scandir $path, 4, sub {
359 my ($dirs, $nondirs) = @_; 826 my ($dirs, $nondirs) = @_;
360 827
361 find_files "$path/$_" 828 $scandir->("$path/$_")
362 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 829 for grep $_ !~ /^(?:CVS|dev|\..*)$/, @$dirs;
363 830
831 my $dir = $path;
832 substr $dir, 0, 1 + length $PATH, "";
833
364 for my $file (@$nondirs) { 834 for my $file (@$nondirs) {
835 if ($dir =~ /^music(?:\/|$)/) {
836 $c_any->put ([\&process_res, $path, $file, 3]) # FT_MUSIC
837 if $file =~ /\.(ogg)$/;
838
839 } elsif ($dir =~ /^sound(?:\/|$)/) {
840 $c_any->put ([\&process_res, $path, $file, 5]) # FT_SOUND
841 if $file =~ /\.(wav|ogg)$/;
842
843 } elsif ($dir =~ /^res(?:\/|$)/) {
844 if ($file =~ /\.(jpg|png)$/) {
845 $c_any->put ([\&process_res, $path, $file, 0]) # FT_FACE
846 } elsif ($file =~ /\.(res)$/) {
847 $c_any->put ([\&process_res, $path, $file, 6]) # FT_RSRC
848 } else {
849 $c_any->put ([\&process_res, $path, $file, undef]);
850 }
851
365 if ($file =~ /\.png$/) { 852 } elsif ($file =~ /\.png$/) {
366 push @png, ["$path/$file", 0]; 853 $PNG{$file} = $path;
854
855 } elsif ($file =~ /\.faceinfo$/) {
856 $c_any->put ([\&process_faceinfo, $path, $file]);
857
367 } elsif ($file =~ /\.trs$/) { 858 } elsif ($file =~ /\.trs$/) {
368 push @trs, [$path, $file]; 859 $c_any->put ([\&process_trs, $path, $file]);
860
369 } elsif ($file =~ /\.arc$/) { 861 } elsif ($file =~ /\.arc$/) {
370 push @arc, [$path, $file]; 862 $c_arc->put ([$path, $file]);
863
371 } else { 864 } else {
372 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 865 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
373 } 866 }
867 }
374 } 868 };
375 }; 869 };
870
871 $scandir->($path);
872 aio_wait $grp;
873 }
874
875 sub generate_plurals {
876# use Lingua::EN::Inflect ();
877# Lingua::EN::Inflect::classical;
878# Lingua::EN::Inflect::def_noun '(.*)staff' => '$1staves'; # policy
879# Lingua::EN::Inflect::def_noun '(.*)boots' => '$1boots'; # hack
880#
881# for my $a (@ARC) {
882# my $name = $a->{name} || $a->{_name};
883#
884# next unless $a->{name_pl};
885# next if $a->{invisible};
886# next if $a->{is_floor};
887# next if $a->{no_pick};
888#
889# my $test = Lingua::EN::Inflect::PL_N_eq $name, Lingua::EN::Inflect::PL $name;
890# my $pl = $test =~ /^(?:eq|p:.)$/
891# ? $name
892# : Lingua::EN::Inflect::PL $name;
893#
894# if ($pl ne $a->{name_pl}) {
895# warn "$a->{_name}: plural differs, $pl vs $a->{name_pl}\n";
896# }
897# }
376 } 898 }
377 899
378 sub inst_arch($) { 900 sub inst_arch($) {
379 my (undef, $path) = @_; 901 my (undef, $path) = @_;
902
903 $PATH = $path;
380 904
381 print "\n", 905 print "\n",
382 "Installing '$path' to '$DATADIR'\n", 906 "Installing '$path' to '$DATADIR'\n",
383 "\n", 907 "\n",
384 "This can take a long time if you run this\n", 908 "This can take a long time if you run this\n",
… …
387 "Unless you run verbosely, all following warning\n", 911 "Unless you run verbosely, all following warning\n",
388 "or error messages indicate serious problems.\n", 912 "or error messages indicate serious problems.\n",
389 "\n"; 913 "\n";
390 914
391 if (!-d "$path/treasures") { 915 if (!-d "$path/treasures") {
392 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n"; 916 warn "FATAL: '$path' does not look like an arch directory ('treasures' directory is missing).\n";
393 exit 1 unless $FORCE; 917 exit 1 unless $FORCE;
394 } 918 }
395 919
920 print "starting file scan, arc, any processing...\n" if $VERBOSE;
921
922 my @a_arc = map +(async \&process_arc), 1..2;
923 my @a_any = map +(async \&process_any), 1..4;
924
396 find_files $path; 925 find_files $path;
397 IO::AIO::flush;
398 926
399 $_->join for ( 927 $c_arc->shutdown;
928 $c_any->shutdown;
929
930 $_->join for @a_arc; # need to parse all archetypes before png processing
931 print "finished arc processing...\n" if $VERBOSE;
932
933 # fill png queue
934 for (keys %FACEINFO) {
935 # we only expect source pngs to exist for non-derived
936 # faces, i.e. no split tiles (+x+x) and no face derivates
937 # (xxx:)
938 /^[^:]+\....$/
939 or next;
940
941 my $seen;
942
943 if (exists $PNG{"$_.32x32.png"}) {
944 push @c_png, ["$PNG{\"$_.32x32.png\"}/$_.32x32.png"];
945 $seen = 1;
946 }
947 if (exists $PNG{"$_.64x64.png"}) {
948 push @c_png, ["$PNG{\"$_.64x64.png\"}/$_.64x64.png"];
949 $seen = 1;
950 }
951
952 warn "ERROR: $_: face not found, expect problems.\n"
953 unless $seen;
954 }
955
956 print "starting png processing...\n" if $VERBOSE;
957
400 # four png crunchers work fine for my 2x smp machine 958 # eight png crunchers work fine for my 4x smp machine
401 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 959 my @a_png = map +(async \&process_png), 1..8;
402 (async \&process_trs), (async \&process_trs),
403 (async \&process_arc), (async \&process_arc),
404 );
405 960
961 $_->join for @a_any;
962 print "finished any processing...\n" if $VERBOSE;
963
964 $_->join for @a_png;
965 print "finished png processing...\n" if $VERBOSE;
966
967 print "scanning done, processing results...\n" if $VERBOSE;
406 { 968 {
407 # remove path prefix from editor_folder 969 # remove path prefix from editor_folder
970 $_->{editor_folder} =~ /^\x00/
408 substr $_->{editor_folder}, 0, 1 + length $path, "" 971 and substr $_->{editor_folder}, 0, 2 + length $path, ""
409 for values %ARC; 972 for values %ARC;
410 973
974 print "resolving inheritance tree...\n" if $VERBOSE;
411 # resolve inherit 975 # resolve inherit
412 while () { 976 while () {
413 my $progress; 977 my $progress;
414 my $loop; 978 my $loop;
415 979
416 for my $o (values %ARC) { 980 for my $o (values %ARC) {
417 if (my $other = $o->{inherit}) { 981 for my $other (split /,/, $o->{inherit}) {
418 if (my $s = $ARC{$other}) { 982 if (my $s = $ARC{$other}) {
419 if ($s->{inherit}) { 983 if ($s->{inherit}) {
420 $loop = $s; 984 $loop = $s;
421 } else { 985 } else {
422 delete $o->{inherit}; 986 delete $o->{inherit};
… …
424 delete @s{qw(_name more name name_pl)}; 988 delete @s{qw(_name more name name_pl)};
425 %$o = ( %s, %$o ); 989 %$o = ( %s, %$o );
426 ++$progress; 990 ++$progress;
427 } 991 }
428 } else { 992 } else {
429 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 993 warn "ERROR: archetype '$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
430 delete $ARC{$o->{_name}}; 994 delete $ARC{$o->{_name}};
431 } 995 }
432 } 996 }
433 } 997 }
434 998
… …
438 1002
439 last; 1003 last;
440 } 1004 }
441 } 1005 }
442 1006
1007 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
1008 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
1009
1010 # fix up archetypes without names, where the archanme doesn't work at all
1011 for (@ARC) {
1012 if (!exists $_->{name} and $_->{_name} =~ /_/) {
1013 for ($_->{name} = $_->{_name}) {
1014 s/(?:_\d+)+$//;
1015 s/_[nesw]+$//;
1016 y/_/ /;
1017 }
1018 }
1019 }
1020
1021 #print "generating plurals...\n" if $VERBOSE;
1022 #generate_plurals;
1023
1024 printf "writing %d archetypes...\n", scalar @ARC if $VERBOSE;
443 open my $fh, ">:utf8", "$DATADIR/archetypes~" 1025 open my $fh, ">:utf8", "$DATADIR/archetypes~"
444 or die "$DATADIR/archetypes~: $!"; 1026 or die "$DATADIR/archetypes~: $!";
445 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; 1027 print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
446 } 1028 }
447 1029
448 { 1030 {
1031 printf "writing treasures (%d octets)...\n", length $TRS if $VERBOSE;
449 open my $fh, ">:utf8", "$DATADIR/treasures~" 1032 open my $fh, ">:utf8", "$DATADIR/treasures~"
450 or die "$DATADIR/treasures~: $!"; 1033 or die "$DATADIR/treasures~: $!";
451 print $fh $TRS; 1034 print $fh $TRS;
452 } 1035 }
453 1036
454 { 1037 {
1038 print "processing facedata...\n" if $VERBOSE;
455 while (my ($k, $v) = each %FACEINFO) { 1039 while (my ($k, $v) = each %FACEINFO) {
456 length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n"; 1040 length $v->{data32} or warn "ERROR: face '$k' has no png32 - this will not work.\n";
457 length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n"; 1041 length $v->{data64} or warn "ERROR: face '$k' has no png64 - this will not work.\n";
458 1042
1043 make_hash $k, $v->{data32}, $v->{hash32};
1044 make_hash $k, $v->{data64}, $v->{hash64};
1045
459 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 1046 #length $v->{data32} <= 10000 or warn "WARNING: face '$k' has face32 larger than 10000 bytes, will not work with crossfire client.\n";
460 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n"; 1047 #length $v->{data64} <= 10000 or warn "WARNING: face '$k' has face64 larger than 10000 bytes.\n";
461 1048
462 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 1049 $v->{glyph} // warn "ERROR: face '$k' has no glyph - missing faceinfo entry?\n";
463 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 1050 $v->{visibility} // warn "ERROR: face '$k' has no visibility info - missing faceinfo entry?\n";
1051 $v->{magicmap} // warn "ERROR: face '$k' has no foreground colour - missing faceinfo entry?\n";
1052
1053 delete @$v{qw(arc stem derive)}; # not used by the server
1054 }
1055
1056 print "processing resources...\n" if $VERBOSE;
1057 my $enc = JSON::XS->new->utf8->canonical->relaxed;
1058 while (my ($k, $v) = each %RESOURCE) {
1059
1060 if ($v->{meta} && $v->{meta}{datadir}) {
1061 delete $RESOURCE{$k};
1062
1063 $k =~ s/^res\/// or die "$k: datadir files must be in res/";
1064
1065 printf "writing $k (%d octets)...\n", length $v->{data} if $VERBOSE;
1066 open my $fh, ">:raw", "$DATADIR/$k~"
1067 or die "$DATADIR/$k~: $!";
1068 syswrite $fh, $v->{data};
1069 push @COMMIT, $k;
1070
1071 } else {
1072 if ($v->{type} & 1) {
1073 # prepend meta info
1074
1075 my $meta = $enc->encode ({
1076 name => $k,
1077 %{ $v->{meta} || {} },
1078 });
1079
1080 $v->{data} = pack "(w/a*)*", $meta, $v->{data};
1081 }
1082
1083 make_hash $k, $v->{data}, $v->{hash}, 6; # 6 for the benefit of existing clients
464 } 1084 }
1085 }
1086
1087 printf "writing facedata (%d faces, %d anims, %d resources)...\n",
1088 scalar keys %FACEINFO,
1089 scalar keys %ANIMINFO,
1090 scalar keys %RESOURCE
1091 if $VERBOSE;
465 1092
466 open my $fh, ">:perlio", "$DATADIR/facedata~" 1093 open my $fh, ">:perlio", "$DATADIR/facedata~"
467 or die "$DATADIR/facedata~: $!"; 1094 or die "$DATADIR/facedata~: $!";
468 1095
469 print $fh freeze { 1096 print $fh nfreeze {
470 version => 2, 1097 version => 2,
471 faceinfo => \%FACEINFO, 1098 faceinfo => \%FACEINFO,
472 animinfo => \%ANIMINFO, 1099 animinfo => \%ANIMINFO,
1100 resource => \%RESOURCE,
473 }; 1101 };
474 } 1102 }
475 1103
1104 print "committing files...\n" if $VERBOSE;
1105
476 for (qw(archetypes facedata treasures)) { 1106 for (qw(archetypes facedata treasures), @COMMIT) {
477 chmod 0644, "$DATADIR/$_~"; 1107 chmod 0644, "$DATADIR/$_~";
478 rename "$DATADIR/$_~", "$DATADIR/$_" 1108 rename "$DATADIR/$_~", "$DATADIR/$_"
479 or die "$DATADIR/$_: $!"; 1109 or die "$DATADIR/$_: $!";
480 } 1110 }
481 1111

Diff Legend

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