Remove obsolete scripts
Nicolas Weeger
parent
9aef8cef4a
commit
76f0808599
11
Info/README
11
Info/README
|
|
@ -1,16 +1,5 @@
|
|||
In this directory is utilities, gif images of the maps, and other notes.
|
||||
|
||||
map_info: (From Tero Haatanen <Tero.Haatanen@lut.fi>). It goes through
|
||||
the map files in the specified directory, printing out problems and
|
||||
also generating a list of used objects.
|
||||
|
||||
map_check: Another program that goes through and checks maps. This one
|
||||
starts at the starting map, and then visits all the maps connected to it,
|
||||
and so on. Thus, its output and the output of do a 'find . -type f -print'
|
||||
in the maps directory, can be compared after some modification, to find maps
|
||||
in the map directory that are not connected to anything. I think that
|
||||
map_info does a better job about other map errors, however.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Developer guidelines:
|
||||
|
||||
|
|
|
|||
383
Info/map_check
383
Info/map_check
|
|
@ -1,383 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# (C) Copyright Markus Weber, 1994. All rights reserved.
|
||||
# Permission is granted to use, copy, and modify for non-commercial use.
|
||||
#
|
||||
|
||||
# usage: check-consistency.pl [options]...
|
||||
# Options:
|
||||
# archdb=pathname-of-archetype-database *** not used ***
|
||||
# default ./ARCHDB .{dir,pag}
|
||||
# archetypes=pathname-of-archetypes-file
|
||||
# default $cfdir/share/crossfire/archetypes
|
||||
# cfdir=pathname-to-crossfire-installation
|
||||
# default /opt/cf0901 (hardcoded)
|
||||
# mapdir=pathname-of-map-directory
|
||||
# default $cfdir/share/crossfire/maps
|
||||
# start-map=map-path-of-starting map
|
||||
# default (init in archetypes)
|
||||
|
||||
# %% make it a command line option
|
||||
$debug = 1;
|
||||
|
||||
#
|
||||
# ARGUMENT PROCESSING
|
||||
#
|
||||
# preset options
|
||||
$cfdir = "/export/home/crossfire/cf-installroot";
|
||||
|
||||
# loop thru arg vector
|
||||
while (@ARGV) {
|
||||
$_ = @ARGV[0];
|
||||
if (/^archdb=/) {
|
||||
($junk,$archdb) = split(/=/,$ARGV[0]);
|
||||
shift;
|
||||
}
|
||||
elsif (/^archetypes=/) {
|
||||
($junk,$archetypes) = split(/=/,$ARGV[0]);
|
||||
shift;
|
||||
}
|
||||
elsif (/^cfdir=/) {
|
||||
($junk,$cfdir) = split(/=/,$ARGV[0]);
|
||||
shift;
|
||||
}
|
||||
elsif (/^mapdir=/) {
|
||||
($junk,$mapdir) = split(/=/,$ARGV[0]);
|
||||
shift;
|
||||
}
|
||||
elsif (/^start-map=/) {
|
||||
($junk,$start_map) = split(/=/,$ARGV[0]);
|
||||
shift;
|
||||
}
|
||||
else {
|
||||
print "Unknown option $ARGV[0]\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
# post-process
|
||||
$mapdir = "$cfdir/share/crossfire/maps" unless defined($mapdir);
|
||||
$archetypes = "$cfdir/share/crossfire/archetypes" unless defined($archetypes);
|
||||
print STDERR "DBG: archetypes=$archetypes\n" if $debug > 5;
|
||||
print STDERR "DBG: archdb=$archdb\n" if $debug > 5;
|
||||
print STDERR "DBG: mapdir=$mapdir\n" if $debug > 5;
|
||||
|
||||
|
||||
#
|
||||
# INIT ARCHETYPES DATABASE
|
||||
#
|
||||
print STDERR "DBG: initializing archetype database...\n" if $debug;
|
||||
&init_archetypes_database; # unless $skip_db_init;
|
||||
print STDERR "DBG: ...done\n" if $debug;
|
||||
|
||||
defined($start_map) || die "FATAL: no starting map";
|
||||
print STDERR "DBG: start_map=$start_map\n" if $debug;
|
||||
|
||||
|
||||
print STDERR "DBG: scanning for archetypes of special interest...\n" if $debug;
|
||||
|
||||
while ( ($arch,$type) = each(%ARCHDB) ) {
|
||||
|
||||
next if !defined($type); # skip if not special
|
||||
|
||||
$_ = $type; # see below
|
||||
|
||||
if ($type == 41 || $type == 66 || $type == 94) {
|
||||
# EXITS: archetypes with exits to other maps
|
||||
$EXITS{$arch} = 1;
|
||||
}
|
||||
# Bad Programming Style Alert. Don't try this at home!
|
||||
elsif (/^1[78]$/ || /^2[679]$/ || /^3[012]$/ || /^9[123]$/) {
|
||||
# CONNECT: "connected" archetypes,
|
||||
# e.g. buttons, handles, gates, ...
|
||||
$CONNECT{$arch} = 1;
|
||||
}
|
||||
if ($type == 85) {
|
||||
$SB{$arch} = 1;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
print STDERR "DBG: ...done.\n" if $debug;
|
||||
|
||||
#
|
||||
# MAIN LOOP
|
||||
#
|
||||
|
||||
# pathname of start_map is assumed to be absolute (e.g. /village/village
|
||||
push(@MAPS,$start_map);
|
||||
|
||||
while ($map = pop(@MAPS)) {
|
||||
|
||||
# print STDERR "array stack size is $#MAPS\n";
|
||||
next if $visited{$map}; # skip if been here before
|
||||
$visited{$map} = 1; # flag it if not
|
||||
|
||||
# skip random maps
|
||||
next if ($map =~ m#/!#);
|
||||
|
||||
print STDERR "DBG: visiting $map\n" if $debug;
|
||||
#print "visiting $map\n" if $debug;
|
||||
|
||||
#
|
||||
# side effect: check_map pushes any (legal) exits found on stack
|
||||
#
|
||||
&check_map($map);
|
||||
}
|
||||
|
||||
print "Unused archetypes:\n";
|
||||
foreach $key (sort(keys %ARCHDB)) {
|
||||
print "$key\n" if (!defined($USED{$key}))
|
||||
}
|
||||
|
||||
|
||||
|
||||
exit;
|
||||
|
||||
#
|
||||
# ++++++++++++++++++++ END OF MAIN ++++++++++++++++++
|
||||
#
|
||||
|
||||
#
|
||||
# INIT ARCHETYPES DATABASE
|
||||
#
|
||||
# store (archname,type) pairs
|
||||
#
|
||||
sub init_archetypes_database {
|
||||
local($arch_lines,$arches); # counters
|
||||
local($arch,$type,$slaying); # values
|
||||
local($junk);
|
||||
|
||||
print STDERR "DBG: opening archetypes: $archetypes\n" if $debug > 5;
|
||||
open(ARCHETYPES,$archetypes) || die "can't open $archetypes";
|
||||
|
||||
$arch_lines = 0;
|
||||
$arches = 0;
|
||||
$type = 0;
|
||||
|
||||
while ( <ARCHETYPES> ) {
|
||||
$arch_lines++;
|
||||
if (/^Object\s/) {
|
||||
($junk,$arch) = split;
|
||||
if (!defined($arch)) {
|
||||
print STDERR "$archetypes: bad Object, line $arch_lines\n";
|
||||
}
|
||||
}
|
||||
elsif (/^type\s/) {
|
||||
($junk,$type) = split;
|
||||
if (!defined($type)) {
|
||||
print STDERR "$archetypes: bad type, line $arch_lines\n";
|
||||
}
|
||||
}
|
||||
elsif (/^slaying\s/ && $arch eq "map") {
|
||||
($junk,$slaying) = split;
|
||||
# don't care if defined or not (yet)
|
||||
}
|
||||
elsif (/^end$/) {
|
||||
print STDERR "DBG: entered arch=$arch, optional type=$type\n" if $debug > 10;
|
||||
next if (!defined($arch));
|
||||
# don't care whether $type defined or not
|
||||
$ARCHDB{$arch} = $type;
|
||||
$arches++;
|
||||
$type = 0;
|
||||
}
|
||||
elsif (/^end\s*$/) {
|
||||
print STDERR "DBG: arch $arch is using end with space before newline\n";
|
||||
next if (!defined($arch));
|
||||
# don't care whether $type defined or not
|
||||
$ARCHDB{$arch} = $type;
|
||||
$arches++;
|
||||
$type = 0;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# find start map
|
||||
# print error message iff "map" arch not found or missing path
|
||||
# assign start map (unless pre-defined on cmd line)
|
||||
#
|
||||
if (!defined($slaying)) {
|
||||
print STDERR "***ERROR*** no map object or map path missing\n";
|
||||
}
|
||||
elsif (!defined($start_map)) {
|
||||
$start_map = $slaying;
|
||||
}
|
||||
#print STDERR "DBG: start_map=$start_map\n";
|
||||
|
||||
close(ARCHETYPES);
|
||||
print STDERR "DBG: closed $archetypes, $arch_lines lines, $arches arches\n"
|
||||
if $debug > 5;
|
||||
}
|
||||
|
||||
#
|
||||
# CHECK MAP FOR ELEMENTARY CONSISTENCY
|
||||
#
|
||||
|
||||
sub check_map {
|
||||
local($map) = @_;
|
||||
local($arch,$connected,$slaying,$exit,$x,$y, $rx, $ry);
|
||||
local($lines,$fullmap);
|
||||
local($junk);
|
||||
$depth=0;
|
||||
|
||||
# build full pathname (nb: map path starts with /) and open map file
|
||||
$fullmap = "$mapdir$map";
|
||||
open(MAP,$fullmap) || die "can't open $fullmap";
|
||||
print STDERR "DBG: opened $map\n" if $debug > 5;
|
||||
|
||||
$lines = 0;
|
||||
|
||||
while ( <MAP> ) {
|
||||
if (/^tile_path_/) {
|
||||
($junk,$slaying) = split;
|
||||
$_ = "$map $slaying"; # easy matching :-)
|
||||
s@^(/.*/)([^/]*)\s([^\./].*)$@\1\2 \1\3@;
|
||||
s@^(/.*/)([^/]*)\s(\.\./.*)$@\1\2 \1\3@;
|
||||
s@/[^/]*/\.\./@/@g;
|
||||
($junk,$exit) = split;
|
||||
next if $visited{$exit};
|
||||
|
||||
if ( (! -r "$mapdir$exit") && ( $exit ne "/!") ) {
|
||||
print "ERROR: map $map, arch $arch, line $lines, no such exit $exit ($rx, $ry, to $x, $y)\n";
|
||||
next;
|
||||
}
|
||||
push(@MAPS,$exit);
|
||||
}
|
||||
|
||||
|
||||
$lines++;
|
||||
if (/^arch\s/) {
|
||||
# Note we have to do some checks here - that is because
|
||||
# if an object is inside an object, the value of $arch
|
||||
# is clobbered.
|
||||
($junk,$arch) = split;
|
||||
# if ($SB{$arch}) {
|
||||
# print "WARNING: spellbook found at map $map, line $lines, arch $arch\n";
|
||||
# }
|
||||
if (!defined($ARCHDB{$arch})) {
|
||||
print "FATAL: map $map, line $lines, bad archetype: $arch ($rx, $ry)\n";
|
||||
}
|
||||
$USED{$arch}=1;
|
||||
undef($slaying);
|
||||
undef($x);
|
||||
undef($y);
|
||||
undef($rx);
|
||||
undef($ry);
|
||||
undef($connected);
|
||||
$depth++;
|
||||
}
|
||||
elsif (/^connected\s/) {
|
||||
($junk,$connected) = split;
|
||||
}
|
||||
elsif (/^slaying\s/) {
|
||||
($junk,$slaying) = split;
|
||||
}
|
||||
elsif (/^hp\s/) {
|
||||
($junk,$x) = split;
|
||||
}
|
||||
elsif (/^sp\s/) {
|
||||
($junk,$y) = split;
|
||||
}
|
||||
elsif (/^x\s/) {
|
||||
($junk, $rx) = split;
|
||||
}
|
||||
elsif (/^y\s/) {
|
||||
($junk, $ry) = split;
|
||||
}
|
||||
elsif (/^anim$/) {
|
||||
print "Map $fullmap has an anim command in it\n";
|
||||
}
|
||||
|
||||
next if !/^end$/; # continue iff not end of arch
|
||||
$depth--;
|
||||
|
||||
#
|
||||
# CHECK 2: connect-arch actually connected?
|
||||
# NB: if not, that's perfectly legal, but suspicious
|
||||
#
|
||||
# if ($CONNECT{$arch}) {
|
||||
# if (!$connected) {
|
||||
#print STDERR "WARNING: map $map, line $lines, arch $arch, not connected\n";
|
||||
#print "WARNING: map $map, line $lines, arch $arch, not connected\n";
|
||||
# }
|
||||
# next;
|
||||
# }
|
||||
|
||||
next if !$EXITS{$arch}; # continue if not an exit
|
||||
|
||||
|
||||
#
|
||||
# CHECK 3: exit-type arch, but no path given
|
||||
# Presumably the path defaults to the local map,
|
||||
# but in all probability this is an error
|
||||
#
|
||||
if (!defined($slaying)) {
|
||||
if ($x || $y) {
|
||||
#print STDERR "ERROR: map $map, line $lines, arch $arch, exit defaults\n";
|
||||
#print "ERROR: map $map, line $lines, arch $arch, exit defaults\n";
|
||||
}
|
||||
else {
|
||||
#print STDERR "INFO: map $map, line $lines, arch $arch, no exit defined\n";
|
||||
#print "INFO: map $map, line $lines, arch $arch, no exit defined\n";
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
#
|
||||
# CHECK 4: verify that exit map exists
|
||||
# if not, the game (hopefully!) won't crash, but
|
||||
# chances are this _is_ an error
|
||||
#
|
||||
|
||||
#
|
||||
# normalize exit path (FullyQualifiedPathName :-)))
|
||||
# (i.e. construct absolute pathname, rooted in CLibDir/maps)
|
||||
# E.g.:
|
||||
# current map: /village/somewhere
|
||||
# EXIT PATH YIELDS
|
||||
# /village/building /village/building
|
||||
# townhouse /village/townhouse
|
||||
# ../island /island
|
||||
#
|
||||
$_ = "$map $slaying"; # easy matching :-)
|
||||
# /path/map exit --> /path/map /path/exit
|
||||
s@^(/.*/)([^/]*)\s([^\./].*)$@\1\2 \1\3@;
|
||||
# /path/map ../exit --> /path/map /path/../exit
|
||||
s@^(/.*/)([^/]*)\s(\.\./.*)$@\1\2 \1\3@;
|
||||
# /dir/../ --> / (all occurances)
|
||||
s@/[^/]*/\.\./@/@g;
|
||||
|
||||
($junk,$exit) = split;
|
||||
#print STDERR "DBG: exit $map $exit\n" if $debug > 5;
|
||||
#print "exit $map $exit\n";
|
||||
|
||||
#
|
||||
# shortcut: if the exit map was already checked, don't bother
|
||||
# stacking it again.
|
||||
# %% if a map is never pushed twice in the first place,
|
||||
# the corresponding test in the main loop is probably
|
||||
# in vain.
|
||||
#
|
||||
next if $visited{$exit};
|
||||
|
||||
#
|
||||
# this is check 4, finally.
|
||||
# if exit map can't be opened, complain and continue
|
||||
#
|
||||
if ( (! -r "$mapdir$exit") && ( $exit ne "/!") ) {
|
||||
#print STDERR "ERROR: map $map, arch $arch, line $lines, no such exit $exit\n";
|
||||
print "ERROR: map $map, arch $arch, line $lines, no such exit $exit ($rx, $ry, to $x, $y)\n";
|
||||
next;
|
||||
}
|
||||
|
||||
#
|
||||
# the exit map looks good; push it and continue
|
||||
push(@MAPS,$exit);
|
||||
}
|
||||
|
||||
close(MAP);
|
||||
if ($depth != 0) {
|
||||
print "ERROR: map $map, mismatched arch/end, $depth\n";
|
||||
}
|
||||
}
|
||||
|
||||
368
Info/map_info
368
Info/map_info
|
|
@ -1,368 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# This program is meant to use check crossfire (version 0.90.?) maps.
|
||||
# Program wanderers through mapfiles and reports all objects that
|
||||
# can't be found in the archetypes, all exit that doesn't lead to
|
||||
# anywhere and all corrupted mapfiles.
|
||||
#
|
||||
# By: Tero Haatanen <Tero.Haatanen@lut.fi>
|
||||
#
|
||||
# Usage: wanderer.pl directory
|
||||
|
||||
# Set if you want to get warnings about spikes, gates, buttons, et al that
|
||||
# are not connected. This can be annoying at times, since many maps use
|
||||
# these objects for decorations.
|
||||
$CONNECTED = 0;
|
||||
$LIB = "/export/home/crossfire/cf-installroot/share/crossfire";
|
||||
$ARCH = "$LIB/archetypes";
|
||||
$BMAPS = "$LIB/bmaps";
|
||||
$ANIM = "$LIB/animations";
|
||||
$MAPS = "$LIB/maps";
|
||||
# Set VERBOSE=1 if you want more output
|
||||
$VERBOSE=0;
|
||||
$SHOW_UNUSED = 0;
|
||||
|
||||
if (! $ARGV[0]) {
|
||||
print "Using $MAPS are starting map directory.\n";
|
||||
$STARTING = $MAPS;
|
||||
} else {
|
||||
$STARTING = $ARGV[0];
|
||||
}
|
||||
|
||||
|
||||
# read filenames to @maps
|
||||
chdir ($STARTING);
|
||||
while ($area = shift) {
|
||||
&maplist ($area);
|
||||
}
|
||||
|
||||
$* = 1; # use multiline matches
|
||||
|
||||
&faces;
|
||||
&animations;
|
||||
# read archetypes
|
||||
&archetypes;
|
||||
|
||||
|
||||
%ex = &collect ('^type 66$'); # type 66 == exit
|
||||
%tele = &collect ('^type 41$'); # type 41 == teleport
|
||||
%conn = &collect ('^type (17|18|26|27|29|30|31|32|91|92|93|94)$');
|
||||
delete $conn{"spikes_moving"};
|
||||
delete $conn{"magic_ear"};
|
||||
%players = &collect ('^type 1$'); # type 1 == player
|
||||
#
|
||||
# In theory, I don't think any of these should show up in maps.
|
||||
# For now, I mostly ignore them so I can more easily check out the
|
||||
# editor directory and verify everything is in place.
|
||||
%abilities = &collect('^type (2|10|11|12|19|25|43|44|49|50|52|88|97|110|114|121|141|151)$');
|
||||
|
||||
# check exits from archetypes
|
||||
foreach $a (keys (%ex), keys (%tele)) {
|
||||
if ($arches {$a} =~ /^food -?\d+$/) {
|
||||
print "Warning: Archetype $a has food field.\n";
|
||||
}
|
||||
}
|
||||
|
||||
# some general info
|
||||
print "=" x 70, "\n";
|
||||
print "Number of mapfiles = " , @maps + 0, "\n";
|
||||
print "Number of archetypes = " , values(%arches)+0, ":\n";
|
||||
print " - Exits (" , values(%ex)+0, ")\n";
|
||||
print " - Teleports (" , values(%tele)+0, ")\n";
|
||||
print " - Connected objects (", values(%conn)+0, ")\n";
|
||||
print " - Players (" , values(%players)+0, ")\n";
|
||||
print "=" x 70, "\n";
|
||||
|
||||
# check maps
|
||||
while ($file = shift (@maps)) {
|
||||
&readmap;
|
||||
}
|
||||
|
||||
# summary of missing archetypes
|
||||
if (%missing) {
|
||||
print "=" x 70, "\n";
|
||||
print "Missing archetypes: ", join (", ", sort keys (%missing)), "\n";
|
||||
}
|
||||
# if you don't want list of used objects, uncomment next line
|
||||
# and you can comment also last line check_obj
|
||||
# (This isn't very useful, but maybe tells something)
|
||||
|
||||
#exit;
|
||||
|
||||
#&print_usage();
|
||||
|
||||
if ($SHOW_UNUSED) {
|
||||
print " Unused object\n";
|
||||
foreach $a (sort(keys %arches)) {
|
||||
print "$a\n" if (!$objects{$a} && !$players{$a} && !$abilities{$a})
|
||||
}
|
||||
}
|
||||
|
||||
exit;
|
||||
|
||||
sub print_usage() {
|
||||
print "=" x 70, "\nArchetype count\n";
|
||||
$total = 0;
|
||||
foreach $a (sort by (keys (%objects))) {
|
||||
printf ("%-24s%d\n", $a, $objects{$a});
|
||||
$total += $objects{$a};
|
||||
}
|
||||
print '-' x 30, "\nTotal objects $total\n";
|
||||
}
|
||||
# return table containing all objects in the map
|
||||
sub readmap {
|
||||
my ($m);
|
||||
my($last);
|
||||
my($parent);
|
||||
$last = "";
|
||||
$parent = "";
|
||||
|
||||
$/ = "\nend\n";
|
||||
if (! open (IN, $file)) {
|
||||
print "Can't open map file $file\n";
|
||||
return;
|
||||
}
|
||||
$_ = <IN>;
|
||||
if (! /^arch map$/) {
|
||||
# print "Error: file $file isn't mapfile.\n";
|
||||
return;
|
||||
}
|
||||
if ($VERBOSE) {
|
||||
print "Testing $file, ";
|
||||
print /^name (.+)$/ ? $1 : "No mapname";
|
||||
print ", size [", /^x (\d+)$/ ? $1 : 16;
|
||||
print ",", /^y (\d+)/ ? $1 : 16, "]";
|
||||
|
||||
if (! /^msg$/) {
|
||||
print ", No message\n";
|
||||
} elsif (/(\w+@\S+)/) {
|
||||
print ", $1\n";
|
||||
} else {
|
||||
print ", Unknown\n";
|
||||
}
|
||||
$printmap=0;
|
||||
}
|
||||
else {
|
||||
$name= /^name (.+)$/ ? $1 : "No mapname";
|
||||
$x= /^x (\d+)$/ ? $1 : 16;
|
||||
$y= /^y (\d+)/ ? $1 : 16;
|
||||
$mapname="Map $file, $name, size [$x, $y]\n" ;
|
||||
$printmap=1;
|
||||
}
|
||||
|
||||
|
||||
while (<IN>) {
|
||||
if (($m = (@_ = /^arch \S+\s*$/g)) > 1) {
|
||||
$parent = /^arch (\S+)\s*$/;
|
||||
# object has inventory
|
||||
my ($inv) = $_;
|
||||
while (<IN>) {
|
||||
if (/((.|\n)*end\n)(arch (.|\n)*\nend\n)/) {
|
||||
&check_obj ("$inv$1");
|
||||
&check_obj ($3);
|
||||
last;
|
||||
} elsif (/^arch (.|\n)*\nend$/) {
|
||||
&check_obj ($_);
|
||||
} elsif (/^end$/) {
|
||||
&check_obj ("$inv$_");
|
||||
} else {
|
||||
# if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
# This doesn't work right - it gets confused when objects are within
|
||||
# another object
|
||||
# print " Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n";
|
||||
}
|
||||
}
|
||||
$parent="";
|
||||
} elsif (/^More$/ || $m == 1) {
|
||||
&check_obj ($_);
|
||||
} else {
|
||||
# if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
# print " Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n";
|
||||
}
|
||||
}
|
||||
close (IN);
|
||||
}
|
||||
|
||||
sub check_obj {
|
||||
$_ = shift @_;
|
||||
|
||||
local ($x) = (/^x (\d+)$/)?$1:0;
|
||||
local ($y) = (/^y (\d+)$/)?$1:0;
|
||||
local($arch) = /^arch (\S+)\s*$/;
|
||||
|
||||
if (! $arches{$1} && $last ne $1) {
|
||||
$last = $1;
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print " Error: Object $last is not defined in archetypes file ($x,$y), arch=$arch\n";
|
||||
$missing{$last}++;
|
||||
} elsif ($ex{$1}) {
|
||||
&examine_exit ($_);
|
||||
} elsif ($tele{$1}) {
|
||||
if (/^food -?\d+$/) {
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print " Error: Teleport $1 has food field.\n";
|
||||
}
|
||||
else {
|
||||
&examine_exit ($_);
|
||||
}
|
||||
} elsif ($conn{$1} && ! /^connected -?\d+$/) {
|
||||
$last = $1;
|
||||
if ($CONNECTED) {
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print " Warning: Object $last has not been connected, $x,$y\n"
|
||||
}
|
||||
} elsif ($players{$1} && $last ne $1 && ! /^type / ) {
|
||||
$last = $1;
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print " Error: Player $last found in the map.\n";
|
||||
} elsif ($1 eq "scroll" && ! /^msg$/) {
|
||||
$last = $1;
|
||||
# print " Warning: scroll without message ($x, $y:$parent), should be random_scroll?\n";
|
||||
} elsif ($1 eq "potion" && $last ne $1) {
|
||||
$last = $1;
|
||||
# print " Warning: potion found, should be random_potion or random_food?\n";
|
||||
} elsif ($1 eq "ring" || $1 eq "amulet") {
|
||||
$last = $1;
|
||||
# print " Warning: ring/amulet found ($x,$y:$parent), should be random_talisman?\n";
|
||||
}
|
||||
$objects{$1}++;
|
||||
if (/^animation (\S+)$/) {
|
||||
if (! $anim{$1}) {
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print "Error: Object $arch is using an unknown animation $1\n"
|
||||
}
|
||||
}
|
||||
if (/^face (\S+)$/) {
|
||||
if (! $faces{$1}) {
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print "Error: Object $arch is using an unknown face $1\n"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub by {
|
||||
$_ = $objects{$b} <=> $objects{$a};
|
||||
$_ ? $_ : $a cmp $b;
|
||||
}
|
||||
|
||||
sub obj_name {
|
||||
$_ = shift(@_);
|
||||
local ($name) = /^name (.+)$/; # object's name
|
||||
local ($arch) = /^arch (\S+)$/;
|
||||
if (!defined ($name) && $arches{$arch} =~ /^name (.+)$/) {
|
||||
$name = $1; # archetype's name
|
||||
}
|
||||
return defined ($name) ? $name : $arch; # archetype or name
|
||||
}
|
||||
|
||||
sub examine_exit {
|
||||
$_ = shift(@_);
|
||||
|
||||
local ($x) = (/^hp (\d+)$/)?$1:0;
|
||||
local ($y) = (/^sp (\d+)$/)?$1:0;
|
||||
local ($x1) = (/^x (\d+)$/)?$1:0;
|
||||
local ($y1) = (/^y (\d+)$/)?$1:0;
|
||||
local ($to) = /^slaying (\S+)$/;
|
||||
|
||||
if (/^food (-?\d+)$/) {
|
||||
# old style exits, doesn't work with crossfire 0.90-1
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print " Error: ", &obj_name($_), " ($x1,$y1) -> ",
|
||||
"Old style level [$1] ($x,$y)\n";
|
||||
} elsif (! defined ($to)) {
|
||||
# print " Closed: ", &obj_name($_), " ($x1,$y1)\n";
|
||||
} else {
|
||||
# These are currently used be crossfire
|
||||
if ($to eq "/!") { # this is a random exit - if we
|
||||
# have a final map, make sure it
|
||||
# exists
|
||||
local ($finalmap) = /^final_map (\S+)$/;
|
||||
if ($finalmap ne "") {
|
||||
if ($finalmap =~ m!^/!) { $cdir = "$MAPS"; }
|
||||
else { ($cdir) = $file =~ m!(.*/)!; }
|
||||
if (! -f "$cdir$finalmap") {
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print " Missing: ", &obj_name($_), " ($x1,$y1) -> $finalmap ($x,$y)\n";
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
if ($to =~ m!^/!) {
|
||||
$cdir = "$MAPS";
|
||||
} else {
|
||||
($cdir) = $file =~ m!(.*/)!;
|
||||
}
|
||||
if (! -f "$cdir$to") {
|
||||
if ($printmap) { print "$mapname"; $printmap=0;}
|
||||
print " Missing: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n";
|
||||
} else {
|
||||
# print " OK: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# @maps contains all filenames
|
||||
sub maplist {
|
||||
local ($dir, $file, @dirs) = shift;
|
||||
|
||||
opendir (DIR , $dir) || die "Can't open directory : $dir\n";
|
||||
while ($file = readdir (DIR)) {
|
||||
next if ($file eq "." || $file eq ".." || $file eq ".svn" || $file eq "unlinked" || $file eq "editor");
|
||||
$file = "$dir/$file";
|
||||
next if (-l $file);
|
||||
push (@dirs, $file) if (-d $file);
|
||||
push (@maps, $file) if (-f $file);
|
||||
}
|
||||
closedir (DIR);
|
||||
|
||||
# recurcive handle sub-dirs too
|
||||
while ($_ = shift @dirs) {
|
||||
&maplist ($_);
|
||||
}
|
||||
}
|
||||
|
||||
# collect all objects matching with reg.expr.
|
||||
sub collect {
|
||||
local ($expr,$a, %col) = shift;
|
||||
|
||||
foreach $a (keys %arches) {
|
||||
$_ = $arches{$a};
|
||||
if (/$expr/) {
|
||||
$col{$a}++;
|
||||
}
|
||||
}
|
||||
return %col;
|
||||
}
|
||||
|
||||
# collect all archetypes into associative array %arches
|
||||
sub archetypes {
|
||||
open (IN, $ARCH) || die "Can't open archetype file $ARCH.\n";
|
||||
$/ = "\nend\n";
|
||||
while (<IN>) {
|
||||
while (/^Object (\S+)\s*$/g) {
|
||||
$arches{$1} = $_;
|
||||
}
|
||||
}
|
||||
close (IN);
|
||||
}
|
||||
|
||||
sub faces {
|
||||
open(IN, $BMAPS) || die ("Can't open faces file $BMAPS\n");
|
||||
while (<IN>) {
|
||||
chomp;
|
||||
($num, $name) = split;
|
||||
$faces{$name} = $name;
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
|
||||
|
||||
sub animations {
|
||||
open(IN, $ANIM) || die ("Can't open animations file $ANIM\n");
|
||||
while (<IN>) {
|
||||
if (/^anim (\S+)\s*$/) {
|
||||
$anim{$1} = $1;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
Loading…
Reference in New Issue