--- cfmaps/cfmap2html 2007/06/21 00:14:50 1.27 +++ cfmaps/cfmap2html 2009/10/22 05:11:23 1.36 @@ -1,7 +1,7 @@ #!/opt/bin/perl -# cfmap2html - convert crossfire maps to html -# Copyright (C) 2005,2007 Marc Lehmann +# cfmap2html - convert deliantra maps to html +# Copyright (C) 2005,2007,2008,2009 Marc Lehmann # # CFMAP2HTML is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -17,13 +17,14 @@ # along with cfmaps; if not, write to the Free Software # Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -our $VERSION = '2.001'; +our $VERSION = '2.122'; -use Crossfire 1.0; +use strict; -my $T = 32; +use List::Util qw(min max); +use Deliantra; -my $arch; +my $T = 32; sub escape_html($) { local $_ = shift; @@ -38,36 +39,41 @@ # print STDERR "$path\n"; if (!-e "$base.png" - || !-e "$base.pst" - || -M "$base.pst" > -M $path - || -M "$base.png" > -M $path) { + || -M "$base.png" > -M "$base.map") { # regenerate png and metainfo push @cfmap2png, $path; - }; + } } system "cfmap2png", @cfmap2png if @cfmap2png; +Deliantra::load_archetypes; + for my $path (@ARGV) { (my $base = $path) =~ s/\.map//; if (!-e "$base.xhtml" - || -M "$base.xhtml" > -M "$base.pst") { + || -M "$base.xhtml" > -M "$base.map") { - Crossfire::load_archetypes - unless %ARCH; - - my $meta = Storable::retrieve "$base.pst"; + my $meta = eval { read_arch "$base.map" } + or next; + my $arch = $meta->{arch}; open my $fh, ">:utf8", "$base.xhtml" or die "$base.xhtml: $!"; select $fh; - my $W = $meta->{width} * $T; - my $H = $meta->{height} * $T; + my $W = (1 + max map $_->{x}, @$arch); + my $H = (1 + max map $_->{y}, @$arch); + + my $info = shift @$arch; + my @map; - my $W2 = $W + 600; + push @{ $map[$_->{x}][$_->{y}] }, $_ + for @$arch; + + my $W2 = $W * $T + 600; my (@path) = split /\//, $base; @@ -75,7 +81,7 @@ '', "", "", - "Crossfire Map \"$path\"", + "Deliantra Map \"$path\"", "\n", "\n", "\n", @@ -88,7 +94,7 @@ print "", "", "", "", - "", + "", "", "", ""; - my $W1 = $W + 600; + my $W1 = $W * $T + 600; print "

", - escape_html $meta->{info}{msg}, + escape_html delete $info->{msg}, "

"; + if (open my $fh, "<", "$base.png.err") { + local $/; + print "

", + (escape_html scalar <$fh>), + "

"; + } + + print "", + (map "", + grep !/^_/, keys %$info), + "
" . (escape_html $_) . "" . (escape_html $info->{$_}) . "
", + "

"; + print ""; - my %ignore = map +($_ => 1), qw(name _name x y); + my %ignore = map +($_ => 1), qw(name _name _atype x y); my %is_exit = map +($_ => 1), 41, 57, 66; - for my $y (0.. $meta->{height} - 1) { + for my $y (0.. $H - 1) { print ""; - for my $x (0.. $meta->{width} - 1) { - if (my $as = $meta->{map}[$x][$y]) { + for my $x (0.. $W - 1) { + if (my $as = $map[$x][$y]) { my @class; push @class, "fishy" if grep $_->{invisible} || $_->{face} || exists $_->{no_pass} || exists $_->{no_pick}, @$as; - push @class, "exit" if grep $is_exit{$arch->{$_->{_name}}{type}} && $_->{slaying}, @$as; + push @class, "exit" if grep $is_exit{$ARCH{$_->{_name}}{type}} && $_->{slaying}, @$as; push @class, "dialog" if grep $_->{msg} =~ /^\@match/m, @$as; print ""; @@ -146,8 +165,8 @@ sub print_archs { print "
    "; - for my $a (@{$_[0]}) { - my $o = $arch->{$a->{_name}}; + for my $a (reverse @{$_[0]}) { + my $o = $ARCH{$a->{_name}}; my $type = $a->{type} || $o->{type}; my $aname = escape_html $a->{_name}; my $name = escape_html $a->{name} || $o->{name};