From c23fe5a252b2a75c13b74826d6b9dab8c2ff81fe Mon Sep 17 00:00:00 2001 From: partmedia Date: Thu, 26 Jun 2014 00:38:11 +0000 Subject: [PATCH] Move map scripts to maps distribution git-svn-id: svn://svn.code.sf.net/p/crossfire/code/maps/trunk@19586 282e977c-c81d-0410-88c4-b93c2d0d6712 --- Info/README | 11 ++ Info/map_check | 383 +++++++++++++++++++++++++++++++++++++++++++++ Info/map_expand.pl | 110 +++++++++++++ Info/map_info | 368 +++++++++++++++++++++++++++++++++++++++++++ Info/mapslitter.pl | 264 +++++++++++++++++++++++++++++++ 5 files changed, 1136 insertions(+) create mode 100644 Info/map_check create mode 100644 Info/map_expand.pl create mode 100644 Info/map_info create mode 100644 Info/mapslitter.pl diff --git a/Info/README b/Info/README index 2c048ce42..c31157820 100644 --- a/Info/README +++ b/Info/README @@ -1,5 +1,16 @@ In this directory is utilities, gif images of the maps, and other notes. +map_info: (From Tero Haatanen ). 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: diff --git a/Info/map_check b/Info/map_check new file mode 100644 index 000000000..08032d8d5 --- /dev/null +++ b/Info/map_check @@ -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 ( ) { + $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 ( ) { + 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"; + } +} + diff --git a/Info/map_expand.pl b/Info/map_expand.pl new file mode 100644 index 000000000..4fb140695 --- /dev/null +++ b/Info/map_expand.pl @@ -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 > \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 () { + + 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=; +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; + } +} + diff --git a/Info/map_info b/Info/map_info new file mode 100644 index 000000000..c66344dac --- /dev/null +++ b/Info/map_info @@ -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 +# +# 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; + } + $_ = ; + 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 () { + if (($m = (@_ = /^arch \S+\s*$/g)) > 1) { + $parent = /^arch (\S+)\s*$/; + # object has inventory + my ($inv) = $_; + while () { + 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 () { + while (/^Object (\S+)\s*$/g) { + $arches{$1} = $_; + } + } + close (IN); +} + +sub faces { + open(IN, $BMAPS) || die ("Can't open faces file $BMAPS\n"); + while () { + chomp; + ($num, $name) = split; + $faces{$name} = $name; + } + close(IN); +} + + +sub animations { + open(IN, $ANIM) || die ("Can't open animations file $ANIM\n"); + while () { + if (/^anim (\S+)\s*$/) { + $anim{$1} = $1; + } + } + close(IN); +} diff --git a/Info/mapslitter.pl b/Info/mapslitter.pl new file mode 100644 index 000000000..1fcc92a83 --- /dev/null +++ b/Info/mapslitter.pl @@ -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 "; +} +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=; + print STDOUT "Now superimposing on map ".$THISMAP."\n"; +# Discard header + $headscan=1; + while ($headscan) { + if ($currentline=~/end\n/) { + $headscan=0; + } + $currentline=; + } +# 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=; + } + $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=; + } + close MAP; + close CONMAP; + close IMPMAP; + $yc=$yc+1; +# print STDOUT "\n"; + } + $xc=$xc+1; +}