--- deliantra/server/utils/cfutil.in 2010/10/20 06:21:48 1.106 +++ deliantra/server/utils/cfutil.in 2011/04/22 02:15:45 1.112 @@ -3,7 +3,7 @@ # # This file is part of Deliantra, the Roguelike Realtime MMORPG. # -# Copyright (©) 2007,2008,2009 Marc Alexander Lehmann / Robin Redeker / the Deliantra team +# Copyright (©) 2007,2008,2009,2010 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 @@ -30,7 +30,7 @@ my $DATADIR = "@datadir@/@PACKAGE@"; my $CONVERT = "@CONVERT@"; -#my $IDENTIFY = "@IDENTIFY@"; +my $IDENTIFY = "@IDENTIFY@"; my $OPTIPNG = "@OPTIPNG@"; my $RSYNC = "@RSYNC@"; my $PNGNQ = "@PNGNQ@"; @@ -40,17 +40,20 @@ use POSIX (); use Carp; -use Coro::EV; -use AnyEvent; use YAML::XS (); +use Digest::MD5 (); +use Storable (); use JSON::XS (); use IO::AIO (); -use Digest::MD5 (); +use Compress::LZF (); +use AnyEvent; use Coro 5.12; +use Coro::EV; use Coro::AIO; use Coro::Util; use Coro::Channel; +use Coro::AnyEvent; use Coro::Storable; $Storable::canonical = 1; use Deliantra; @@ -134,7 +137,7 @@ mkdir $TMPDIR, 0700 or die "$TMPDIR: $!"; -sub fork_sub(&) { +sub fork_exec(&) { my ($cb) = @_; if (my $pid = fork) { @@ -149,6 +152,35 @@ } } +sub imgsize($) { + open my $fh, "-|", $IDENTIFY, qw(-ping -format %w,%h --), $_[0] + or die "$IDENTIFY: $!"; + + Coro::AnyEvent::readable $fh; + + my ($w, $h) = split /,/, <$fh>; + + ($w+0, $h+0) +} + +# make $dst from $src, if not uptodate, by calling $how +sub make_file($$$) { + my ($src, $dst, $how) = @_; + + my $t = (aio_stat $dst) ? -1 : (stat _)[9]; + + for (ref $src ? @$src : $src) { + aio_stat $_ + and die "$_: $!"; + + if ((stat _)[9] > $t) { + # outdated, redo + $how->(); + last; + } + } +} + sub inst_maps($) { my (undef, $path) = @_; @@ -250,8 +282,8 @@ if (0 > aio_stat "$stem.64x64.png") { my $other = "$stem.64x64.png~"; - if (0 > aio_lstat $other or (-M _) > (-M $path)) { - fork_sub { + make_file $path, $other, sub { + fork_exec { my $CROP; my $SRC = "png:\Q$path\E"; @@ -319,7 +351,7 @@ die "$other~ has zero size, aborting." unless -s "$other~"; rename "$other~", $other; }; - } + }; push @c_png, [$other, !$CACHE]; } @@ -328,8 +360,8 @@ if (0 > aio_stat "$stem.32x32.png") { my $other = "$stem.32x32.png~"; - if (0 > aio_lstat $other or (-M _) > (-M $path)) { - fork_sub { + make_file $path, $other, sub { + fork_exec { system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; system $OPTIPNG, "-i0", "-q", "$other~"; @@ -354,7 +386,7 @@ die "$other~ has zero size, aborting." unless -s "$other~"; rename "$other~", $other; }; - } + }; #warn "scaled down $path to $other\n";#d# push @c_png, [$other, !$CACHE]; @@ -378,7 +410,7 @@ my $mtime = (lstat $path)[9]; my @todo = grep { $_->[3] <= $mtime } @tile; if (@todo) { - fork_sub { + fork_exec { open my $convert, "|-", $CONVERT, "png:-", (map { @@ -439,11 +471,12 @@ for (split /\n/, $data) { chomp; - my ($face, $visibility, $fg, $bg, $glyph) = split /\s+/; + my ($face, $visibility, $fg, $bg, $glyph) = split /\s+/, $_, 5; # bg not used except for text clients utf8::decode $glyph; $glyph =~ s/^\?(?=.)//; # remove "autoglyph" flag + $glyph =~ s/^"(.+)"$/$1/; # allow for ""-style quoting $fg = "white" if $fg eq "none"; # lots of faces have no fg colour yet @@ -457,9 +490,10 @@ $fi->{magicmap} = $fgi; # foreground colour becomes magicmap $glyph .= " " if 2 > length $glyph; # TODO kanji + die "glyph $face too long" if 2 < length $glyph; $fi->{glyph} = ""; - for (split //, $glyph, -1) { + for (split //, $glyph) { utf8::encode $_; $fi->{glyph} .= (chr $fgi) . (chr $bgi) . $_; } @@ -580,11 +614,79 @@ $FILECACHE{$_[0]} } + # convert an image and a palette to some indexed 2d-matrix structure + sub process_plt { + my ($base, $plt) = @_; + + my ($w, $h) = imgsize "$base.png"; + + $w * $h + or die "$base.png: unable to identify correct size\n"; + + my @plt; + my %map; + + for (split /\n/, $plt) { + next unless /\S/; + next if /^\s*#/; + + /^([0-9a-fA-F]{3,6})\s*(.*?)\s*$/ + or die "unparseable palette entry for $base.plt: $_"; + + my ($rgb, $name) = ($1, $2); + + $rgb =~ s/^(.)(.)(.)$/$1$1$2$2$3$3/; + + $map{pack "H*", $rgb} = chr @plt; + push @plt, $name; + } + + make_file ["$base.plt", "$base.png"], "$base.tbl~", sub { + warn "building $base\n" if $VERBOSE >= 3; + + fork_exec { + open my $png, "-|", $CONVERT, qw(-depth 8 --), "$base.png", "rgb:" + or die "$base.png: $!"; + + local $/; + $png = <$png>; + + $w * $h * 3 == length $png + or die "$base.png: failed to read enough data from file\n"; + + $png =~ s/(...)/$map{$1}/ge; + + $w * $h == length $png + or die "$base.png: failed to map all data - wrong palette?\n"; + + { + open my $fh, ">:raw", "$base.tbl~~" + or die "$base.tbl~~: $!"; + syswrite $fh, $png; + } + + rename "$base.tbl~~", "$base.tbl~"; + }; + }; + + 0 <= aio_load "$base.tbl~", my $tbl + or die "$base.tbl~: $!"; + + IO::AIO::aio_unlink "$base.tbl~" unless $CACHE; + + Compress::LZF::compress nfreeze { + w => $w, + h => $h, + plt => \@plt, + tbl => $tbl, + } + } + sub process_res { my ($dir, $file, $type) = @_; - my $data; - aio_load "$dir/$file", $data; + 0 <= aio_load "$dir/$file", my $data + or die "$dir/$file: $!"; my $meta = load_cached "$dir/meta", sub { JSON::XS->new->utf8->relaxed->decode (shift) }; @@ -621,9 +723,9 @@ $file =~ s/\.res$//; $file =~ s/\.(ogg|wav|jpg|png)$//; - substr $dir, 0, 1 + length $PATH, ""; - - if (my $filter = $meta->{cfutil_filter}) { + if ($file =~ s/\.plt$//) { + $data = process_plt "$dir/$file", $data; + } elsif (my $filter = $meta->{cfutil_filter}) { if ($filter eq "yaml2json") { $data = JSON::XS::encode_json YAML::XS::Load $data; } elsif ($filter eq "json2json") { @@ -636,6 +738,8 @@ } } + substr $dir, 0, 1 + length $PATH, ""; + $RESOURCE{"$dir/$file"} = { type => (exists $meta->{type} ? delete $meta->{type} : $type), data => $data, @@ -912,7 +1016,6 @@ animinfo => \%ANIMINFO, resource => \%RESOURCE, }; - } print "committing files...\n" if $VERBOSE;