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.43 by root, Mon Jul 23 23:38:18 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 ();
20use Crossfire; 21use Crossfire;
21use Coro; 22use Coro;
22use Coro::AIO; 23use Coro::AIO;
23use POSIX (); 24use POSIX ();
24use Digest::MD5; 25use Digest::MD5;
26use Carp;
25use Coro::Storable; $Storable::canonical = 1; 27use Coro::Storable; $Storable::canonical = 1;
28
29$SIG{QUIT} = sub { Carp::cluck "QUIT" };
26 30
27sub usage { 31sub usage {
28 warn <<EOF; 32 warn <<EOF;
29Usage: cfutil [-v] [-q] [--force] [--cache] 33Usage: cfutil [-v] [-q] [--force] [--cache]
30 [--install-arch path] 34 [--install-arch path]
42my $CACHE = 0; 46my $CACHE = 0;
43my $FORCE; 47my $FORCE;
44my $TMPDIR = "/tmp/cfutil$$~"; 48my $TMPDIR = "/tmp/cfutil$$~";
45my $TMPFILE = "aaaa0"; 49my $TMPFILE = "aaaa0";
46 50
51our %COLOR = (
52 black => 0,
53 white => 1,
54 navy => 2,
55 red => 3,
56 orange => 4,
57 blue => 5,
58 darkorange => 6,
59 green => 7,
60 lightgreen => 8,
61 grey => 9,
62 brown => 10,
63 gold => 11,
64 tan => 12,
65);
66
47END { system "rm", "-rf", $TMPDIR } 67END { system "rm", "-rf", $TMPDIR }
48 68
49Event->signal (signal => "INT", cb => sub { exit 1 }); 69Event->signal (signal => "INT", cb => sub { exit 1 });
50Event->signal (signal => "TERM", cb => sub { exit 1 }); 70Event->signal (signal => "TERM", cb => sub { exit 1 });
51 71
68} 88}
69 89
70sub inst_maps($) { 90sub inst_maps($) {
71 my (undef, $path) = @_; 91 my (undef, $path) = @_;
72 92
73 print "installing '$path' to '$DATADIR/maps'\n"; 93 print "\nInstalling '$path' to '$DATADIR/maps'\n\n";
74 94
75 if (!-f "$path/regions") { 95 if (!-f "$path/regions") {
76 warn "'$path' does not look like a maps directory ('regions' file is missing).\n"; 96 warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
77 exit 1 unless $FORCE; 97 exit 1 unless $FORCE;
78 } 98 }
79 99
80 system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded" 100 system $RSYNC, "-a", "--chmod=u=rwX,go=rX", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded"
81 and die "map installation failed.\n"; 101 and die "map installation failed.\n";
82 102
83 print "maps installed successfully.\n"; 103 print "maps installed successfully.\n";
84} 104}
85 105
86{ 106{
87 our %ANIMINFO; 107 our %ANIMINFO;
88 our %FACEINFO; 108 our %FACEINFO;
109 our %RESOURCE;
110 our @ARC;
89 our %ARC; 111 our %ARC;
90 our $TRS; 112 our $TRS;
91 our $NFILE; 113 our $NFILE;
114 our $PATH;
92 115
93 our $QUANTIZE = "+dither -colorspace RGB -colors 256"; 116 our $QUANTIZE = "+dither -colorspace RGB -colors 256";
94 117
95 our (@png, @trs, @arc); # files we are interested in 118 our (@png, @trs, @arc, @res); # files we are interested in
96 119
97 sub commit_png($$$) { 120 sub commit_png($$$) {
98 my ($name, $data, $T) = @_; 121 my ($name, $data, $T) = @_;
99 122
100 $FACEINFO{$name}{"data$T"} = $data; 123 $FACEINFO{$name}{"data$T"} = $data;
153 fork_sub { 176 fork_sub {
154 system "convert png:\Q$path\E -depth 8 rgba:-" 177 system "convert png:\Q$path\E -depth 8 rgba:-"
155 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap" 178 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap"
156 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~" 179 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~"
157 and die "convert/hq2xa pipeline error: status $? ($!)"; 180 and die "convert/hq2xa pipeline error: status $? ($!)";
158 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 181 system $OPTIPNG, "-i0", "-q", "$other~";
159 die "$other~ has zero size, aborting." unless -s "$other~"; 182 die "$other~ has zero size, aborting." unless -s "$other~";
160 rename "$other~", $other; 183 rename "$other~", $other;
161 }; 184 };
162 } 185 }
163 186
169 my $other = "$stem.32x32.png~"; 192 my $other = "$stem.32x32.png~";
170 193
171 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 194 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
172 fork_sub { 195 fork_sub {
173 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 196 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
174 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 197 system $OPTIPNG, "-i0", "-q", "$other~";
198
199 # reduce smoothfaces >10000 bytes
200 if ($stem =~ /_S\./ && (-s "$other~") > 10000) {
201 my $ncolor = 256;
202 while () {
203 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
204 system $OPTIPNG, "-i0", "-q", "$other~~";
205 last if 10000 > -s "$other~~";
206 $ncolor = int $ncolor * 0.9;
207 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
208 }
209
210 printf "reduced %s from %d to %d bytes using %d colours.\n",
211 $other, -s "$other~", -s "$other~~", $ncolor
212 if $VERBOSE >= 2;
213 rename "$other~~", "$other~";
214 }
215
175 die "$other~ has zero size, aborting." unless -s "$other~"; 216 die "$other~ has zero size, aborting." unless -s "$other~";
176 rename "$other~", $other; 217 rename "$other~", $other;
177 }; 218 };
178 } 219 }
179 220
255 my $arc; 296 my $arc;
256 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 297 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
257 298
258 my $arc = read_arch "$dir/$file"; 299 my $arc = read_arch "$dir/$file";
259 for my $o (values %$arc) { 300 for my $o (values %$arc) {
301 push @ARC, $o;
302 for (my $m = $o; $m; $m = $m->{more}) {
260 $ARC{$o->{_name}} = $o; 303 $ARC{$m->{_name}} = $m;
304 }
261 305
262 $o->{editor_folder} = $dir; 306 $o->{editor_folder} = $dir;
263 307
264 my $visibility = delete $o->{visibility}; 308 my $visibility = delete $o->{visibility};
265 my $magicmap = delete $o->{magicmap}; 309 my $magicmap = delete $o->{magicmap};
278 322
279 my $ext = $x|$y ? "+$x+$y" : ""; 323 my $ext = $x|$y ? "+$x+$y" : "";
280 324
281 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 325 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
282 326
283 my $visibility = delete $o->{visibility} if exists $o->{visibility}; 327 $visibility = delete $o->{visibility} if exists $o->{visibility};
284 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap}; 328 $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
285 329
286 my $anim = delete $o->{anim}; 330 my $anim = delete $o->{anim};
287 331
288 if ($anim) { 332 if ($anim) {
289 # possibly add $ext to the animation name to avoid 333 # possibly add $ext to the animation name to avoid
344 388
345 $TRS .= $trs; 389 $TRS .= $trs;
346 } 390 }
347 } 391 }
348 392
393 sub process_res {
394 while (@res) {
395 my ($dir, $file) = @{pop @res};
396
397 my $data;
398 aio_load "$dir/$file", $data;
399
400 my $copyright;
401 aio_load "$dir/copyright", $copyright;
402
403 $file =~ s/\.res$//;
404 $file =~ /\.([^.]+)$/
405 or next;
406
407 my $type = $1;
408
409 substr $dir, 0, 1 + length $PATH, "";
410
411 $RESOURCE{"$dir/$file"} = {
412 type => $1,
413 copyright => $copyright,
414 data => $data,
415 chksum => Digest::MD5::md5 $data,
416 };
417 }
418 }
419
349 sub find_files; 420 sub find_files;
350 sub find_files { 421 sub find_files {
351 my ($path) = @_; 422 my ($path) = @_;
352 423
353 IO::AIO::aioreq_pri 4; 424 IO::AIO::aioreq_pri 4;
355 my ($dirs, $nondirs) = @_; 426 my ($dirs, $nondirs) = @_;
356 427
357 find_files "$path/$_" 428 find_files "$path/$_"
358 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 429 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;
359 430
431 my $dir = $path;
432 substr $dir, 0, 1 + length $PATH, "";
433
360 for my $file (@$nondirs) { 434 for my $file (@$nondirs) {
435 if ($file =~ /\.(ogg|jpg|res)$/ || $dir =~ /^res(?:\/|$)/) {
436 push @res, [$path, $file];
361 if ($file =~ /\.png$/) { 437 } elsif ($file =~ /\.png$/) {
362 push @png, ["$path/$file", 0]; 438 push @png, ["$path/$file", 0];
363 } elsif ($file =~ /\.trs$/) { 439 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 440 push @trs, [$path, $file];
365 } elsif ($file =~ /\.arc$/) { 441 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 442 push @arc, [$path, $file];
367 } else { 443 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 444 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 445 }
370 } 446 }
371 }; 447 };
372 } 448 }
373 449
374 sub inst_arch($) { 450 sub inst_arch($) {
375 my (undef, $path) = @_; 451 my (undef, $path) = @_;
376 452
453 $PATH = $path;
454
455 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 456 "Installing '$path' to '$DATADIR'\n",
457 "\n",
378 "This can take a long time if you run this\n", 458 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 459 "for the first time or do not use --cache.\n",
380 "\n", 460 "\n",
381 "Unless you run verbosely, all following warning\n", 461 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 462 "or error messages indicate serious problems.\n",
393 $_->join for ( 473 $_->join for (
394 # four png crunchers work fine for my 2x smp machine 474 # four png crunchers work fine for my 2x smp machine
395 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 475 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png),
396 (async \&process_trs), (async \&process_trs), 476 (async \&process_trs), (async \&process_trs),
397 (async \&process_arc), (async \&process_arc), 477 (async \&process_arc), (async \&process_arc),
478 (async \&process_res), (async \&process_res),
398 ); 479 );
399 480
400 { 481 {
401 # remove path prefix from editor_folder 482 # remove path prefix from editor_folder
402 substr $_->{editor_folder}, 0, 1 + length $path, "" 483 substr $_->{editor_folder}, 0, 1 + length $path, ""
412 if (my $s = $ARC{$other}) { 493 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 494 if ($s->{inherit}) {
414 $loop = $s; 495 $loop = $s;
415 } else { 496 } else {
416 delete $o->{inherit}; 497 delete $o->{inherit};
498 my %s = %$s;
499 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 500 %$o = ( %s, %$o );
418 ++$progress; 501 ++$progress;
419 } 502 }
420 } else { 503 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 504 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 505 delete $ARC{$o->{_name}};
430 513
431 last; 514 last;
432 } 515 }
433 } 516 }
434 517
518 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
519 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
520
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 521 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 522 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 523 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 524 }
439 525
440 { 526 {
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 527 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 528 or die "$DATADIR/treasures~: $!";
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 537 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"; 538 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 539
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 540 $v->{chksum32} = Digest::MD5::md5 $v->{data32};
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 541 $v->{chksum64} = Digest::MD5::md5 $v->{data64};
542
543 if (my $magicmap = $v->{magicmap}) {
544 $magicmap =~ y/A-Z_\-/a-z/d;
545 $v->{magicmap} = $COLOR{$magicmap};
546 }
456 } 547 }
457 548
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 549 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 550 or die "$DATADIR/facedata~: $!";
460 551
461 print $fh freeze { 552 print $fh freeze {
462 version => 2, 553 version => 2,
463 faceinfo => \%FACEINFO, 554 faceinfo => \%FACEINFO,
464 animinfo => \%ANIMINFO, 555 animinfo => \%ANIMINFO,
556 resource => \%RESOURCE,
465 }; 557 };
466 } 558 }
467 559
468 for (qw(archetypes facedata treasures)) { 560 for (qw(archetypes facedata treasures)) {
469 chmod 0644, "$DATADIR/$_~"; 561 chmod 0644, "$DATADIR/$_~";

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines