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.111 by root, Fri Apr 22 02:03:12 2011 UTC vs.
Revision 1.115 by root, Sat May 14 17:41:57 2011 UTC

1#!@PERL@ 1#!@PERL@
2 2
3# 3#
4# This file is part of Deliantra, the Roguelike Realtime MMORPG. 4# This file is part of Deliantra, the Roguelike Realtime MMORPG.
5# 5#
6# Copyright (©) 2007,2008,2009,2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team 6# Copyright (©) 2007,2008,2009,2010,2011 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
7# 7#
8# Deliantra is free software: you can redistribute it and/or modify it under 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 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 10# Free Software Foundation, either version 3 of the License, or (at your
11# option) any later version. 11# option) any later version.
… …
116 116
117# here we could try to avoid collisions and reduce chksum size further 117# here we could try to avoid collisions and reduce chksum size further
118sub make_hash($\$\$;$) { 118sub make_hash($\$\$;$) {
119 my ($id, $dataref, $hashref, $clen) = @_; 119 my ($id, $dataref, $hashref, $clen) = @_;
120 120
121 my $hash = substr +(Digest::MD5::md5 $$dataref), 0, $clen || 4; 121 my $hash = substr +(Digest::MD5::md5 $$dataref), 0, $clen || 5;
122 122
123 if (exists $hash{$hash}) { 123 if (exists $hash{$hash}) {
124 # hash collision, but some files are simply identical 124 # hash collision, but some files are simply identical
125 if (${$hash{$hash}[1]} ne $$dataref) { 125 if (${$hash{$hash}[1]} ne $$dataref) {
126 warn "hash collision $hash{$hash}[0] vs. $id\n"; 126 warn "hash collision $hash{$hash}[0] vs. $id (increase the default \$clen in make_hash?)\n";
127 exit 1; 127 exit 1;
128 } else { 128 } else {
129 print "$hash{$hash}[0] and $id are identical (which is fine).\n" if $VERBOSE >= 3; 129 print "$hash{$hash}[0] and $id are identical (which is fine).\n" if $VERBOSE >= 3;
130 } 130 }
131 } 131 }
132 $hash{$hash} = [$id, $dataref, $hashref]; 132 $hash{$hash} = [$id, $dataref, $hashref];
133 133
134 $$hashref = $hash; 134 $$hashref = $hash;
135}
136
137sub optipng($) {
138 system $OPTIPNG, "-o5", "-i0", "-q", $_[0];
139 die "$_[0] has zero size, aborting." unless -s $_[0];
135} 140}
136 141
137mkdir $TMPDIR, 0700 142mkdir $TMPDIR, 0700
138 or die "$TMPDIR: $!"; 143 or die "$TMPDIR: $!";
139 144
… …
345 350
346 system "convert -depth 8 $SRC rgba:-" 351 system "convert -depth 8 $SRC rgba:-"
347 . "| $exec_prefix/bin/cfhq2xa $w $h 0" 352 . "| $exec_prefix/bin/cfhq2xa $w $h 0"
348 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $CROP $QUANTIZE -quality 00 png32:\Q$other\E~" 353 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $CROP $QUANTIZE -quality 00 png32:\Q$other\E~"
349 and die "convert/cfhq2xa pipeline error: status $? ($!)"; 354 and die "convert/cfhq2xa pipeline error: status $? ($!)";
350 system $OPTIPNG, "-i0", "-q", "$other~"; 355 optipng "$other~";
351 die "$other~ has zero size, aborting." unless -s "$other~";
352 rename "$other~", $other; 356 rename "$other~", $other;
353 }; 357 };
354 }; 358 };
355 359
356 push @c_png, [$other, !$CACHE]; 360 push @c_png, [$other, !$CACHE];
… …
361 my $other = "$stem.32x32.png~"; 365 my $other = "$stem.32x32.png~";
362 366
363 make_file $path, $other, sub { 367 make_file $path, $other, sub {
364 fork_exec { 368 fork_exec {
365 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 369 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
366 system $OPTIPNG, "-i0", "-q", "$other~"; 370 optipng "$other~";
367 371
368 # reduce smoothfaces >10000 bytes 372 # reduce smoothfaces >10000 bytes
369 # obsolete, no longer required 373 # obsolete, no longer required
370 if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) { 374 if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) {
371 my $ncolor = 256; 375 my $ncolor = 256;
372 while () { 376 while () {
373 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E"; 377 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
374 system $OPTIPNG, "-i0", "-q", "$other~~"; 378 optipng "$other~~";
375 last if 10000 > -s "$other~~"; 379 last if 10000 > -s "$other~~";
376 $ncolor = int $ncolor * 0.9; 380 $ncolor = int $ncolor * 0.9;
377 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes"; 381 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
378 } 382 }
379 383
… …
431 print $convert $png; 435 print $convert $png;
432 close $convert; 436 close $convert;
433 437
434 # pass 2, optimise, and rename 438 # pass 2, optimise, and rename
435 for (@todo) { 439 for (@todo) {
436 system $OPTIPNG, "-o5", "-i0", "-q", "$_->[2]~"; 440 optipng "$_->[2]~";
437 die "$_->[2]~ has zero size, aborting." unless -s "$_->[2]~";
438 rename "$_->[2]~", $_->[2]; 441 rename "$_->[2]~", $_->[2];
439 } 442 }
440 }; 443 };
441 } 444 }
442 445
… …
626 my @plt; 629 my @plt;
627 my %map; 630 my %map;
628 631
629 for (split /\n/, $plt) { 632 for (split /\n/, $plt) {
630 next unless /\S/; 633 next unless /\S/;
634 next if /^\s*#/;
631 635
632 /^([0-9a-fA-F]{3,6})\s*(.*?)\s*$/ 636 /^([0-9a-fA-F]{3,6})\s*(.*?)\s*$/
633 or die "unparseable palette entry for $base.plt: $_"; 637 or die "unparseable palette entry for $base.plt: $_";
634 638
635 my ($rgb, $name) = ($1, $2); 639 my ($rgb, $name) = ($1, $2);
… …
855 if (!-d "$path/treasures") { 859 if (!-d "$path/treasures") {
856 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n"; 860 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
857 exit 1 unless $FORCE; 861 exit 1 unless $FORCE;
858 } 862 }
859 863
860 print "start file scan, arc, any processing...\n" if $VERBOSE; 864 print "starting file scan, arc, any processing...\n" if $VERBOSE;
861 865
862 my @a_arc = map +(async \&process_arc), 1..2; 866 my @a_arc = map +(async \&process_arc), 1..2;
863 my @a_any = map +(async \&process_any), 1..4; 867 my @a_any = map +(async \&process_any), 1..4;
864 868
865 find_files $path; 869 find_files $path;
866 870
867 $c_arc->shutdown; 871 $c_arc->shutdown;
868 $c_any->shutdown; 872 $c_any->shutdown;
869 873
870 $_->join for @a_arc; # need to parse all archetypes before png processing 874 $_->join for @a_arc; # need to parse all archetypes before png processing
875 print "ended arc processing...\n" if $VERBOSE;
871 876
872 print "end arc, start png processing...\n" if $VERBOSE; 877 print "starting png processing...\n" if $VERBOSE;
873 878
874 # eight png crunchers work fine for my 4x smp machine 879 # eight png crunchers work fine for my 4x smp machine
875 my @a_png = map +(async \&process_png), 1..8; 880 my @a_png = map +(async \&process_png), 1..8;
876 881
877 print "end any processing...\n" if $VERBOSE;
878 $_->join for @a_any; 882 $_->join for @a_any;
879
880 print "end png processing...\n" if $VERBOSE; 883 print "ended any processing...\n" if $VERBOSE;
884
881 $_->join for @a_png; 885 $_->join for @a_png;
886 print "ended png processing...\n" if $VERBOSE;
882 887
883 print "scanning done, processing results...\n" if $VERBOSE; 888 print "scanning done, processing results...\n" if $VERBOSE;
884 { 889 {
885 # remove path prefix from editor_folder 890 # remove path prefix from editor_folder
886 $_->{editor_folder} =~ /^\x00/ 891 $_->{editor_folder} =~ /^\x00/

Diff Legend

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