#!/opt/bin/perl # cfmap2html - convert deliantra maps to html # Copyright (C) 2005,2007,2008 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 # the Free Software Foundation; either version 2 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 GNU General Public License # 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.111'; use strict; use List::Util qw(min max); use Deliantra; my $T = 32; 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 "$base.png" || -M "$base.png" > -M "$base.map") { # regenerate png and metainfo push @cfmap2png, $path; } } system "cfmap2png", @cfmap2png if @cfmap2png; for my $path (@ARGV) { (my $base = $path) =~ s/\.map//; if (!-e "$base.xhtml" || -M "$base.xhtml" > -M "$base.map") { Deliantra::load_archetypes unless %ARCH; my $meta = read_arch "$base.map"; 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 "", "", "", "", "", "", "", "
", "Deliantra Map
", ""; print "/ "; for (0 .. $#path - 1) { print "$path[$_] / "; } my @dir = qw(none up right down left); my @tile = map { my $path = delete $info->{"tile_path_$_"}; $path ? "$dir[$_]" : "" } 1..4; print "$path[-1]", "", "

[more about maps.deliantra.net]

", "		$tile[0]
$tile[3]map thumbnail$tile[1]
$tile[2]
"; my $W1 = $W * $T + 600; print "

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

"; 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 (@{$_[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 "
    • "; } print "
"; } print_archs $as; print "
"; } else { print ""; } print "
"; } } print "

created by cfmap2html version $VERSION

", "

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