map checker

To: crossfire@ifi.uio.no
Subject: map checker
From: Markus Weber <markus@dial.eunet.ch>
Date: Sat, 19 Mar 1994 16:04:33 +0100

Yo Folks :-)

I love playing crossfire, but the (non-chico) maps are driving me to
distraction...

Here's a small perl script I hacked together to perform some elementary
consistency checks on the maps. The script is appended to the end of this
mail.

Basically, the script scans the CLibDir/archetypes file for valid archetypes,
derives the start map from this file and performs a depth-first walk through
the reachable(!) maps. The checks performed are:

* Verify that archetypes in maps are valid, i.e. defined in CLibDir/archetypes.

* Complain if button, gate, etc. isn't connected, i.e. defaults. Usually
  this is done for "cosmetical" reasons, but in some cases the map is broken.

* Complain if an exit archetype is missing a destination map. The script makes
  a distinction between truly "closed" exits and those with a defaulting exit
  map, which is bad news on certain maps.

* Verify that a given exit map does indeed exist.


The output of this tool may be filtered with several goals in mind:

a) Generate list of reachable maps (relative to the start map, of course).
   Comparing this list to a "find" listing of the map directory proves
   instructional, at least as far as the 0.90.1 maps are concerned. Out of
   800++ files in the map dir, only 550 are reachable from /village/village.

   Skript example:
   grep ^visiting RESULT | sed 's/^visiting //' | sort > Maps.Reached

b) Filter all the error messages, of course. Alas, there's a certain amount
   of unavoidable noise.

c) Generate raw data for a connectivity graph:
   grep ^exit RESULT | sed 's/^exit //' | sort | uniq > Exits

   This filtered output is very handy if you plan to move maps around.

   You should be able perform additional checks with these data:
   * find the shortest path from map A to map B (using the hop count metric)
   * find all loop-free paths from A to B
   * find any/all paths from A to B not crossing C
   * verify that there are no dead ends.

This script definitely has some very rough edges and the code isn't pretty.
On the other hand, it's extremely useful for me in its current form;
as always, your mileage may vary.

Many consistency checks that come to mind require knowledge of the local map,
or that of "neighboring" maps. Other checks need to parse even more archetype
fields. In order of increasing difficulty:

* Check the "food" field for non-exit archetypes (it should be numerical).
  The old maps have been converted a few times too often.
* Search objects without solid ground underneath. Not an error, but ugly.
* Verify that jump targets (e.g. of teleporters, pits) are legal: You should
  NOT end up in a wall, in the sea, on top of a monster and the like.
* Above for exits to other maps.


-Markus

---------------------
#!/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/lib/archetypes
# cfdir=pathname-to-crossfire-installation
#	default /opt/cf0901	(hardcoded)
# mapdir=pathname-of-map-directory
#	default $cfdir/lib/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 = "/opt/cf0903";
$archdb = "./ARCHDB";

# 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;
	}
}

# post-process
$mapdir = "$cfdir/lib/maps" unless defined($mapdir);
$archetypes = "$cfdir/lib/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;

# open archetypes database
print STDERR "DBG: opening archdb: $archdb\n" if $debug > 5;
# %% performance booster: put assoc arrays in dbm files:
#if ( -f "$archdb.pag) { $skip_db_init = 1; }
#dbmopen(%ARCHDB,$archdb,0644) || die "can't dbmopen $archdb";

#
#	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";
# %% save start map in database
#$ARCHDB{"_start_map"} = $start_map;
print STDERR "DBG: start_map=$start_map\n" if $debug;

# select archetypes of special interest
# %% skip iff $skip_db_init, dbmopen() the arrays instead

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;
	}
}

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)) {

	next if $visited{$map};		# skip if been here before
	$visited{$map} = 1;		# flag it if not

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);
}


#dbmclose(ARCHDB);

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;
		}
	}

	#
	# 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);
	local($lines,$fullmap);
	local($junk);

	# 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> ) {
		$lines++;
		if (/^arch\s/) {
			($junk,$arch) = split;
			undef($slaying);
			undef($x);
			undef($y);
			undef($connected);
		}
		elsif (/^connected\s/) {
			($junk,$connected) = split;
		}
		elsif (/^slaying\s/) {
			($junk,$slaying) = split;
		}
		elsif (/^hp\s/) {
			($junk,$x) = split;
		}
		elsif (/^sp\s/) {
			($junk,$y) = split;
		}

		next if !/^end$/;	# continue iff not end of arch

		#
		# CHECK 1: valid archetype?
		#
		if (!defined($ARCHDB{$arch})) {
#print STDERR "FATAL: map $map, line $lines, bad archetype: $arch\n";
print "FATAL: map $map, line $lines, bad archetype: $arch\n";
			next;
		}

		#
		# 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") ) {
#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\n";
			next;
		}

		#
		# the exit map looks good; push it and continue
		push(@MAPS,$exit);
	}

	close(MAP);
}

# --EOF--
Prev by Date: Re: More maps
Next by Date: Re: More maps
Prev by thread: Re: cheating and suid
Next by thread: Help
Index(es):
- Date
- Thread