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.36 by root, Sun Jun 10 02:51:46 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 ();
42my $CACHE = 0; 43my $CACHE = 0;
43my $FORCE; 44my $FORCE;
44my $TMPDIR = "/tmp/cfutil$$~"; 45my $TMPDIR = "/tmp/cfutil$$~";
45my $TMPFILE = "aaaa0"; 46my $TMPFILE = "aaaa0";
46 47
48our %COLOR = (
49 black => 0,
50 white => 1,
51 navy => 2,
52 red => 3,
53 orange => 4,
54 blue => 5,
55 darkorange => 6,
56 green => 7,
57 lightgreen => 8,
58 grey => 9,
59 brown => 10,
60 gold => 11,
61 tan => 12,
62);
63
47END { system "rm", "-rf", $TMPDIR } 64END { system "rm", "-rf", $TMPDIR }
48 65
49Event->signal (signal => "INT", cb => sub { exit 1 }); 66Event->signal (signal => "INT", cb => sub { exit 1 });
50Event->signal (signal => "TERM", cb => sub { exit 1 }); 67Event->signal (signal => "TERM", cb => sub { exit 1 });
51 68
68} 85}
69 86
70sub inst_maps($) { 87sub inst_maps($) {
71 my (undef, $path) = @_; 88 my (undef, $path) = @_;
72 89
73 print "installing '$path' to '$DATADIR/maps'\n"; 90 print "\nInstalling '$path' to '$DATADIR/maps'\n\n";
74 91
75 if (!-f "$path/regions") { 92 if (!-f "$path/regions") {
76 warn "'$path' does not look like a maps directory ('regions' file is missing).\n"; 93 warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
77 exit 1 unless $FORCE; 94 exit 1 unless $FORCE;
78 } 95 }
84} 101}
85 102
86{ 103{
87 our %ANIMINFO; 104 our %ANIMINFO;
88 our %FACEINFO; 105 our %FACEINFO;
106 our @ARC;
89 our %ARC; 107 our %ARC;
90 our $TRS; 108 our $TRS;
91 our $NFILE; 109 our $NFILE;
92 110
93 our $QUANTIZE = "+dither -colorspace RGB -colors 256"; 111 our $QUANTIZE = "+dither -colorspace RGB -colors 256";
153 fork_sub { 171 fork_sub {
154 system "convert png:\Q$path\E -depth 8 rgba:-" 172 system "convert png:\Q$path\E -depth 8 rgba:-"
155 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap" 173 . "| $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~" 174 . "| 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 $? ($!)"; 175 and die "convert/hq2xa pipeline error: status $? ($!)";
158 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 176 system $OPTIPNG, "-i0", "-q", "$other~";
159 die "$other~ has zero size, aborting." unless -s "$other~"; 177 die "$other~ has zero size, aborting." unless -s "$other~";
160 rename "$other~", $other; 178 rename "$other~", $other;
161 }; 179 };
162 } 180 }
163 181
169 my $other = "$stem.32x32.png~"; 187 my $other = "$stem.32x32.png~";
170 188
171 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 189 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
172 fork_sub { 190 fork_sub {
173 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 191 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
174 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 192 system $OPTIPNG, "-i0", "-q", "$other~";
193
194 # reduce smoothfaces >10000 bytes
195 if ($stem =~ /_S\./ && (-s "$other~") > 10000) {
196 my $ncolor = 256;
197 while () {
198 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
199 system $OPTIPNG, "-i0", "-q", "$other~~";
200 last if 10000 > -s "$other~~";
201 $ncolor = int $ncolor * 0.9;
202 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
203 }
204
205 printf "reduced %s from %d to %d bytes using %d colours.\n",
206 $other, -s "$other~", -s "$other~~", $ncolor
207 if $VERBOSE >= 2;
208 rename "$other~~", "$other~";
209 }
210
175 die "$other~ has zero size, aborting." unless -s "$other~"; 211 die "$other~ has zero size, aborting." unless -s "$other~";
176 rename "$other~", $other; 212 rename "$other~", $other;
177 }; 213 };
178 } 214 }
179 215
255 my $arc; 291 my $arc;
256 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 292 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
257 293
258 my $arc = read_arch "$dir/$file"; 294 my $arc = read_arch "$dir/$file";
259 for my $o (values %$arc) { 295 for my $o (values %$arc) {
296 push @ARC, $o;
297 for (my $m = $o; $m; $m = $m->{more}) {
260 $ARC{$o->{_name}} = $o; 298 $ARC{$m->{_name}} = $m;
299 }
261 300
262 $o->{editor_folder} = $dir; 301 $o->{editor_folder} = $dir;
263 302
264 my $visibility = delete $o->{visibility}; 303 my $visibility = delete $o->{visibility};
265 my $magicmap = delete $o->{magicmap}; 304 my $magicmap = delete $o->{magicmap};
278 317
279 my $ext = $x|$y ? "+$x+$y" : ""; 318 my $ext = $x|$y ? "+$x+$y" : "";
280 319
281 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 320 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
282 321
283 my $visibility = delete $o->{visibility} if exists $o->{visibility}; 322 $visibility = delete $o->{visibility} if exists $o->{visibility};
284 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap}; 323 $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
285 324
286 my $anim = delete $o->{anim}; 325 my $anim = delete $o->{anim};
287 326
288 if ($anim) { 327 if ($anim) {
289 # possibly add $ext to the animation name to avoid 328 # possibly add $ext to the animation name to avoid
363 } elsif ($file =~ /\.trs$/) { 402 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 403 push @trs, [$path, $file];
365 } elsif ($file =~ /\.arc$/) { 404 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 405 push @arc, [$path, $file];
367 } else { 406 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 407 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 408 }
370 } 409 }
371 }; 410 };
372 } 411 }
373 412
374 sub inst_arch($) { 413 sub inst_arch($) {
375 my (undef, $path) = @_; 414 my (undef, $path) = @_;
376 415
416 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 417 "Installing '$path' to '$DATADIR'\n",
418 "\n",
378 "This can take a long time if you run this\n", 419 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 420 "for the first time or do not use --cache.\n",
380 "\n", 421 "\n",
381 "Unless you run verbosely, all following warning\n", 422 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 423 "or error messages indicate serious problems.\n",
412 if (my $s = $ARC{$other}) { 453 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 454 if ($s->{inherit}) {
414 $loop = $s; 455 $loop = $s;
415 } else { 456 } else {
416 delete $o->{inherit}; 457 delete $o->{inherit};
458 my %s = %$s;
459 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 460 %$o = ( %s, %$o );
418 ++$progress; 461 ++$progress;
419 } 462 }
420 } else { 463 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 464 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 465 delete $ARC{$o->{_name}};
430 473
431 last; 474 last;
432 } 475 }
433 } 476 }
434 477
478 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
479 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
480
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 481 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 482 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 483 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 484 }
439 485
440 { 486 {
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 487 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 488 or die "$DATADIR/treasures~: $!";
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 497 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"; 498 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 499
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 500 $v->{chksum32} = Digest::MD5::md5 $v->{data32};
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 501 $v->{chksum64} = Digest::MD5::md5 $v->{data64};
502
503 if (my $magicmap = $v->{magicmap}) {
504 $magicmap =~ y/A-Z_\-/a-z/d;
505 $v->{magicmap} = $COLOR{$magicmap};
506 }
456 } 507 }
457 508
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 509 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 510 or die "$DATADIR/facedata~: $!";
460 511

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines