--- cfmaps/cfmap2html 2005/11/23 09:07:21 1.21 +++ cfmaps/cfmap2html 2009/10/31 17:26:44 1.37 @@ -1,7 +1,7 @@ #!/opt/bin/perl -# cfmap2html - convert crossfire maps to html -# Copyright (C) 2005 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 @@ -14,174 +14,210 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with gvpe; if not, write to the Free Software +# along with cfmaps; if not, write to the Free Software # Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -our $VERSION = '1.21'; +our $VERSION = '2.2'; -use Storable; +use strict; -my $LIBDIR = $ENV{CROSSFIRE_LIBDIR} - or die "\$CROSSFIRE_LIBDIR must be set\n"; +use List::Util qw(min max); +use Deliantra; my $T = 32; -my $arch; - sub escape_html($) { local $_ = shift; s/([<>&])/sprintf "&#%d;", ord $1/ge; $_ } +my @cfmap2png; + for my $path (@ARGV) { + (my $base = $path) =~ s/\.map//; # print STDERR "$path\n"; - if (!-e "$path.png" - || !-e "$path.pst" - || -M "$path.pst" > -M $path - || -M "$path.png" > -M $path) { + if (!-e "$base.png" + || -M "$base.png" > -M "$base.map") { # regenerate png and metainfo + push @cfmap2png, $path; + # force xhtml file to be remade as well + utime 1, 1, "$base.xhtml"; + } +} - system "cfmap2png", $path; - }; +system "cfmap2png", @cfmap2png + if @cfmap2png; - $arch ||= Storable::retrieve "$LIBDIR/archetypes.pst"; - my $meta = Storable::retrieve "$path.pst"; +Deliantra::load_archetypes; - open my $fh, ">:utf8", "$path.xhtml" - or die "$path.xhtml: $!"; +for my $path (@ARGV) { + (my $base = $path) =~ s/\.map//; + if (!-e "$base.xhtml" + || -M "$base.xhtml" > -M "$base.map") { + + 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 = (1 + max map $_->{x}, @$arch); + my $H = (1 + max map $_->{y}, @$arch); + + my $info = shift @$arch; + my @map; + + push @{ $map[$_->{x}][$_->{y}] }, $_ + for @$arch; + + my $W2 = $W * $T + 600; + + my (@path) = split /\//, $base; + + print "", + '', + "", + "", + "Deliantra Map \"$path\"", + "\n", + "\n", + "\n", + "", + "", + ""; + + print "", + "", - "", - "", - "", - "", - "", - ""; - - my $W1 = $W + 600; - - print "

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

"; - - print ""; - - my %ignore = map +($_ => 1), qw(name _name x y); - my %is_exit = map +($_ => 1), 41, 57, 66; - - for my $y (0.. $meta->{height} - 1) { - print ""; - for my $x (0.. $meta->{width} - 1) { - if (my $as = $meta->{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, "dialog" if grep $_->{msg} =~ /^\@match/m, @$as; - - print ""; - print "
"; - - print join "\n", map "$_", - reverse sort { (length $a) <=> (length $b) or $b <=> $a } - grep $_, map $_->{connected}, @$as; - - print "
($x|$y)"; - - sub print_archs { - print "
    "; - for my $a (@{$_[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}; - - print "
  • $aname \"$name\"\n"; - for (sort keys %$a) { - next if $ignore{$_}; - my $v = escape_html $a->{$_}; - - if ($_ eq "slaying" && $is_exit{$type}) { # door, teleporter, player_changer - $a->{msg} =~ /^final_map\s*(\S+)\s*$/m, $v = $1 - if $v eq "/!"; # random map - - print "slaying => $v\n"; - } elsif ($_ eq "other_arch") { - print "$_ => $v\n"; - } elsif ($_ eq "inventory") { - print "inventory =>\n"; - print_archs ($a->{$_}); - } elsif ($_ eq "msg") { - print "

    $v

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

"; + + print ""; + + my %ignore = map +($_ => 1), qw(name _name _atype x y); + my %is_exit = map +($_ => 1), 41, 57, 66; + + for my $y (0.. $H - 1) { + print ""; + 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, "dialog" if grep $_->{msg} =~ /^\@match/m, @$as; + + print ""; + print "
"; + + print join "\n", map "$_", + reverse sort { (length $a) <=> (length $b) or $b <=> $a } + grep $_, map $_->{connected}, @$as; + + print "
($x|$y)"; + + sub print_archs { + print "
    "; + 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}; + + print "
  • $aname \"$name\"\n"; + for (sort keys %$a) { + next if $ignore{$_}; + my $v = escape_html $a->{$_}; + + if ($_ eq "slaying" && $is_exit{$type}) { # door, teleporter, player_changer + $a->{msg} =~ /^final_map\s*(\S+)\s*$/m, $v = $1 + if $v eq "/!"; # random map + + if ($v =~ s/^\*//) { + print "slaying => *$v\n"; + } else { + print "slaying => $v\n"; + } + } elsif ($_ eq "other_arch") { + print "$_ => $v\n"; + } elsif ($_ eq "inventory") { + print "inventory =>\n"; + print_archs ($a->{$_}); + } elsif ($_ eq "msg") { + print "

    $v

    "; + } else { + print "$_ => $v\n"; + } } + print "
  • "; } - print ""; + print "
"; } - print ""; - } - print_archs $as; - print "
"; - } else { - print "
"; + } else { + print ""; } - print ""; - } - print "
"; - } + print_archs $as; + print ""; + } + } + print "

", - "

"; + print "

", + "

"; - close $fh; + close $fh; - #system "gzip", "-7f", "$path.xhtml"; + #system "gzip", "-7f", "$path.xhtml"; + } }