--- cf.schmorp.de/server/utils/cfutil.in 2008/12/05 00:52:44 1.70 +++ cf.schmorp.de/server/utils/cfutil.in 2009/11/04 13:46:37 1.78 @@ -1,5 +1,27 @@ #!@PERL@ +# +# This file is part of Deliantra, the Roguelike Realtime MMORPG. +# +# Copyright (©) 2007,2008,2009 Marc Alexander Lehmann / Robin Redeker / the Deliantra team +# +# Deliantra is free software: you can redistribute it and/or modify it under +# the terms of the Affero GNU General Public License as published by the +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the Affero GNU General Public License +# and the GNU General Public License along with this program. If not, see +# . +# +# The authors can be reached via e-mail to +# + use strict; my $prefix = "@prefix@"; @@ -14,21 +36,24 @@ my $PNGNQ = "@PNGNQ@"; use Getopt::Long; +use File::Temp; +use POSIX (); +use Carp; + use Coro::EV; use AnyEvent; -use YAML (); +use YAML::XS (); use JSON::XS (); use IO::AIO (); -use File::Temp; -use Deliantra; + use Coro 5.12; use Coro::AIO; use Coro::Util; -use POSIX (); -use Carp; use Coro::Channel; use Coro::Storable; $Storable::canonical = 1; +use Deliantra; + $SIG{QUIT} = sub { Carp::cluck "QUIT" }; sub usage { @@ -275,7 +300,8 @@ system $OPTIPNG, "-i0", "-q", "$other~"; # reduce smoothfaces >10000 bytes - if ($stem =~ /_S\./ && (-s "$other~") > 10000) { + # obsolete, no longer required + if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) { my $ncolor = 256; while () { system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E"; @@ -381,7 +407,7 @@ $ARC{$m->{_name}} = $m; } - $o->{editor_folder} = $dir; + $o->{editor_folder} ||= "\x00$dir"; # horrible kludge my $visibility = delete $o->{visibility}; my $magicmap = delete $o->{magicmap}; @@ -535,7 +561,7 @@ if (my $filter = $meta->{cfutil_filter}) { if ($filter eq "yaml2json") { - $data = JSON::XS::encode_json YAML::Load $data; + $data = JSON::XS::encode_json YAML::XS::Load $data; } elsif ($filter eq "json2json") { $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data); } elsif ($filter eq "perl2json") { @@ -602,6 +628,31 @@ }; } + sub generate_plurals { +# use Lingua::EN::Inflect (); +# Lingua::EN::Inflect::classical; +# Lingua::EN::Inflect::def_noun '(.*)staff' => '$1staves'; # policy +# Lingua::EN::Inflect::def_noun '(.*)boots' => '$1boots'; # hack +# +# for my $a (@ARC) { +# my $name = $a->{name} || $a->{_name}; +# +# next unless $a->{name_pl}; +# next if $a->{invisible}; +# next if $a->{is_floor}; +# next if $a->{no_pick}; +# +# my $test = Lingua::EN::Inflect::PL_N_eq $name, Lingua::EN::Inflect::PL $name; +# my $pl = $test =~ /^(?:eq|p:.)$/ +# ? $name +# : Lingua::EN::Inflect::PL $name; +# +# if ($pl ne $a->{name_pl}) { +# warn "$a->{_name}: plural differs, $pl vs $a->{name_pl}\n"; +# } +# } + } + sub inst_arch($) { my (undef, $path) = @_; @@ -650,8 +701,9 @@ print "scanning done, processing results...\n" if $VERBOSE; { # remove path prefix from editor_folder - substr $_->{editor_folder}, 0, 1 + length $path, "" - for values %ARC; + $_->{editor_folder} =~ /^\x00/ + and substr $_->{editor_folder}, 0, 2 + length $path, "" + for values %ARC; print "resolving inheritance tree...\n" if $VERBOSE; # resolve inherit @@ -689,14 +741,17 @@ # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC; - print "writing archetypes...\n" if $VERBOSE; + print "generating plurals...\n" if $VERBOSE; + generate_plurals; + + printf "writing %d archetypes...\n", scalar @ARC if $VERBOSE; open my $fh, ">:utf8", "$DATADIR/archetypes~" or die "$DATADIR/archetypes~: $!"; print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; } { - print "writing treasures...\n" if $VERBOSE; + printf "writing treasures (%d octets)...\n", length $TRS if $VERBOSE; open my $fh, ">:utf8", "$DATADIR/treasures~" or die "$DATADIR/treasures~: $!"; print $fh $TRS; @@ -708,7 +763,7 @@ length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n"; length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n"; - length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; + #length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n"; if (my $magicmap = $v->{magicmap}) { @@ -719,7 +774,12 @@ delete $v->{arc}; } - print "writing facedata...\n" if $VERBOSE; + printf "writing facedata (%d faces, %d anims, %d resources)...\n", + scalar keys %FACEINFO, + scalar keys %ANIMINFO, + scalar keys %RESOURCE + if $VERBOSE; + open my $fh, ">:perlio", "$DATADIR/facedata~" or die "$DATADIR/facedata~: $!"; @@ -729,6 +789,7 @@ animinfo => \%ANIMINFO, resource => \%RESOURCE, }; + } print "committing files...\n" if $VERBOSE;