Move map scripts to maps distribution
git-svn-id: svn://svn.code.sf.net/p/crossfire/code/maps/trunk@19586 282e977c-c81d-0410-88c4-b93c2d0d6712master
partmedia
parent
015661a8a5
commit
c23fe5a252
11
Info/README
11
Info/README
|
|
@ -1,5 +1,16 @@
|
|||
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:
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,383 @@
|
|||
#!/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";
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
#! /usr/bin/perl
|
||||
|
||||
# this script takes a map (in new format, eg those that support
|
||||
# tiling and only save the head for multipart objects) and
|
||||
# expands it by some factor. Note that editing of the destination
|
||||
# file will certainly be necessary, but this may be useful instead
|
||||
# of having to re-do a scaled map by hand.
|
||||
|
||||
$default_X_size = 16;
|
||||
$default_Y_size = 16;
|
||||
|
||||
$expand = 2;
|
||||
$help = 0;
|
||||
$input_map = $ARGV[$#ARGV];
|
||||
|
||||
# argv loop
|
||||
foreach $i (0 .. $#ARGV) {
|
||||
if($ARGV[$i] =~ "-h") { $help = 1; }
|
||||
if($ARGV[$i] =~ "-e") { $expand = $ARGV[++$i]; }
|
||||
}
|
||||
|
||||
# various help/runtime messages
|
||||
if(!$expand||!$input_map) {
|
||||
print "USAGE: $0 -e factor <input map> > <output map> \n" ;
|
||||
exit 0;
|
||||
}
|
||||
if($help) {
|
||||
print "\n$0 options:\n" ;
|
||||
print "-e\t Factor by which to expand map x,y dimensions.\n";
|
||||
print "-h\t This help message. \n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
#Read in input map
|
||||
open(FILE, $input_map) || die "FATAL: file $input_map not found!\n";
|
||||
# process the map object special. This is easier than trying
|
||||
# to handle the special values it has
|
||||
|
||||
while (<FILE>) {
|
||||
|
||||
if (/^width (\d+)$/) {
|
||||
printf "width %d\n", $1 * $expand;
|
||||
} elsif (/^height (\d+)$/) {
|
||||
printf "height %d\n", $1 * $expand;
|
||||
} elsif (/^enter_x (\d+)$/) {
|
||||
printf "enter_x %d\n", $1 * $expand;
|
||||
} elsif (/^enter_y (\d+)$/) {
|
||||
printf "enter_y %d\n", $1 * $expand;
|
||||
}
|
||||
else { print $_; }
|
||||
last if (/^end$/);
|
||||
}
|
||||
@mapdata=<FILE>;
|
||||
close(FILE);
|
||||
|
||||
|
||||
# convert map data into objects
|
||||
while ($i<=$#mapdata) {
|
||||
local(@datum) = split (' ',$mapdata[$i]);
|
||||
if($datum[0] eq "arch") { $name[$objnum] = $datum[1]; }
|
||||
elsif($datum[0] eq "end") { $objnum++; }
|
||||
elsif($datum[0] eq "x") { $x[$objnum] = $datum[1]; }
|
||||
elsif($datum[0] eq "y") { $y[$objnum] = $datum[1]; }
|
||||
else {
|
||||
push(@otherline,$mapdata[$i]); $olines_in_obj[$objnum]++;
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
|
||||
|
||||
#Expand the map objects 1 to $objnum
|
||||
for ($j=0; $j<$objnum; $j++) {
|
||||
&expand_obj("$j $expand $bufline");
|
||||
$bufline += $olines_in_obj[$j];
|
||||
}
|
||||
|
||||
# SUBROUTINES
|
||||
|
||||
sub expand_obj {
|
||||
local($data) = @_;
|
||||
local(@temp) = split(' ',$data);
|
||||
local($obj) = $temp[0];
|
||||
local($factor) = $temp[1];
|
||||
local($end_buf) = $temp[2] + $olines_in_obj[$obj];
|
||||
local($start_x) = $x[$obj] * $factor;
|
||||
local($start_y) = $y[$obj] * $factor;
|
||||
local($end_x) = $start_x + $factor;
|
||||
local($end_y) = $start_y + $factor;
|
||||
|
||||
while($start_x<$end_x) {
|
||||
while($start_y<$end_y) {
|
||||
local($start_buf) = $temp[2];
|
||||
if($name[$obj]) { printf("arch %s\n",$name[$obj]); }
|
||||
else { return; }
|
||||
|
||||
printf("x %d\n",$start_x);
|
||||
printf("y %d\n",$start_y);
|
||||
|
||||
while ($start_buf<$end_buf) {
|
||||
print "$otherline[$start_buf]";
|
||||
$start_buf++;
|
||||
}
|
||||
print"end\n";
|
||||
$start_y++;
|
||||
}
|
||||
$start_x++;
|
||||
$start_y = $y[$obj] * $factor;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,368 @@
|
|||
#!/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);
|
||||
}
|
||||
|
|
@ -0,0 +1,264 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# This script will write (to stdout) all the needed exits to connect maps
|
||||
# in a tiled fashion. The variables at the start will need to be set
|
||||
# for things to work.
|
||||
|
||||
# Set these as appropriate to the maps it should connect to. If one is left
|
||||
# blank, then exits for that direction will not be created.
|
||||
|
||||
$MAPNAME=$ARGV[0];
|
||||
$XM=$ARGV[1];
|
||||
$YM=$ARGV[2];
|
||||
$WIDTH=$ARGV[3];
|
||||
$HEIGHT=$ARGV[4];
|
||||
#$SPLITMAP=$ARGV[5];
|
||||
|
||||
if ($MAPNAME eq "") {
|
||||
die "Usage: connect.pl <basename> <x maps> <y maps> <width> <height>";
|
||||
}
|
||||
if ($WIDTH==0) {
|
||||
$WIDTH=42;
|
||||
}
|
||||
if ($HEIGHT==0) {
|
||||
$HEIGHT=34;
|
||||
}
|
||||
|
||||
# DELTA What the overlap is - it should always be 5 for smooth transitions
|
||||
$DELTA=5;
|
||||
$xc=1;
|
||||
$yc=1;
|
||||
|
||||
print STDOUT "Creating connection maps.\n";
|
||||
|
||||
while ($xc<=$XM) {
|
||||
$yc=1;
|
||||
while ($yc<=$YM) {
|
||||
$NORTH="";
|
||||
$NORTHWEST="";
|
||||
$WEST="";
|
||||
$SOUTHWEST="";
|
||||
$SOUTH="";
|
||||
$SOUTHEAST="";
|
||||
$EAST="";
|
||||
$NORTHEAST="";
|
||||
if ($yc>1){
|
||||
$NORTH=$MAPNAME."_".$xc."_".($yc-1);
|
||||
}
|
||||
if ($yc>1 || $xc>1) {
|
||||
$NORTHWEST=$MAPNAME."_".($xc-1)."_".($yc-1);
|
||||
}
|
||||
if ($xc>1) {
|
||||
$WEST=$MAPNAME."_".($xc-1)."_".$yc;
|
||||
}
|
||||
if ($xc>1 || $yc<$YM) {
|
||||
$SOUTHWEST=$MAPNAME."_".($xc-1)."_".($yc+1);
|
||||
}
|
||||
if ($yc<$YM) {
|
||||
$SOUTH=$MAPNAME."_".$xc."_".($yc+1);
|
||||
}
|
||||
if ($yc<$YM || $xc<$XM) {
|
||||
$SOUTHEAST=$MAPNAME."_".($xc+1)."_".($yc+1);
|
||||
}
|
||||
if ($xc<$XM) {
|
||||
$EAST=$MAPNAME."_".($xc+1)."_".$yc;
|
||||
}
|
||||
if ($xc<$XM || $yc>1) {
|
||||
$NORTHEAST=$MAPNAME."_".($xc+1)."_".($yc-1);
|
||||
}
|
||||
$THISMAP=$MAPNAME."_".$xc."_".$yc;
|
||||
open (MAP, ">$THISMAP") or die "unable to open mapfile.";
|
||||
print MAP "arch map\n";
|
||||
print MAP "name $MAPNAME\n";
|
||||
print MAP "msg\n";
|
||||
print MAP "Creator: splitmap.pl\n";
|
||||
print MAP "Email: azzie\@tellutec.se\n";
|
||||
print MAP "Date: Wed Oct 27 10:59:23 1993\n";
|
||||
print MAP "endmsg\n";
|
||||
print MAP "hp ".($DELTA+1)."\n";
|
||||
print MAP "sp $DELTA\n";
|
||||
print MAP "x $WIDTH\n";
|
||||
print MAP "y $HEIGHT\n";
|
||||
print MAP "end\n";
|
||||
print $MAPNAME."_".$xc."_".$yc."\n";
|
||||
# print "XC=".$xc."\n";
|
||||
# print "YC=".$yc."\n";
|
||||
#$NORTHWEST="";
|
||||
#$WEST="";
|
||||
#$SOUTHWEST="";
|
||||
#$SOUTH="world_a3";
|
||||
#$SOUTHEAST="world_b3";
|
||||
#$EAST="world_b2";
|
||||
#$NORTHEAST="world_b1";
|
||||
# End of configurable options.
|
||||
# Quick reminder - hp is the destination x, sp is the destination y
|
||||
|
||||
# Lets do the corners first
|
||||
if ($NORTHWEST ne "") {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $NORTHWEST\n";
|
||||
print MAP "x ".($DELTA-1)."\n";
|
||||
print MAP "y ".($DELTA-1)."\n";
|
||||
print MAP "hp ".($WIDTH-$DELTA-1)."\n";
|
||||
print MAP "sp ".($HEIGHT-$DELTA-1)."\n";
|
||||
print MAP "end\n";
|
||||
}
|
||||
if ($SOUTHWEST ne "") {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $SOUTHWEST\n";
|
||||
print MAP "x ".($DELTA-1)."\n";
|
||||
print MAP "y ".($HEIGHT-$DELTA)."\n";
|
||||
print MAP "hp ".($WIDTH-$DELTA-1)."\n";
|
||||
print MAP "sp ".($DELTA)."\n";
|
||||
print MAP "end\n";
|
||||
}
|
||||
if ($SOUTHEAST ne "") {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $SOUTHEAST\n";
|
||||
print MAP "x ".($WIDTH-$DELTA)."\n";
|
||||
print MAP "y ".($HEIGHT-$DELTA)."\n";
|
||||
print MAP "hp ".($DELTA)."\n";
|
||||
print MAP "sp ".($DELTA)."\n";
|
||||
print MAP "end\n";
|
||||
}
|
||||
if ($NORTHEAST ne "") {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $NORTHEAST\n";
|
||||
print MAP "x ".($WIDTH-$DELTA)."\n";
|
||||
print MAP "y ".($DELTA-1)."\n";
|
||||
print MAP "hp ".($DELTA)."\n";
|
||||
print MAP "sp ".($HEIGHT-$DELTA-1)."\n";
|
||||
print MAP "end\n";
|
||||
}
|
||||
|
||||
# Now lets do the edges.
|
||||
|
||||
if ($NORTH ne "") {
|
||||
$x=$DELTA;
|
||||
while ($x < ($WIDTH-$DELTA)) {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $NORTH\n";
|
||||
print MAP "x ".$x."\n";
|
||||
print MAP "y ".($DELTA-1)."\n";
|
||||
print MAP "hp ".$x."\n";
|
||||
print MAP "sp ".($HEIGHT-$DELTA-1)."\n";
|
||||
print MAP "end\n";
|
||||
$x=$x+1;
|
||||
}
|
||||
}
|
||||
|
||||
if ($SOUTH ne "") {
|
||||
$x=$DELTA;
|
||||
while ($x < ($WIDTH-$DELTA)) {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $SOUTH\n";
|
||||
print MAP "x ".$x."\n";
|
||||
print MAP "y ".($HEIGHT-$DELTA)."\n";
|
||||
print MAP "hp ".$x."\n";
|
||||
print MAP "sp ".($DELTA)."\n";
|
||||
print MAP "end\n";
|
||||
$x=$x+1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if ($WEST ne "") {
|
||||
$y=$DELTA;
|
||||
while ($y < ($HEIGHT-$DELTA)) {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $WEST\n";
|
||||
print MAP "x ".($DELTA-1)."\n";
|
||||
print MAP "y ".$y."\n";
|
||||
print MAP "hp ".($WIDTH-$DELTA-1)."\n";
|
||||
print MAP "sp ".$y."\n";
|
||||
print MAP "end\n";
|
||||
$y=$y+1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if ($EAST ne "") {
|
||||
$y=$DELTA;
|
||||
while ($y < ($HEIGHT-$DELTA)) {
|
||||
print MAP "arch exit\n";
|
||||
print MAP "slaying $EAST\n";
|
||||
print MAP "x ".($WIDTH-$DELTA)."\n";
|
||||
print MAP "y ".$y."\n";
|
||||
print MAP "hp ".($DELTA)."\n";
|
||||
print MAP "sp ".$y."\n";
|
||||
print MAP "end\n";
|
||||
$y=$y+1;
|
||||
}
|
||||
}
|
||||
close MAP;
|
||||
$yc=$yc+1;
|
||||
}
|
||||
$xc=$xc+1;
|
||||
}
|
||||
|
||||
# Second pass. Connected maps opened and primary map superimposed.
|
||||
|
||||
print STDOUT "Done with connecting, now superimposing split map.\n";
|
||||
$xc=1;
|
||||
$yc=1;
|
||||
while ($xc<=$XM) {
|
||||
$yc=1;
|
||||
while ($yc<=$YM) {
|
||||
$NEWMAP=$MAPNAME."_".$xc."_".$yc.".new";
|
||||
$THISMAP=$MAPNAME."_".$xc."_".$yc;
|
||||
open (MAP, ">>$THISMAP") or die "unable to open new mapfile.";
|
||||
# open (CONMAP, "$THISMAP") or die "unable to open connected mapfile.";
|
||||
open (IMPMAP, "$MAPNAME") or die "unable to open superimposed mapfile.";
|
||||
$currentline=<IMPMAP>;
|
||||
print STDOUT "Now superimposing on map ".$THISMAP."\n";
|
||||
# Discard header
|
||||
$headscan=1;
|
||||
while ($headscan) {
|
||||
if ($currentline=~/end\n/) {
|
||||
$headscan=0;
|
||||
}
|
||||
$currentline=<IMPMAP>;
|
||||
}
|
||||
# Read rest of file
|
||||
while ($currentline) {
|
||||
# print STDOUT $currentline;
|
||||
# Scan for and buffer archs within bounds.
|
||||
while ($currentline ne "end\n" && $currentline) {
|
||||
|
||||
if ($currentline=~/x /) {
|
||||
($florp, $px) = split //,$currentline,2;
|
||||
$currentline="x ".($px-(($xc-1)*$WIDTH)+(($xc-1)*$DELTA*2))."\n";
|
||||
}
|
||||
if ($currentline=~/y /) {
|
||||
($florp, $py)=split //,$currentline,2;
|
||||
$currentline="y ".($py-(($yc-1)*$HEIGHT)+(($yc-1)*$DELTA*2))."\n";
|
||||
}
|
||||
if ($currentline ne "x 0\n" && $currentline ne "y 0\n"){
|
||||
$buf=$buf.$currentline;
|
||||
}
|
||||
$currentline=<IMPMAP>;
|
||||
}
|
||||
$buf=$buf.$currentline;
|
||||
# print STDOUT $px.$py;
|
||||
if ($px >= (($xc-1)*$WIDTH)-(($xc-1)*$DELTA*2) && $px < ($xc*$WIDTH)-(($xc-1)*$DELTA*2) && $py >= (($yc-1)*$HEIGHT)-(($yc-1)*$DELTA*2) && $py < ($yc*$HEIGHT)-(($yc-1)*$DELTA*2)) {
|
||||
# print STDOUT "In map: ".$THISMAP."\n";
|
||||
print MAP $buf;
|
||||
# print STDOUT ".";
|
||||
|
||||
}
|
||||
# else {
|
||||
# print STDOUT "-";
|
||||
# }
|
||||
$px=0;
|
||||
$py=0;
|
||||
$buf="";
|
||||
$currentline=<IMPMAP>;
|
||||
}
|
||||
close MAP;
|
||||
close CONMAP;
|
||||
close IMPMAP;
|
||||
$yc=$yc+1;
|
||||
# print STDOUT "\n";
|
||||
}
|
||||
$xc=$xc+1;
|
||||
}
|
||||
Loading…
Reference in New Issue