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.52 by root, Sat Aug 18 22:25:35 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 Digest::MD5;
27use Carp;
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 (@png, @trs, @arc, @res); # files we are interested in
96 120
97 sub commit_png($$$) { 121 sub commit_png($$$) {
98 my ($name, $data, $T) = @_; 122 my ($name, $data, $T) = @_;
99 123
100 $FACEINFO{$name}{"data$T"} = $data; 124 $FACEINFO{$name}{"data$T"} = $data;
… …
147 # possibly enlarge 171 # possibly enlarge
148 if (0 > aio_stat "$stem.64x64.png") { 172 if (0 > aio_stat "$stem.64x64.png") {
149 my $other = "$stem.64x64.png~"; 173 my $other = "$stem.64x64.png~";
150 174
151 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 175 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
152 my $wrap = 0; # for the time being
153 fork_sub { 176 fork_sub {
177 my $CROP;
178 my $SRC = "png:\Q$path\E";
179
180 # check if this is a wall. ultra-ugly. ultra-ultra-ugly.
181 if ($path =~ /^(.*\/wall\/.*_)([0-9A-F])(\.x11.*\.png)$/) {
182 my ($pfx, $dir, $sfx) = ($1, hex $2, $3);
183 #check for 0..F images to be sure(?) this is a wall
184 unless (grep { !-e sprintf "%s%X%s", $pfx, $_, $sfx } 0..15) {
185 # add a 4px border and add other images around it
186 $CROP = "-shave 8x8 +repage";
187
188 $w += 8;
189 $h += 8;
190
191 $SRC = "-size ${w}x${h} xc:transparent";
192 $SRC .= " png:\Q$path\E -geometry +4+4 -composite";
193
194 # 8 surrounding images
195 for (
196 # x y b r0 r1
197 [-1, -1, 0, 6],
198 [ 0, -1, 1, 10, 14],
199 [+1, -1, 0, 12],
200
201 [-1, 0, 8, 5, 7],
202 #
203 [+1, 0, 2, 5, 13],
204
205 [-1, +1, 0, 3],
206 [ 0, +1, 4, 10, 11],
207 [+1, +1, 0, 9],
208 ) {
209 my ($x, $y, $d, $r0, $r1) = @$_;
210 $SRC .= sprintf " png:%s%X%s -geometry %+d%+d -composite",
211 "\Q$pfx",
212 ($dir & $d) ? $r1 : $r0,
213 "\Q$sfx",
214 $x * ($w - 8) + 4,
215 $y * ($h - 8) + 4;
216 }
217 }
218 }
219
154 system "convert png:\Q$path\E -depth 8 rgba:-" 220 system "convert -depth 8 $SRC rgba:-"
155 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap" 221 . "| $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~" 222 . "| 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 $? ($!)"; 223 and die "convert/cfhq2xa pipeline error: status $? ($!)";
158 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 224 system $OPTIPNG, "-i0", "-q", "$other~";
159 die "$other~ has zero size, aborting." unless -s "$other~"; 225 die "$other~ has zero size, aborting." unless -s "$other~";
160 rename "$other~", $other; 226 rename "$other~", $other;
161 }; 227 };
162 } 228 }
163 229
… …
169 my $other = "$stem.32x32.png~"; 235 my $other = "$stem.32x32.png~";
170 236
171 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 237 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
172 fork_sub { 238 fork_sub {
173 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 239 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
174 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 240 system $OPTIPNG, "-i0", "-q", "$other~";
241
242 # reduce smoothfaces >10000 bytes
243 if ($stem =~ /_S\./ && (-s "$other~") > 10000) {
244 my $ncolor = 256;
245 while () {
246 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
247 system $OPTIPNG, "-i0", "-q", "$other~~";
248 last if 10000 > -s "$other~~";
249 $ncolor = int $ncolor * 0.9;
250 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
251 }
252
253 printf "reduced %s from %d to %d bytes using %d colours.\n",
254 $other, -s "$other~", -s "$other~~", $ncolor
255 if $VERBOSE >= 2;
256 rename "$other~~", "$other~";
257 }
258
175 die "$other~ has zero size, aborting." unless -s "$other~"; 259 die "$other~ has zero size, aborting." unless -s "$other~";
176 rename "$other~", $other; 260 rename "$other~", $other;
177 }; 261 };
178 } 262 }
179 263
… …
255 my $arc; 339 my $arc;
256 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 340 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
257 341
258 my $arc = read_arch "$dir/$file"; 342 my $arc = read_arch "$dir/$file";
259 for my $o (values %$arc) { 343 for my $o (values %$arc) {
344 push @ARC, $o;
345 for (my $m = $o; $m; $m = $m->{more}) {
260 $ARC{$o->{_name}} = $o; 346 $ARC{$m->{_name}} = $m;
347 }
261 348
262 $o->{editor_folder} = $dir; 349 $o->{editor_folder} = $dir;
263 350
264 my $visibility = delete $o->{visibility}; 351 my $visibility = delete $o->{visibility};
265 my $magicmap = delete $o->{magicmap}; 352 my $magicmap = delete $o->{magicmap};
… …
278 365
279 my $ext = $x|$y ? "+$x+$y" : ""; 366 my $ext = $x|$y ? "+$x+$y" : "";
280 367
281 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 368 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
282 369
283 my $visibility = delete $o->{visibility} if exists $o->{visibility}; 370 $visibility = delete $o->{visibility} if exists $o->{visibility};
284 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap}; 371 $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
285 372
286 my $anim = delete $o->{anim}; 373 my $anim = delete $o->{anim};
287 374
288 if ($anim) { 375 if ($anim) {
289 # possibly add $ext to the animation name to avoid 376 # possibly add $ext to the animation name to avoid
… …
344 431
345 $TRS .= $trs; 432 $TRS .= $trs;
346 } 433 }
347 } 434 }
348 435
436 my %FILECACHE;
437
438 sub load_cached($;$) {
439 unless (exists $FILECACHE{$_[0]}) {
440 my $data;
441 if (0 < aio_load $_[0], $data) {
442 if ($_[1]) {
443 $data = eval { $_[1]->($data) };
444 warn "$_[0]: $@" if $@;
445 }
446 }
447
448 $FILECACHE{$_[0]} = $data;
449 }
450
451 $FILECACHE{$_[0]}
452 }
453
454 sub process_res {
455 while (@res) {
456 my ($dir, $file, $type) = @{pop @res};
457
458 my $data;
459 aio_load "$dir/$file", $data;
460
461 my $meta = load_cached "$dir/meta", sub { JSON::XS::from_json shift };
462
463 next if $meta && !exists $meta->{$file};
464
465 $meta = {
466 %{ $meta->{"" } || {} },
467 %{ $meta->{$file} || {} },
468 };
469
470 if ($meta->{license} =~ s/^#//) {
471 $meta->{license} = ({
472 "pd" => "Public Domain",
473 "gpl" => "GNU General Public License, version 3.0 or any later",
474 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
475 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.5/",
476 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
477 })->{$meta->{license}}
478 || warn "$dir/$file: license tag '$meta->{license}' not found.";
479 }
480
481 $file =~ s/\.res$//;
482 $file =~ s/\.(ogg|wav|jpg|png)$//;
483
484 substr $dir, 0, 1 + length $PATH, "";
485
486 $RESOURCE{"$dir/$file"} = {
487 type => (delete $meta->{type}) || $type,
488 data => $data,
489 chksum => (Digest::MD5::md5 $data),
490 %$meta ? (meta => $meta) : (),
491 };
492 }
493 }
494
349 sub find_files; 495 sub find_files;
350 sub find_files { 496 sub find_files {
351 my ($path) = @_; 497 my ($path) = @_;
352 498
353 IO::AIO::aioreq_pri 4; 499 IO::AIO::aioreq_pri 4;
… …
355 my ($dirs, $nondirs) = @_; 501 my ($dirs, $nondirs) = @_;
356 502
357 find_files "$path/$_" 503 find_files "$path/$_"
358 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 504 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;
359 505
506 my $dir = $path;
507 substr $dir, 0, 1 + length $PATH, "";
508
360 for my $file (@$nondirs) { 509 for my $file (@$nondirs) {
510 if ($dir =~ /^music(?:\/|$)/) {
511 push @res, [$path, $file, 3] # FT_MUSIC
512 if $file =~ /\.(ogg)$/;
513
514 } elsif ($dir =~ /^sound(?:\/|$)/) {
515 push @res, [$path, $file, 5] # FT_SOUND
516 if $file =~ /\.(wav|ogg)$/;
517
518 } elsif ($dir =~ /^res(?:\/|$)/) {
519 push @res, [$path, $file, 0] # FT_FACE
520 if $file =~ /\.(jpg|png)$/;
521 push @res, [$path, $file, 7] # FT_RSRC
522 if $file =~ /\.(res)$/;
523
361 if ($file =~ /\.png$/) { 524 } elsif ($file =~ /\.png$/) {
362 push @png, ["$path/$file", 0]; 525 push @png, ["$path/$file", 0];
526
363 } elsif ($file =~ /\.trs$/) { 527 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 528 push @trs, [$path, $file];
529
365 } elsif ($file =~ /\.arc$/) { 530 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 531 push @arc, [$path, $file];
532
367 } else { 533 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 534 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 535 }
370 } 536 }
371 }; 537 };
372 } 538 }
373 539
374 sub inst_arch($) { 540 sub inst_arch($) {
375 my (undef, $path) = @_; 541 my (undef, $path) = @_;
376 542
543 $PATH = $path;
544
545 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 546 "Installing '$path' to '$DATADIR'\n",
547 "\n",
378 "This can take a long time if you run this\n", 548 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 549 "for the first time or do not use --cache.\n",
380 "\n", 550 "\n",
381 "Unless you run verbosely, all following warning\n", 551 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 552 "or error messages indicate serious problems.\n",
… …
393 $_->join for ( 563 $_->join for (
394 # four png crunchers work fine for my 2x smp machine 564 # four png crunchers work fine for my 2x smp machine
395 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 565 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png),
396 (async \&process_trs), (async \&process_trs), 566 (async \&process_trs), (async \&process_trs),
397 (async \&process_arc), (async \&process_arc), 567 (async \&process_arc), (async \&process_arc),
568 (async \&process_res), (async \&process_res),
398 ); 569 );
399 570
400 { 571 {
401 # remove path prefix from editor_folder 572 # remove path prefix from editor_folder
402 substr $_->{editor_folder}, 0, 1 + length $path, "" 573 substr $_->{editor_folder}, 0, 1 + length $path, ""
… …
412 if (my $s = $ARC{$other}) { 583 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 584 if ($s->{inherit}) {
414 $loop = $s; 585 $loop = $s;
415 } else { 586 } else {
416 delete $o->{inherit}; 587 delete $o->{inherit};
588 my %s = %$s;
589 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 590 %$o = ( %s, %$o );
418 ++$progress; 591 ++$progress;
419 } 592 }
420 } else { 593 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 594 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 595 delete $ARC{$o->{_name}};
… …
430 603
431 last; 604 last;
432 } 605 }
433 } 606 }
434 607
608 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
609 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
610
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 611 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 612 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 613 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 614 }
439 615
440 { 616 {
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 617 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 618 or die "$DATADIR/treasures~: $!";
… …
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 627 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"; 628 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 629
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 630 $v->{chksum32} = Digest::MD5::md5 $v->{data32};
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 631 $v->{chksum64} = Digest::MD5::md5 $v->{data64};
632
633 if (my $magicmap = $v->{magicmap}) {
634 $magicmap =~ y/A-Z_\-/a-z/d;
635 $v->{magicmap} = $COLOR{$magicmap};
636 }
456 } 637 }
457 638
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 639 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 640 or die "$DATADIR/facedata~: $!";
460 641
461 print $fh freeze { 642 print $fh freeze {
462 version => 2, 643 version => 2,
463 faceinfo => \%FACEINFO, 644 faceinfo => \%FACEINFO,
464 animinfo => \%ANIMINFO, 645 animinfo => \%ANIMINFO,
646 resource => \%RESOURCE,
465 }; 647 };
466 } 648 }
467 649
468 for (qw(archetypes facedata treasures)) { 650 for (qw(archetypes facedata treasures)) {
469 chmod 0644, "$DATADIR/$_~"; 651 chmod 0644, "$DATADIR/$_~";

Diff Legend

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