Crossfire Map \"$path\"

#!/opt/bin/perl # cfmap2idx - inverted index for crossfire maps # Copyright (C) 2005 Marc Lehmann # # CFMAPIDX 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 gvpe; if not, write to the Free Software # Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA our $VERSION = '0.0'; use Storable; use DB_File; sub escape_html($) { local $_ = shift; s/([<>&])/sprintf "&#%d;", ord $1/ge; $_ } if ($ARGV[0] eq "-a") { shift; tie %idx, DB_File, ".index.dat~", O_RDWR|O_CREAT, 0644, $DB_HASH or die ".index.dat~: $!"; my %idx2; for my $path (@ARGV) { my $docnum = pack "n", ++$idx{Vdocnum}; $idx{"D$docnum"} = $path; my $meta = Storable::retrieve "$path.pst"; for my $x (0 .. $meta->{width} - 1) { for my $y (0 .. $meta->{height} - 1) { for my $a (@{ $meta->{map}[$x][$y] }) { for my $v (values %$a) { $v = lc $v; $v =~ y/a-zA-Z0-9_\-./ /c; for (split /\s+/, $v) { $idx2{$_} .= $docnum; if (/_\-\./) { $idx2{$_} .= $docnum for (split /[_\-\.]/) } } } } } } } while (my ($k, $v) = each %idx2) { $idx{$k} = pack "n*", keys %{ { map +($_ => 1), unpack "n*", $idx{$k}.$v } }; } } elsif ($ARGV[0] eq "-s") { shift; tie %idx, DB_File, ".index.dat", O_RDONLY, 0, $DB_HASH or die ".index.dat: $!"; my $cnt; my %res; for (map lc, @ARGV) { if (exists $idx{$_}) { $cnt++; $res{$_}++ for unpack "n*", $_; } else { warn "$_ not found\n";#d# } } while (my ($k, $v) = each %res) { next unless $v == $cnt; my $path = $idx{"D" . pack "n", $k}; warn "found in doc $path\n"; } # print STDERR "$path\n"; die; open my $fh, ">:utf8", "$path.xhtml" or die "$path.xhtml: $!"; select $fh; my $W = $meta->{width} * $T; my $H = $meta->{height} * $T; my $W2 = $W + 600; my (@path) = split /\//, $path; print "", "", "", "Crossfire Map \"$path\"", "\n", "\n", "\n", "", "", ""; print "", "", "", "", "", "", "", "

", "Crossfire Map
", ""; print "/ "; for (0 .. $#path - 1) { print "$path[$_] / "; } my @dir = qw(none up right down left); my @tile = map { $meta->{info}{"tile_path_$_"} ? "

" : "" } 1..4; #"}"# vim misparses without this comment print "$path[-1]", "", "

[more about cfmaps.schmorp.de]

", "

$tile[0]

$tile[3]

$tile[1]

$tile[2]

"; 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}, @$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 "

$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_archs $as; print "

"; } else { print ""; } print "

"; } } print "

", "

"; close $fh; }