#!/usr/local/bin/perl
#################################################################################
#
# IIII NN NN FFFFFFF OOOO RRRRRRR MM MM AAAA PPPPPP
# II MM NN FF OO OO RR RR MMM MMM AA AA PP PP
# II NNN NN FF OO OO RR RR MMM MMM AA AA PP PP
# II NN N MM FFFFF OO OO RRRRRRR MM MM MM AAAAAAAA PPPPPP
# II NN NNNN FF OO OO RR RR MM MM AA AA PP
# II NN NN FF OO OO RR RR MM MM AA AA PP
# IIII NN NN FF OOOO RR RR MM MM AA AA PP
#
#
# F L O A T T H E C A V E . . .
#
#
# (c) 1998/1999 by Toni Arnold, Zurich
# ------------------------------------------------------------------------------
# Perl-Script that draws a map in ASCII-"graphics"
# out of an Inform source file
#
# Version 1.1b0
# Serial Number 990507
#
# Some information about perl can be found at:
#
http://www.gnu.org/software/perl/perl.html
# ------------------------------------------------------------------------------
# Comments and bug reports to:
#
[email protected]
#
# Copying is free as long as it is
# - not commercial
# - copied as a whole
# ------------------------------------------------------------------------------
#
# Call
# ----
#
# perl informap.pl infile [outfile] [flags]
#
# This creates a map with filename: filename.map.txt
# Have a look at that map with your favorite ASCII-Text-editor.
# (be sure to switch word wrapping off!)
#
# outfile
# -------
# Some machines (eg. DOS) don't allow long filenames. For that reason
# the second argument is recognized as the output filename if it is
# not a flag. If there are multiple columns selected, the (necessary)
# numbers in the filename are added as extension to the outfile which
# makes it a file type. This not really good, but I found no other
# general solution.
#
# Flags
# -----
#
# flags are recognized by a letter followed by =
# ignores the case of the flag letter and they can appear in any order
#
# n=[number] e.g. N=15
# ----------
# number is the width of a single room NAME printed and defaults to 11
# only odd numbers are accepded, even numers are increased by 1
#
# c=[number] e.g. C=80
# ----------
# number is the width of a single COLUMN to be printed out. Maps get often
# larger than the maximum width of a text on the printer. For printing them
# they are split if they are larger than the column width. The filenames
# become then filename.map.001.txt filename.map.002.txt ....
#
# f=[on/off] e.g. f=off
# ----------
# This flag indicates whether "Include"-FILEPATHS should be FOLLOWED
# or not. There are files defined which are ignored always. Edit
# @include_ignore = (...); below to add files to the ignore-list.
# Default is on.
#
# p=[hor/ver] e.g. p=ver
# -----------
# It is common style to program both a HORIZONTAL direction, e.g. w_to,
# and a VERTICAL direction, e.g. d_to, to the same room. In that case
# informap has to choose whether the horizontal direction has to be drawn
# (on the same floor) or the vertical one on a new floor (below in the
# example). Default is to PREFER horizontal - the flag can change this.
#
#
# Comment about the call in Windows
# ---------------------------------
# On Unix it is possible to call perl without "perl" by adjoining the
# perl binary path to the first line of the script. On Windows NT *.pl
# can be associated with perl, which works at least with the ActiveState
# distribution.
# ------------------------------------------------------------------------------
#
# Revision history
# ----------------
#
# V1.0 first release
# V1.1 before[go; n_obj: PlayerTo(Room,2)]; is now recognized
#
# ------------------------------------------------------------------------------
#
# Known Bugs and lacks
# --------------------
#
# - Doors (door_dir) are not handled
# - out_to is not handled. This is really a problem e.g. in adventure.inf
#
# ------------------------------------------------------------------------------
#
# Example
# =======
#
# The following is a shortened inform file:
# -----------------------------------------
#
# Object Middle
# n_to North
# s_to south
# w_to West
# sw_to southwest
# nw_to northwest
#
# Object Southwest
# ne_to Middle
# n_to West
#
# Object North
# s_to middle
# d_to cellar
#
# Object West
# e_to Middle
# n_to Northwest
# s_to South
#
# Object Cellar
# u_to North
#
# Object NorthWest
# se_to South
# s_to West
#
# Object South
# nw_to Northwest
# n_to Middle
#
#
# This is the map drawn by INFORMAP:
# ----------------------------------
#
# ______________ ______________
# / / / /
# / northwest / / north /
# /___________|south| /_____________/
# |
# / ^ / |
# / ^ / |
# / ^ / :
# ______________ ______________
# / / / /
# / west / ------- / middle /.
# /___>south>___/ /_____________/
# ___
# ^ ___/ / .
# ^ ___/ /
# ^ ___/ /
# ______________ ______________ .
# / / |northwe| /
# / southwest / / south /
# /_____________/ /_____________/ .
#
#
# .
# :
# |
# |
# _____|________
# / /
# / cellar /
# /_____________/
#
#
# Legend
# ------
# - Names in squares are rooms
# - Connections in between ("lines") are compass directions
# - If a connection is drawn as >>> od ^^^ it is only in one direction
# - If a room cannot be connected with a line it is printed on the border
# of the room it is attached to. It is written as |room| if it is bidirectional
# and as >room> if it is only in one direction
#
# ------------------------------------------------------------------------------
# This file contains the whole commented source code. I suppose that it still
# contains inconsistencies and the like; I just made it work by hacking.
#
# Table of sections
# -----------------
#
# SECTION 1: GET COMMAND LINE
# SECTION 2: GET FILE(S) AND DECODE INPUT
# SECTION 3: BUILD LOGICAL MAP
# SECTION 4: BUILD LOGICAL DIRECTIONS
# SECTION 5: BUILD GRAPHICAL MAP
# SECTION 6: SAVE GRAPHICAL MAP
#
# For non-perl-users: the script has to be read as a script which is executed
# line per line from top to bottom. Subroutines (sub name { ) of course are
# skipped while passing them executing the script.
# Some parts (esp. sections 3 and 4) are extremely redundant. With Object
# oriented programming the space could possibly be reduced, but I was not
# able to use objects, so the code is old fashioned c-klone-style.
#################################################################################
# This Array contains "include"-files that shoud be ignored.
# It can be parts of the game that should not be "mapped"
# or - more important - library files containig rooms
# Case is ignored!
@include_ignore = ("Parser","VerbLib","Grammar",
"GermanG"); # language library
$outfile_suffix = ".map"; # change it if you like it different
$outfile_type = ".txt";
#######################
# Print title message #
#######################
print "\nINFORMAP V1.1b0\n";
print "(c) 1998/1999 by Toni Arnold, Zurich\n\n";
####################### SECTION 1: GET COMMAND LINE ##########################
#####################################
# get the arguments
#####################################
# first argument = inform file
# $inform to draw a map from
# -> open it and read content to
# @inform
$inform = $ARGV[0];
$outfile_name = $inform; # can be overridden by explicite filename
if ((not defined($inform)) or ($inform =~ /\w=.*/)) {
die "No input file specified!\nCall: perl informap.pl infile [outfile] [flags]\n";
}
# argument defaults
$room_width = 13;
$column_width = 99999;
$include_flag = "on";
$prefer_dir = "hor";
# facualtative more arguments
# n=13 width of the room Names (default = 11)
# allows only odd numbers
# c=80 width of a column for printing
# the columns get numbered from 000 to 999
# (default = 99999 [+- infinite for screen])
for ($i=1;$i<=@ARGV;$i++) { # number of arguments
if (defined($ARGV[$i])) {
$arg = $ARGV[$i];
if (($i==1) && ($arg ne "") && # second argument as possible filename
($arg !~ /\w=.*/)) { # matches everything except flags
$outfile_name = $arg; # take it as outfilename
$outfile_suffix = ""; # no additional suffix and type
$outfile_type = "";
$arg = ""; # mark as done
};
if ($arg =~ /n=(\d+)/i) { # --- N=23 ---
$room_width = $1;
if ($room_width > 33) { # names in inform up to 32 chars
$room_width = 33;
};
if ($room_width < 0) { # if < 0 make it > 0
$room_width = $room_width * -1; # (not necessary no more)
};
if (($room_width % 2) == 0) { # if even
$room_width++; # make it odd
};
$arg = ""; # mark as done
};
if ($arg =~ /c=(\d+)/i) { # --- C=23 ---
$column_width = $1;
$arg = "";
};
if (lc($arg) eq "f=on") { # --- F=ON ---
$include_flag = "on";
$arg = "";
};
if (lc($arg) eq "f=off") { # --- F=OFF ---
$include_flag = "off";
$arg = "";
};
if (lc($arg) eq "p=hor") { # --- P=HOR ---
$prefer_dir = "hor";
$arg = "";
};
if (lc($arg) eq "p=ver") { # --- P=VER ---
$prefer_dir = "ver";
$arg = "";
};
if ($arg ne "") { # !! die on invalid arguments !!
die ("Invalid argument: $arg\n");
};
};
};
#################### SECTION 2: GET FILE(S) AND DECODE INPUT ####################
#########################################
# Read Map-Relevant Data into Array
# of arrays of room
# --------------------------------------
# The array @room[n] contains afterwards
# for each room n an entry like below.
# Entry for room $x:
# @room($room_elements*$x)
#########################################
# @rooms[n] =
$name = 0;
$n_to = 1;
$ne_to = 2;
$e_to = 3;
$se_to = 4;
$s_to = 5;
$sw_to = 6;
$w_to = 7;
$nw_to = 8;
$u_to = 9;
$d_to = 10;
$out_to = 11;
$in_to = 12;
#$door_dir = 13;
$room_elements = 14; # the number of elements to manually create
# multidimensional array
# (everything else didn't work)
# ------------------------------------------
# accommodate_new_room
# is called inside the input line loop
# every time when a direction is detected.
# if it's the first direction of the object,
# then the object is recognized as a room
# ------------------------------------------
sub accommodate_new_room {
my($i);
if ($room_detected eq "false") { # if it's not already recogn. as a room
$room_number++; # increase room number to new room
@room[$room_number*$room_elements] = $possible_room; # name of the room
for ($i=1,$i<$room_elements,$i++) { # init direction strings
@room[($room_number*$room_elements)+$i] = ""; # initial value
};
$room_detected = "true"; # mark current room as initialized
};
}
# --------------------------------------------------
# is_valid_file(Filename)
# checks the Filename case insensitive against
# @include_ignore (at the beginning of the script)
# returns true if it is valid, else false
# --------------------------------------------------
sub is_valid_filename {
my($file) = @_;
my($a,$b,$i,$end,$out);
$out = "true"; # init default value
$a = lc($file); # lower case filename
$end = @include_ignore;
for ($i=0;$i<=$end;$i++) { # loop trough every skip filename
$b = lc($include_ignore[$i]);
if ($a eq $b) {
$out = "false";
};
};
$out;
}
# ---------------- input line loop --------------------
# @inform holds the current inform file
# graps the information from this file
# to handle include-statements it is a subroutine
sub input_line_loop {
$line_number=0;
$room_detected = "false"; # whether current object is a room
$before_detected = "false"; # for before go: n_obj: PlayerTo...
$go_detected = "false"; # the 'go:' itself
$go_obj_detected = ""; # no go-obj yet detected
while (<INFORMFILE>) {
$line = $_; # $line contains the actual line
if ($line !~ /^\s*!/) { # skip commented lines
$line =~ s/!.*//; # remove comment at the end
# pattern matching: recognize Include-Statements
if ($include_flag eq "on") {
if (($line =~ /include\s*"(.+)"/i) and
(is_valid_filename($1) eq "true")) {
push (@file_stack,$1);
};
};
# pattern matching: recognize object header (= new room)
if ($line =~ /object\s+(\w+)/i ) {
# ^word "object" (/i = ignore case)
# ^word boundary
# ^name of the (possible) room object
$possible_room = "\L$1\E"; # room name could be any object
$possible_room =~ s/\Afalse\Z/false /; # avoid name conflicts because
# FOR PERL false is equal to the string "false" (SHIT) -> add a space
$room_detected = "false"; # so it is not detected as room up to now
$before_detected = "false"; # and no before
$go_detected = "false"; # and no go up to now
$go_obj_detected = ""; # no go-obj yet detected
};
# === pattern matching: assign the explicite directions ===
if ($line =~ /\bn_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$n_to] = $r;
};
if ($line =~ /\bne_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$ne_to] = $r;
};
if ($line =~ /\be_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$e_to] = $r;
};
if ($line =~ /\bse_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$se_to] = $r;
};
if ($line =~ /\bs_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$s_to] = $r;
};
if ($line =~ /\bsw_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$sw_to] = $r;
};
if ($line =~ /\bw_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$w_to] = $r;
};
if ($line =~ /\bnw_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$nw_to] = $r;
};
if ($line =~ /\bu_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$u_to] = $r;
};
if ($line =~ /\bd_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$d_to] = $r;
};
if ($line =~ /\bin_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$in_to] = $r;
};
if ($line =~ /\bout_to\s+(\w+)/i ) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$out_to] = $r;
};
# === pattern matching: assign the before go: - directions ===
if ($line =~ /\bbefore\b/i ) { # detect before
$before_detected = "true";
};
if ($line =~ /\bgo\s*:/i ) { # detect go
if ($before_detected eq "true") { # only if before is already detected
$go_detected = "true";
};
};
# --- recognize go_objects ---
if ($go_detected eq "true") {
if ($line =~ /\b(n_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(ne_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(e_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(se_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(s_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(sw_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(w_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(nw_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(u_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
if ($line =~ /\b(d_obj)\s*:/i ) {
$go_obj_detected = lc($1);
};
};
# --- beginning of before go - playerto-routines ---
if (($go_obj_detected eq "n_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$n_to] = $r;
};
if (($go_obj_detected eq "ne_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$ne_to] = $r;
};
if (($go_obj_detected eq "e_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$e_to] = $r;
};
if (($go_obj_detected eq "se_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$se_to] = $r;
};
if (($go_obj_detected eq "s_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$s_to] = $r;
};
if (($go_obj_detected eq "sw_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$sw_to] = $r;
};
if (($go_obj_detected eq "w_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$w_to] = $r;
};
if (($go_obj_detected eq "nw_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$nw_to] = $r;
};
if (($go_obj_detected eq "u_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$u_to] = $r;
};
if (($go_obj_detected eq "d_obj") && ($line =~ /\bplayerto\((\w+),/i )) {
&accommodate_new_room;
$r = "\L$1\E";
$r =~ s/\Afalse\Z/false /; # avoid name conflicts
@room[($room_number*$room_elements)+$d_to] = $r;
};
# --- end of before go - directions ---
# if ($line =~ /\bdoor_dir\s+(\w+)/i ) {
# &accommodate_new_room;
# $r = "\L$1\E";
# $r =~ s/\Afalse\Z/false /; # avoid name conflicts
# @room[($room_number*$room_elements)+$door_dir] = $r;
# };
}; # endif skip commented lines
$line_number++; # get next line
};
}
# ------------ end of input line loop -----------------
############################################
# Load the Infocom Game File(s) into @inform
# $inform holds the main file name
############################################
# STATUS
print "Drawing a map out of the file '$inform'\n";
$room_number=-1; # initialize room counter (-1 for no room)
$input_file = $inform; # main file = first input file
while (defined($input_file)) { # loop for all include files
$skip_nonfile = "false"; # for skipping nonexistent files
unless (open(INFORMFILE, $input_file)) {
if ($input_file eq $inform) { # unable to open main file
if (-e $input_file) {
die ("Inform main file '$input_file' exists, but cannot be opened\n");
} else {
die ("Can't open Inform main file '$input_file'\n");
};
} else {
if (-e $input_file) {
print "Included Inform file '$input_file' exists, but cannot be opened\n";
} else {
print "Can't open included Inform file '$input_file'\n";
};
$skip_nonfile = "true";
};
};
if ($skip_nonfile eq "false") { # if it could be opened
if ($input_file ne $inform) { # message only for include files
print "Including '$input_file'\n";
};
&input_line_loop; # get the whole information from the file
close(INFORMFILE); # close it
};
$input_file = pop(@file_stack); # Include-Statements can push files
};
# -----------------------------------
# for debugging:
# print the information got from
# the inform file
# to switch on comment out:
# - - - - - - - - - - - - - - - - - -
# &print_room_array;
# -----------------------------------
sub print_room_array {
$t = $room_number + 1;
print "\ntotal number of rooms: $t\n\n";
for ($i=0;$i<=$room_number;$i++) {
print "Room: @room[$i*$room_elements]\n";
for ($j=1;$j<$room_elements;$j++) {
$print = @room[($i*$room_elements)+$j];
if ($print ne "") {
print " $j: $print\n";
};
};
};
print "\n\n";
}
# STATUS
print "Got map data\n";
####################### SECTION 3: BUILD LOGICAL MAP ########################
#################################################
# Assigns to every room a position in a
# 3-dimensions-space @map
# ----------------------------------------------
# The Array has the length $room_number
# with three integers with the following indices:
# 0 Name of the room
# 1 x-Position west -> east
# 2 y-Position North -> South
# 3 z-Poistion Down -> Up
#################################################
# ****************** Subroutines ******************
# index = room_in_map (+Room_Name)
# returns -1 if the room is not in the map
# else returns the index of the name of the room
sub room_in_map {
my($room) = @_;
my($i,$maplen,$out);
$out=-1; # default: -1
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if (@map[$i*4] eq $room) { # * 4 = 1 array-entry
$out = $i;
};
};
$out; # returns the index for the room
}
# boolean/string = room_at_place(+x,+y,+z)
# false if there is no room at that place,
# "name" of the room if there is one
# at this place already
sub room_at_place {
my($x,$y,$z) = @_;
my($i,$maplen,$return);
$return = "false"; # init return value
if (($x>=0) and ($y>=0) and ($z>=0)) {; # can be < 0 in the computation
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if ((@map[($i*4)+1] == $x) and
(@map[($i*4)+2] == $y) and
(@map[($i*4)+3] == $z) ) {
$return = @map[$i*4]; # name of the room
};
};
};
$return;
}
# ----------------------------
# getting room coordinates
# by room name
# ----------------------------
# x_coord = get_room_x (+RoomName)
sub get_room_x {
my($name) = @_;
my($i,$maplen,$return);
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if (@map[($i*4)] eq $name) { # if current room is the room searched for
$return = @map[($i*4)+1]; # store its x-coordinate
};
};
$return;
}
# y_coord = get_room_y (+RoomName)
sub get_room_y {
my($name) = @_;
my($i,$maplen,$return);
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if (@map[($i*4)] eq $name) { # if current room is the room searched for
$return = @map[($i*4)+2]; # store its y-coordinate
};
};
$return;
}
# z_coord = get_room_z (+RoomName)
sub get_room_z {
my($name) = @_;
my($i,$maplen,$return);
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if (@map[($i*4)] eq $name) { # if current room is the room searched for
$return = @map[($i*4)+3]; # store its z-coordinate
};
};
$return;
}
# ----------------------------
# shifting rooms around
# while drawing the map
# ----------------------------
# sift_x(+Position)
# Shifts all x-coordinates of the rooms in the map
# from position x until end
sub shift_x {
my($pos) = @_;
my($i,$maplen);
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if (@map[($i*4)+1] >= $pos) { # if current room is right or eq of x_pos
@map[($i*4)+1]++; # shift it right
};
};
}
# sift_y(+Position)
# Shifts all y-coordinates of the rooms in the map
# from position y until end
sub shift_y {
my($pos) = @_;
my($i,$maplen);
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if (@map[($i*4)+2] >= $pos) { # if current room is right or eq of y_pos
@map[($i*4)+2]++; # shift it right
};
};
}
# sift_z(+Position)
# Shifts all z-coordinates of the rooms in the map
# from position z until end
sub shift_z {
my($pos) = @_;
my($i,$maplen);
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) { # go through every room
if (@map[($i*4)+3] >= $pos) { # if current room is right or eq of z_pos
@map[($i*4)+3]++; # shift it right
};
};
}
# ---- adding of a new room ----
# add_new_room (+Room_Name)
# adds a new room to the map
# (=not connected with the map)
# under every other room
sub add_new_room {
my($room_name) = @_;
my($i,$maplen,$z,$max_z);
$maplen = int(@map/4); # current length of the map
if ($map[0] eq "") { # if it's the first room at all
$map[0] = $room_name; # add it at 0,0,0
$map[1] = 0;
$map[2] = 0;
$map[3] = 0;
} else { # if it's a new map in the map
$max_z = 0;
for ($i=0;$i<$maplen;$i++) { # find max. z-pos
if ($map[($i*4)+3] > $max_z) { # i+3 = z-pos
$max_z = $map[($i*4)+3];
};
};
$z = @map;
$map[$z] = $room_name; # enter the new room at 0,0,(max_z+1)
$map[$z+1] = 0;
$map[$z+2] = 0;
$map[$z+3] = $max_z + 1;
};
}
# index = get_room_index (+Room)
# finding a room index to
# @room[i] by its name
sub get_room_index {
my($room_name) = @_;
my($i,$out);
for($i=0;$i<=$room_number;$i++) {
if (@room[$i*$room_elements] eq $room_name) {
$out = $i*$room_elements;
};
};
$out; # returns the index for the room
}
# $current_room = next_room_left;
# compares the list of rooms detected
# against the list of rooms on the logical map
# returns "" if there is no room left,
# else the name of the next new room
sub next_room_left {
my ($i,$room,$out);
$out = ""; # init return
if ($out eq "") { # if no neighbour room found
for ($i=0;$i<=$room_number;$i++) { # loop trough every room detected again
$room = @room[$i*$room_elements];
if ((room_in_map ($room) == -1) and # if the room is not in the map
($out eq "")) { # if it's the first new room
$out = $room;
};
};
};
$out;
}
# ****************** End of Subroutines ******************
# -----------------------------------
# Building of the map
# - - - - - - - - - - - - - - - - - -
# The first room in the text is taken
# as startpoint. It is added to the
# map and then every direction is
# scanned. If there is a room,
# it becomes added to @map
# @dirs holds the directions defined
# -----------------------------------
$current_room = next_room_left; # the first room at all
# -> $current_room holds a room name as a string
# the p=ver/hor - flag made it necessary to
# extract the vertical directions into a subroutine,
# but logically it belongs to the loop just like the others.
sub float_up_down {
# u_to
$next_room = $room[$room_index+$u_to];
if ($next_room ne "") { # if there IS a room upwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room); # Position of the
$y = get_room_y ($current_room); # new room
$z = get_room_z ($current_room)-1;
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_z($z); # create place
};
if ($z == -1) { # new room at top -> push down
shift_z(0); # all other rooms
$z = 0; # z-pos of the new room
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# d_to
$next_room = $room[$room_index+$d_to];
if ($next_room ne "") { # if there IS a room downwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room); # Position of the
$y = get_room_y ($current_room); # new room
$z = get_room_z ($current_room)+1;
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_z($z); # create place
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
}
# --- floats every cave ---
while ($current_room ne "") {
# -------- floats one cave starting with $current_room -----------
while (defined($current_room)) { # main loop, stop if stack is empty
if (room_in_map($current_room) == -1) { # if room is not on the map
add_new_room($current_room); # add it to the map bottom
};
$room_index = get_room_index($current_room);
# if u_to and d_to have priority over the same floor e.g. e_to or n_to:
if ($prefer_dir eq "ver") {float_up_down;};
# n_to
$next_room = $room[$room_index+$n_to];
if ($next_room ne "") { # if there IS a room nordwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room); # Position of the
$y = get_room_y ($current_room)-1; # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_y($y); # create place
};
if ($y == -1) { # new room at back -> push forward
shift_y(0); # all other rooms
$y = 0; # y-pos of the new room
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# s_to
$next_room = $room[$room_index+$s_to];
if ($next_room ne "") { # if there IS a room southwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room); # Position of the
$y = get_room_y ($current_room)+1; # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_y($y); # create place
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# w_to
$next_room = $room[$room_index+$w_to];
if ($next_room ne "") { # if there IS a room westwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room)-1; # Position of the
$y = get_room_y ($current_room); # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_x($x); # create place
};
if ($x == -1) { # new room on left -> push
shift_x(0); # right all other rooms
$x = 0; # x-pos of the new room
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# e_to
$next_room = $room[$room_index+$e_to];
if ($next_room ne "") { # if there IS a room eastwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room)+1; # Position of the
$y = get_room_y ($current_room); # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_x($x); # create place
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# nw_to
$next_room = $room[$room_index+$nw_to];
if ($next_room ne "") { # if there IS a room northwestwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room)-1; # Position of the
$y = get_room_y ($current_room)-1; # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_x($x); # create place on the right
};
if ($x == -1) { # new room on left -> push
shift_x(0); # right all other rooms
$x = 0; # x-pos of the new room
};
if ($y == -1) { # new room at back -> push
shift_y(0); # forward all other rooms
$y = 0; # y-pos of the new room
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# se_to
$next_room = $room[$room_index+$se_to];
if ($next_room ne "") { # if there IS a room southeastwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room)+1; # Position of the
$y = get_room_y ($current_room)+1; # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_x($x); # create place
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# sw_to
$next_room = $room[$room_index+$sw_to];
if ($next_room ne "") { # if there IS a room northwestwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room)-1; # Position of the
$y = get_room_y ($current_room)+1; # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_x($x); # create place on the right
};
if ($x == -1) { # new room on left -> push
shift_x(0); # right all other rooms
$x = 0; # x-pos of the new room
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# ne_to
$next_room = $room[$room_index+$ne_to];
if ($next_room ne "") { # if there IS a room northwestwards
if (room_in_map($next_room) == -1) { # if room is not on the map
$x = get_room_x ($current_room)+1; # Position of the
$y = get_room_y ($current_room)-1; # new room
$z = get_room_z ($current_room);
if (room_at_place($x,$y,$z) ne "false") { # if new pos is taken
shift_x($x); # create place on the right
};
if ($y == -1) { # new room at back -> push
shift_y(0); # forward all other rooms
$y = 0; # x-pos of the new room
};
$index = @map;
$map[$index] = $next_room; # add the new room
$map[$index+1] = $x;
$map[$index+2] = $y;
$map[$index+3] = $z;
push (@room_stack, $next_room); # push the new room on stack
};
};
# if u_to and d_to don't have priority over the same room e.g. e_to or n_to:
if ($prefer_dir eq "hor") {float_up_down;};
$current_room = pop (@room_stack); # loop with the next room
};
# -------- end of floating one cave -------------
$current_room = next_room_left; # the next map
};
# ----- end of floating every cave
# --- compute the size of the derived map ---
# now definitive and constant
$maplen = int(@map/4);
# compute greatest x-pos
$max_x = 0;
for ($i=0;$i<$maplen;$i++) {
$x = @map[($i*4)+1]; # actual x pos
if ($x > $max_x) { # max x pos
$max_x=$x;
};
};
# compute greatest y-pos
$max_y = 0;
for ($i=0;$i<$maplen;$i++) {
$y = @map[($i*4)+2]; # actual x pos
if ($y > $max_y) { # max x pos
$max_y=$y;
};
};
# compute greatest z-pos
$max_z = 0;
for ($i=0;$i<$maplen;$i++) {
$z = @map[($i*4)+3]; # actual x pos
if ($z > $max_z) { # max x pos
$max_z=$z;
};
};
# -----------------------------------
# for debugging:
# print the logical map on screen
# (every room with its coordinates)
# to switch on comment out:
# - - - - - - - - - - - - - - - - - -
# &print_room_map;
# -----------------------------------
sub print_room_map {
my($i,$maplen);
$maplen = int(@map/4); # current length of the map
for ($i=0;$i<$maplen;$i++) {
print "@map[($i*4)+1], ";
print "@map[($i*4)+2], ";
print "@map[($i*4)+3]: ";
print "@map[($i*4)]\n";
};
print "\n\n";
}
# ---------------- End of Building of the Map itself
#################### SECTION 4: BUILD LOGICAL DIRECTIONS ########################
# -----------------------------------
# Building of the connections
# (graphical connections)
# - - - - - - - - - - - - - - - - - -
# This loops through the logical
# map and scans the attached
# directions for every room.
# It creates a new array
# for every direction, e.g.:
# @map_w_e dirtype, (see below)
# x1,y1,z1, (the room itself)
# x2,x2,z2 (the endpoint of the line)
# (7 elements)
#
#
# w_e --- XXXXXX
# _/ / | \
# _/ / | \
# sw_ne s_n |se_nw
# d_u
# -----------------------------------
# if the directions are unary
# (n->s but no way back)
# it's mentioned as follows:
# 0: binary direction
# 1: direction away from room FROM
# 2: direction to room TO
#
# The arrays:
# @map_s_n
# @map_w_e
# @map_sw_ne
# @map_se_nw
# @map_d_u
# -----------------------------------
# if the connections cannot
# be regurarly drawn, they
# come into the 4-element-array
# @map_name_n name,
# x,y,z (4 elements)
# There is an array for every
# direction, e.g
# @map_name_n
# @map_name_nw
# @map_name_w
# ...
# -----------------------------------
# number of elements in a directions map (constant)
$n_map_dir = 7; # N elements for MAP DIRections
# the direction codes (constants)
$bin = 0;
$from = 1;
$to = 2;
# next_DIRECTION (x,y,z)
# these routines (which the direction as suffix)
# grab the next room to each compass direction
# straightly forward
# 45DEG-directions (e.g. ne) are only
# taken if they match exact 45DEG
# updates the global variables
# $next_x
# $next_y
# $next_z
# with the coordinates of the room found
# u_to
sub room_next_u {
my($x,$y,$z) = @_;
my($i,$room,$out);
$out = ""; # initial value
for ($i=$z-1;$i>=0;$i--) {
$room = room_at_place($x,$y,$i);
if (($out eq "") and ($room ne "false")) { # if room not found yet
$out = $room; # store next room
$next_x = $x;
$next_y = $y;
$next_z = $i;
};
};
$out;
}
# d_to
sub room_next_d {
my($x,$y,$z) = @_;
my($i,$room,$out);
$out = "";
for ($i=$z+1;$i<=$max_z;$i++) {
$room = room_at_place($x,$y,$i);
if (($out eq "") and ($room ne "false")) {
$out = $room;
$next_x = $x;
$next_y = $y;
$next_z = $i;
};
};
$out;
}
# n_to
sub room_next_n {
my($x,$y,$z) = @_;
my($i,$room,$out);
$out = "";
for ($i=$y-1;$i>=0;$i--) {
$room = room_at_place($x,$i,$z);
if (($out eq "") and ($room ne "false")) {
$out = $room;
$next_x = $x;
$next_y = $i;
$next_z = $z;
};
};
$out;
}
# s_to
sub room_next_s {
my($x,$y,$z) = @_;
my($i,$room,$out);
$out = "";
for ($i=$y+1;$i<=$max_y;$i++) {
$room = room_at_place($x,$i,$z);
if (($out eq "") and ($room ne "false")) {
$out = $room;
$next_x = $x;
$next_y = $i;
$next_z = $z;
};
};
$out;
}
# w_to
sub room_next_w {
my($x,$y,$z) = @_;
my($i,$room,$out);
$out = "";
for ($i=$x-1;$i>=0;$i--) {
$room = room_at_place($i,$y,$z);
if (($out eq "") and ($room ne "false")) {
$out = $room;
$next_x = $i;
$next_y = $y;
$next_z = $z;
};
};
$out;
}
# e_to
sub room_next_e {
my($x,$y,$z) = @_;
my($i,$room,$out);
$out = "";
for ($i=$x+1;$i<=$max_x;$i++) {
$room = room_at_place($i,$y,$z);
if (($out eq "") and ($room ne "false")) {
$out = $room;
$next_x = $i;
$next_y = $y;
$next_z = $z;
};
};
$out;
}
# nw_to
# main counter for n
sub room_next_nw {
my($x,$y,$z) = @_;
my($i,$j,$d,$room,$out);
$out = "";
$j=0; # counter for w
for ($i=$y-1;$i>=0;$i--) {
$j--;
$room = room_at_place($x+$j,$i,$z);
if (($out eq "") and ($room ne "false") and (($x+$j)>=0)) {
$out = $room;
$next_x = $x+$j;
$next_y = $i;
$next_z = $z;
};
};
$out;
}
# se_to
# main counter for s
sub room_next_se {
my($x,$y,$z) = @_;
my($i,$j,$d,$room,$out);
$out = "";
$j=0; # counter for e
for ($i=$y+1;$i<=$max_y;$i++) {
$j++;
$room = room_at_place($x+$j,$i,$z);
if (($out eq "") and ($room ne "false")) {
$out = $room;
$next_x = $x+$j;
$next_y = $i;
$next_z = $z;
};
};
$out;
}
# ne_to
# main counter for n
sub room_next_ne {
my($x,$y,$z) = @_;
my($i,$j,$d,$room,$out);
$out = "";
$j=0; # counter for e
for ($i=$y-1;$i>=0;$i--) {
$j++;
$room = room_at_place($x+$j,$i,$z);
if (($out eq "") and ($room ne "false")) {
$out = $room;
$next_x = $x+$j;
$next_y = $i;
$next_z = $z;
};
};
$out;
}
# sw_to
# main counter for s
sub room_next_sw {
my($x,$y,$z) = @_;
my($i,$j,$d,$room,$out);
$out = "";
$j=0; # counter for w
for ($i=$y+1;$i<=$max_y;$i++) {
$j--;
$room = room_at_place($x+$j,$i,$z);
if (($out eq "") and ($room ne "false") and (($x+$j)>=0)) {
$out = $room;
$next_x = $x+$j;
$next_y = $i;
$next_z = $z;
};
};
$out;
}
# --- end of next_DIRECTION ---
# --- get_map_DIR(x,y,z) ---
# e.g.: number = get_map_s_n(x,y,z)
# returns -1 if there is no connection at that pos,
# else the index of the found connection
# for down_up-direction
sub get_map_d_u {
my($x,$y,$z) = @_;
my($i,$stop,$out);
$out = -1; # init out
$stop = int(@map_d_u/$n_map_dir); # length of the map
for ($i=0;$i<$stop;$i++) { # loop through all dirs in the map
if ((@map_d_u[($i*$n_map_dir)+1] == $x) and # succeeds if there is a direction
(@map_d_u[($i*$n_map_dir)+2] == $y) and # at that place
(@map_d_u[($i*$n_map_dir)+3] == $z)) {
$out = $i*$n_map_dir; # the index (only one possible)
};
};
$out;
}
# for south_north-direction
sub get_map_s_n {
my($x,$y,$z) = @_;
my($i,$stop,$out);
$out = -1; # init out
$stop = int(@map_s_n/$n_map_dir); # length of the map
for ($i=0;$i<$stop;$i++) { # loop through all dirs in the map
if ((@map_s_n[($i*$n_map_dir)+1] == $x) and # succeeds if there is a direction
(@map_s_n[($i*$n_map_dir)+2] == $y) and # at that place
(@map_s_n[($i*$n_map_dir)+3] == $z)) {
$out = $i*$n_map_dir; # the index (only one possible)
};
};
$out;
}
# for west_east-direction
sub get_map_w_e {
my($x,$y,$z) = @_;
my($i,$stop,$out);
$out = -1; # init out
$stop = int(@map_w_e/$n_map_dir); # length of the map
for ($i=0;$i<$stop;$i++) { # loop through all dirs in the map
if ((@map_w_e[($i*$n_map_dir)+1] == $x) and # succeeds if there is a direction
(@map_w_e[($i*$n_map_dir)+2] == $y) and # at that place
(@map_w_e[($i*$n_map_dir)+3] == $z)) {
$out = $i*$n_map_dir; # the index (only one possible)
};
};
$out;
}
# for southwest_northeast-direction
sub get_map_sw_ne {
my($x,$y,$z) = @_;
my($i,$stop,$out);
$out = -1; # init out
$stop = int(@map_sw_ne/$n_map_dir); # length of the map
for ($i=0;$i<$stop;$i++) { # loop through all dirs in the map
if ((@map_sw_ne[($i*$n_map_dir)+1] == $x) and # succeeds if there is a direction
(@map_sw_ne[($i*$n_map_dir)+2] == $y) and # at that place
(@map_sw_ne[($i*$n_map_dir)+3] == $z)) {
$out = $i*$n_map_dir; # the index (only one possible)
};
};
$out;
}
# for southeast_northwest-direction
sub get_map_se_nw {
my($x,$y,$z) = @_;
my($i,$stop,$out);
$out = -1; # init out
$stop = int(@map_se_nw/$n_map_dir); # length of the map
for ($i=0;$i<$stop;$i++) { # loop through all dirs in the map
if ((@map_se_nw[($i*$n_map_dir)+1] == $x) and # succeeds if there is a direction
(@map_se_nw[($i*$n_map_dir)+2] == $y) and # at that place
(@map_se_nw[($i*$n_map_dir)+3] == $z)) {
$out = $i*$n_map_dir; # the index (only one possible)
};
};
$out;
}
# --- build up connections main routine ---
$maplen = int(@map/4);
for ($i=0;$i<$maplen;$i++) { # loop trough the rooms in the map
$name = @map[($i*4)]; # get name & coordinates of this room
$x = @map[($i*4)+1];
$y = @map[($i*4)+2];
$z = @map[($i*4)+3];
$index = get_room_index($name); # $index is not defined if room not declared,
if (defined($index)) { # but mentioned in a direction
# -> lines only possible TO
# ---- d_u (down-up)-pair ----
# u_to
# line is attached to the room upwards of room!
$next_room = $room[$index+$u_to]; # --- room upwards of $name ---
if ($next_room ne "") { # if there is a room upwards
if (room_next_u($x,$y,$z) eq $next_room) { # and on drawable place up
$ix = @map_d_u; # index to new entry for direction
$inext = get_map_d_u($next_x,$next_y,$next_z); # globals by room_next_...
# index for the next room in dirs
if ($inext == -1) { # if no connection already declared
$map_d_u[$ix] = $to; # direction TO (seen from upwards)
$map_d_u[$ix+1] = $next_x; # create new entry
$map_d_u[$ix+2] = $next_y; # dir attached to the UP room !!
$map_d_u[$ix+3] = $next_z;
$map_d_u[$ix+4] = $x; # endpoint of line
$map_d_u[$ix+5] = $y;
$map_d_u[$ix+6] = $z;
} else { # else it is already declared
$map_d_u[$inext] = $bin; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$d_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_u; # index to new entry for
$map_name_u[$ix] = $next_room_out; # room to be printed
$map_name_u[$ix+1] = $x; # on THIS room !!
$map_name_u[$ix+2] = $y;
$map_name_u[$ix+3] = $z;
};
};
# d_to
# line is attached to the room itself!
$next_room = $room[$index+$d_to]; # --- room downwards of $name ---
if ($next_room ne "") { # if there is a room downwards
if (room_next_d($x,$y,$z) eq $next_room) { # and on drawable place down
$ix = @map_d_u; # index to new entry for direction
$iatt = get_map_d_u($x,$y,$z); # $i for the attach-room (= this room)
if ($iatt == -1) { # if no connection already declared
$map_d_u[$ix] = $from; # direction FROM (seen from here)
$map_d_u[$ix+1] = $x; # create new entry
$map_d_u[$ix+2] = $y; # dir attached to here !!
$map_d_u[$ix+3] = $z;
$map_d_u[$ix+4] = $next_x; # endpoint of line to down
$map_d_u[$ix+5] = $next_y;
$map_d_u[$ix+6] = $next_z;
} else { # else it is already declared
$map_d_u[$iatt] = 0; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$u_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_d; # index to new south(!)-entry for
$map_name_d[$ix] = $next_room_out; # room to be printed
$map_name_d[$ix+1] = $x; # on THIS room !!
$map_name_d[$ix+2] = $y;
$map_name_d[$ix+3] = $z;
};
};
# ---- s_n (south-north)-pair ----
# n_to
# line is attached to the room nordwards of room!
$next_room = $room[$index+$n_to]; # --- room northwards of $name ---
if ($next_room ne "") { # if there is a room northwards
if (room_next_n($x,$y,$z) eq $next_room) { # and on drawable place north
$ix = @map_s_n; # index to new entry for direction
$inext = get_map_s_n($next_x,$next_y,$next_z); # globals by room_next_...
# index for the next room in dirs
if ($inext == -1) { # if no connection already declared
$map_s_n[$ix] = $to; # direction TO (seen from nordwards)
$map_s_n[$ix+1] = $next_x; # create new entry
$map_s_n[$ix+2] = $next_y; # dir attached to the NORTH room !!
$map_s_n[$ix+3] = $next_z;
$map_s_n[$ix+4] = $x; # endpoint of line
$map_s_n[$ix+5] = $y;
$map_s_n[$ix+6] = $z;
} else { # else it is already declared
$map_s_n[$inext] = $bin; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$s_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_n; # index to new entry for
$map_name_n[$ix] = $next_room_out; # room to be printed
$map_name_n[$ix+1] = $x; # on THIS room !!
$map_name_n[$ix+2] = $y;
$map_name_n[$ix+3] = $z;
};
};
# s_to
# line is attached to the room itself!
$next_room = $room[$index+$s_to]; # --- room southwards of $name ---
if ($next_room ne "") { # if there is a room southwards
if (room_next_s($x,$y,$z) eq $next_room) { # and on drawable place south
$ix = @map_s_n; # index to new entry for direction
$iatt = get_map_s_n($x,$y,$z); # $i for the attach-room (= this room)
if ($iatt == -1) { # if no connection already declared
$map_s_n[$ix] = $from; # direction FROM (seen from here)
$map_s_n[$ix+1] = $x; # create new entry
$map_s_n[$ix+2] = $y; # dir attached to here !!
$map_s_n[$ix+3] = $z;
$map_s_n[$ix+4] = $next_x; # endpoint of line to the south
$map_s_n[$ix+5] = $next_y;
$map_s_n[$ix+6] = $next_z;
} else { # else it is already declared
$map_s_n[$iatt] = 0; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$n_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_s; # index to new south(!)-entry for
$map_name_s[$ix] = $next_room_out; # room to be printed
$map_name_s[$ix+1] = $x; # on THIS room !!
$map_name_s[$ix+2] = $y;
$map_name_s[$ix+3] = $z;
};
};
# ---- w_e (west-east)-pair ----
# e_to
# line is attached to the room eastwards of room!
$next_room = $room[$index+$e_to]; # --- room eastwards of $name ---
if ($next_room ne "") { # if there is a room eastwards
if (room_next_e($x,$y,$z) eq $next_room) { # and on drawable place east
$ix = @map_w_e; # index to new entry for direction
$inext = get_map_w_e($next_x,$next_y,$next_z); # globals by room_next_...
# index for the next room in dirs
if ($inext == -1) { # if no connection already declared
$map_w_e[$ix] = $to; # direction TO (seen from eastwards)
$map_w_e[$ix+1] = $next_x; # create new entry
$map_w_e[$ix+2] = $next_y; # dir attached to the EAST room !!
$map_w_e[$ix+3] = $next_z;
$map_w_e[$ix+4] = $x; # endpoint of line
$map_w_e[$ix+5] = $y;
$map_w_e[$ix+6] = $z;
} else { # else it is already declared
$map_w_e[$inext] = $bin; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$w_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_e; # index to new entry for
$map_name_e[$ix] = $next_room_out; # room to be printed
$map_name_e[$ix+1] = $x; # on THIS room !!
$map_name_e[$ix+2] = $y;
$map_name_e[$ix+3] = $z;
};
};
# w_to
# line is attached to the room itself!
$next_room = $room[$index+$w_to]; # --- room westwards of $name ---
if ($next_room ne "") { # if there is a room westwards
if (room_next_w($x,$y,$z) eq $next_room) { # and on drawable place west
$ix = @map_w_e; # index to new entry for direction
$iatt = get_map_w_e($x,$y,$z); # $i for the attach-room (= this room)
if ($iatt == -1) { # if no connection already declared
$map_w_e[$ix] = $from; # direction FROM (seen from here)
$map_w_e[$ix+1] = $x; # create new entry
$map_w_e[$ix+2] = $y; # dir attached to here !!
$map_w_e[$ix+3] = $z;
$map_w_e[$ix+4] = $next_x; # endpoint of line to the west
$map_w_e[$ix+5] = $next_y;
$map_w_e[$ix+6] = $next_z;
} else { # else it is already declared
$map_w_e[$iatt] = 0; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$e_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_w; # index to new south(!)-entry for
$map_name_w[$ix] = $next_room_out; # room to be printed
$map_name_w[$ix+1] = $x; # on THIS room !!
$map_name_w[$ix+2] = $y;
$map_name_w[$ix+3] = $z;
};
};
# ---- sw_ne (southwest-northeast)-pair ----
# ne_to
# line is attached to the room northeastwards of room!
$next_room = $room[$index+$ne_to]; # --- room northeastwards of $name ---
if ($next_room ne "") { # if there is a room northeastwards
if (room_next_ne($x,$y,$z) eq $next_room) { # and on drawable place northeast
$ix = @map_sw_ne; # index to new entry for direction
$inext = get_map_sw_ne($next_x,$next_y,$next_z); # globals by room_next_...
# index for the next room in dirs
if ($inext == -1) { # if no connection already declared
$map_sw_ne[$ix] = $to; # direction TO (seen from ne-wards)
$map_sw_ne[$ix+1] = $next_x; # create new entry
$map_sw_ne[$ix+2] = $next_y; # dir attached to the NORTHEAST room !!
$map_sw_ne[$ix+3] = $next_z;
$map_sw_ne[$ix+4] = $x; # endpoint of line
$map_sw_ne[$ix+5] = $y;
$map_sw_ne[$ix+6] = $z;
} else { # else it is already declared
$map_sw_ne[$inext] = $bin; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$sw_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_ne; # index to new entry for
$map_name_ne[$ix] = $next_room_out; # room to be printed
$map_name_ne[$ix+1] = $x; # on THIS room !!
$map_name_ne[$ix+2] = $y;
$map_name_ne[$ix+3] = $z;
};
};
# sw_to
# line is attached to the room itself!
$next_room = $room[$index+$sw_to]; # --- room southwestwards of $name ---
if ($next_room ne "") { # if there is a room southwestwards
if (room_next_sw($x,$y,$z) eq $next_room) { # and on drawable place southwest
$ix = @map_sw_ne; # index to new entry for direction
$iatt = get_map_sw_ne($x,$y,$z); # $i for the attach-room (= this room)
if ($iatt == -1) { # if no connection already declared
$map_sw_ne[$ix] = $from; # direction FROM (seen from here)
$map_sw_ne[$ix+1] = $x; # create new entry
$map_sw_ne[$ix+2] = $y; # dir attached to here !!
$map_sw_ne[$ix+3] = $z;
$map_sw_ne[$ix+4] = $next_x; # endpoint of line to the southwest
$map_sw_ne[$ix+5] = $next_y;
$map_sw_ne[$ix+6] = $next_z;
} else { # else it is already declared
$map_sw_ne[$iatt] = 0; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$ne_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_sw; # index to new south(!)-entry for
$map_name_sw[$ix] = $next_room_out; # room to be printed
$map_name_sw[$ix+1] = $x; # on THIS room !!
$map_name_sw[$ix+2] = $y;
$map_name_sw[$ix+3] = $z;
};
};
# ---- se_nw (southwest-northeast)-pair ----
# nw_to
# line is attached to the room northwestwards of room!
$next_room = $room[$index+$nw_to]; # --- room northwestwards of $name ---
if ($next_room ne "") { # if there is a room northwestwards
if (room_next_nw($x,$y,$z) eq $next_room) { # and on drawable place northwest
$ix = @map_se_nw; # index to new entry for direction
$inext = get_map_se_nw($next_x,$next_y,$next_z); # globals by room_next_...
# index for the next room in dirs
if ($inext == -1) { # if no connection already declared
$map_se_nw[$ix] = $to; # direction TO (seen from ne-wards)
$map_se_nw[$ix+1] = $next_x; # create new entry
$map_se_nw[$ix+2] = $next_y; # dir attached to the NORTHWEST room !!
$map_se_nw[$ix+3] = $next_z;
$map_se_nw[$ix+4] = $x; # endpoint of line
$map_se_nw[$ix+5] = $y;
$map_se_nw[$ix+6] = $z;
} else { # else it is already declared
$map_se_nw[$inext] = $bin; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$se_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_nw; # index to new entry for
$map_name_nw[$ix] = $next_room_out; # room to be printed
$map_name_nw[$ix+1] = $x; # on THIS room !!
$map_name_nw[$ix+2] = $y;
$map_name_nw[$ix+3] = $z;
};
};
# se_to
# line is attached to the room itself!
$next_room = $room[$index+$se_to]; # --- room southeastwards of $name ---
if ($next_room ne "") { # if there is a room southeastwards
if (room_next_se($x,$y,$z) eq $next_room) { # and on drawable place southeast
$ix = @map_se_nw; # index to new entry for direction
$iatt = get_map_se_nw($x,$y,$z); # $i for the attach-room (= this room)
if ($iatt == -1) { # if no connection already declared
$map_se_nw[$ix] = $from; # direction FROM (seen from here)
$map_se_nw[$ix+1] = $x; # create new entry
$map_se_nw[$ix+2] = $y; # dir attached to here !!
$map_se_nw[$ix+3] = $z;
$map_se_nw[$ix+4] = $next_x; # endpoint of line to the southeast
$map_se_nw[$ix+5] = $next_y;
$map_se_nw[$ix+6] = $next_z;
} else { # else it is already declared
$map_se_nw[$iatt] = 0; # change it to BINARY direction
};
} else { # road to next room is not drawable
$jx = get_room_index($next_room);
if (defined($jx) and # if next_room declared
($room[$jx+$nw_to] eq $name)) { # and points to this room
$next_room_out = $next_room; # it is bidirectional
} else {
$next_room_out = ">$next_room"; # mark single directions
};
$ix = @map_name_se; # index to new south(!)-entry for
$map_name_se[$ix] = $next_room_out; # room to be printed
$map_name_se[$ix+1] = $x; # on THIS room !!
$map_name_se[$ix+2] = $y;
$map_name_se[$ix+3] = $z;
};
};
};
};
# -----------------------------------
# for debugging:
# print the logical map directions
# to switch on comment out:
# - - - - - - - - - - - - - - - - - -
# &print_room_dirs;
# -----------------------------------
sub print_room_dirs {
my($i,$dirlen,$name);
# d_u-pair
$dirlen = int(@map_d_u/$n_map_dir); # down-up-directions
print "#down-up (down of):\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_d_u[($i*$n_map_dir)+1],
@map_d_u[($i*$n_map_dir)+2],
@map_d_u[($i*$n_map_dir)+3]);
$nname = room_at_place(@map_d_u[($i*$n_map_dir)+4],
@map_d_u[($i*$n_map_dir)+5],
@map_d_u[($i*$n_map_dir)+6]);
print "$name to $nname: @map_d_u[($i*$n_map_dir)]\n";
};
$dirlen = int(@map_name_d/4); # names in the west
print "#names down from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_d[($i*4)+1],
@map_name_d[($i*4)+2],
@map_name_d[($i*4)+3]);
print "$name: @map_name_d[($i*4)]\n";
};
$dirlen = int(@map_name_u/4); # names in the east
print "#names up from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_u[($i*4)+1],
@map_name_u[($i*4)+2],
@map_name_u[($i*4)+3]);
print "$name: @map_name_u[($i*4)]\n";
};
print "\n";
# s_n-pair
$dirlen = int(@map_s_n/$n_map_dir); # south-north-directions
print "#south-north (south of):\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_s_n[($i*$n_map_dir)+1],
@map_s_n[($i*$n_map_dir)+2],
@map_s_n[($i*$n_map_dir)+3]);
$nname = room_at_place(@map_s_n[($i*$n_map_dir)+4],
@map_s_n[($i*$n_map_dir)+5],
@map_s_n[($i*$n_map_dir)+6]);
print "$name to $nname: @map_s_n[($i*$n_map_dir)]\n";
};
$dirlen = int(@map_name_s/4); # names in the south
print "#names south from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_s[($i*4)+1],
@map_name_s[($i*4)+2],
@map_name_s[($i*4)+3]);
print "$name: @map_name_s[($i*4)]\n";
};
$dirlen = int(@map_name_n/4); # names in the north
print "#names north from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_n[($i*4)+1],
@map_name_n[($i*4)+2],
@map_name_n[($i*4)+3]);
print "$name: @map_name_n[($i*4)]\n";
};
print "\n";
# w_e-pair
$dirlen = int(@map_w_e/$n_map_dir); # west-east-directions
print "#west-east (west of):\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_w_e[($i*$n_map_dir)+1],
@map_w_e[($i*$n_map_dir)+2],
@map_w_e[($i*$n_map_dir)+3]);
$nname = room_at_place(@map_w_e[($i*$n_map_dir)+4],
@map_w_e[($i*$n_map_dir)+5],
@map_w_e[($i*$n_map_dir)+6]);
print "$name to $nname: @map_w_e[($i*$n_map_dir)]\n";
};
$dirlen = int(@map_name_w/4); # names in the west
print "#names west from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_w[($i*4)+1],
@map_name_w[($i*4)+2],
@map_name_w[($i*4)+3]);
print "$name: @map_name_w[($i*4)]\n";
};
$dirlen = int(@map_name_e/4); # names in the east
print "#names east from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_e[($i*4)+1],
@map_name_e[($i*4)+2],
@map_name_e[($i*4)+3]);
print "$name: @map_name_e[($i*4)]\n";
};
print "\n";
# sw_ne-pair
$dirlen = int(@map_sw_ne/$n_map_dir); # southwest-northeast-directions
print "#southwest-northeast (southwest of):\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_sw_ne[($i*$n_map_dir)+1],
@map_sw_ne[($i*$n_map_dir)+2],
@map_sw_ne[($i*$n_map_dir)+3]);
$nname = room_at_place(@map_sw_ne[($i*$n_map_dir)+4],
@map_sw_ne[($i*$n_map_dir)+5],
@map_sw_ne[($i*$n_map_dir)+6]);
print "$name to $nname: @map_sw_ne[($i*$n_map_dir)]\n";
};
$dirlen = int(@map_name_sw/4); # names in the southwest
print "#names southwest from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_sw[($i*4)+1],
@map_name_sw[($i*4)+2],
@map_name_sw[($i*4)+3]);
print "$name: @map_name_sw[($i*4)]\n";
};
$dirlen = int(@map_name_ne/4); # names in the northeast
print "#names northeast from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_ne[($i*4)+1],
@map_name_ne[($i*4)+2],
@map_name_ne[($i*4)+3]);
print "$name: @map_name_ne[($i*4)]\n";
};
print "\n";
# se_nw-pair
$dirlen = int(@map_se_nw/$n_map_dir); # southeast-northwest-directions
print "#southeast-northwest (southwest of):\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_se_nw[($i*$n_map_dir)+1],
@map_se_nw[($i*$n_map_dir)+2],
@map_se_nw[($i*$n_map_dir)+3]);
$nname = room_at_place(@map_se_nw[($i*$n_map_dir)+4],
@map_se_nw[($i*$n_map_dir)+5],
@map_se_nw[($i*$n_map_dir)+6]);
print "$name to $nname: @map_se_nw[($i*$n_map_dir)]\n";
};
$dirlen = int(@map_name_se/4); # names in the southeast
print "#names southeast from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_se[($i*4)+1],
@map_name_se[($i*4)+2],
@map_name_se[($i*4)+3]);
print "$name: @map_name_se[($i*4)]\n";
};
$dirlen = int(@map_name_nw/4); # names in the northeast
print "#names nortwest from-to:\n";
for ($i=0;$i<$dirlen;$i++) {
$name = room_at_place(@map_name_nw[($i*4)+1],
@map_name_nw[($i*4)+2],
@map_name_nw[($i*4)+3]);
print "$name: @map_name_nw[($i*4)]\n";
};
print "\n";
}
# ----------------- End of building the connections
# STATUS
print "Created logical map\n";
####################### SECTION 5: BUILD GRAPHICAL MAP ########################
######################################
# first compute the x-size of the map
# (y-size not easily computable)
# $drawing_size_x
# $room_width comes from the command line
# this variables serve as constants
# they are not strictly independent of each other
# (e.g. room_space_x and room_space_y)
# -> leave them as they are to avoid (really) ugly maps
# (count starts from 1)
$room_size_x = $room_width + 4 + 2; # width of a room (with 2 lines)
$room_size_y = 2 + 2; # height of a room (with 2 lines)
$room_space_x = 7+2; # horizontal space between rooms
$room_space_y = 1 + 3; # vertical space >=4 between rooms
$room_grid_x = $room_size_x + $room_space_x;
$room_grid_y = $room_size_y + $room_space_y;
$draw_offset_init = 3; # init for $draw_offset up->down (on map drawing)
$draw_offset_z = 6; # space between two "floors"
# $maplen = (@map/4); # from here on static !! (moved upwards)
# computable after max_, max_y:
$drawing_offset_xy = (($max_y+1)*$room_size_y) + # x-offset on y-change
($max_y*$room_space_y); # for all rooms
# this is the maximal 2D-width
$drawing_size_x = (($max_x+1)*$room_size_x) + # number on one x * real width
($max_x*$room_space_x) + # spaces = number - 1
$drawing_offset_xy;
##############################################
# draw map into array @drawing
# -------------------------------------------
# Begin in the upper right corner and
# draw from right->left up->down
##############################################
# put_char(char,x,y)
# put a char on a certain position
# in the 2D-array @drawing
# Attention: x and y have their
# normal 2d-meaning
$lowest_point = 0; # reset "lowest point" of the graphic (max y)
$leftmost_point = $drawing_size_x; # for avoiding space on the left
$rightmost_point = 0; # for avoiding space on the right
sub put_char {
my($char,$x_2d,$y_2d) = @_;
if ( ($x_2d>=0) and ($x_2d<$drawing_size_x) and ($y_2d>=0) ) {
@drawing [ $y_2d*$drawing_size_x + $x_2d ] = $char;
if ($y_2d > $lowest_point) {
$lowest_point = $y_2d;
};
if ($x_2d < $leftmost_point) {
$leftmost_point = $x_2d;
};
if ($x_2d > $rightmost_point) {
$rightmost_point = $x_2d;
};
} else {
print"### failed to put char '$char' on $x_2d,$y_2d\n";
};
}
# draw_char(char,x,y)
# 3D-put-char-projection
# simulates 3d-printing
# on one floor
# (with down-offset
# $draw_offset)
# x,y are char coordinates,
# not logical coordinates!
# ----> x-coord
# /|
# / |
# L v
# y-coord z-coord wiht $draw_offset
sub draw_char {
my($char,$x,$y) = @_;
my($xm,$ym);
$xm = $x - $y + $drawing_offset_xy;
$ym = $y + $draw_offset;
put_char($char,$xm,$ym);
}
# draw_room(name,x,y)
# draws a room at the
# logical position x,y
# (on one floor)
sub draw_room {
my($name,$x_in,$y_in) = @_;
my($stop,$xp,$x,$yp,$y,$i,$len); # $xp and $yp are 2D-coordinates!
# draw the two horizontal lines
$xp = $room_grid_x * $x_in;
$stop = $xp + $room_size_x-1; # here: start from 0
$yp = $room_grid_y * $y_in;
for ($x=$xp;$x<$stop;$x++) {
draw_char("_",$x,$yp);
draw_char("_",$x,$yp+$room_size_y-1); # -1: starting from 0
};
# draw the two vertical lines
$x = $xp;
$y = $yp; # under the upper left corner
for ($i=1;$i<$room_size_y;$i++) { # -> $i=1
draw_char("/",$x,$y+$i);
draw_char("/",($x+$room_size_x-1),$y+$i);
};
# draw the name of the room
$len = length($name); # for centering the name
if ($len > $room_width) {
$len = $room_width;
};
$i = int( ($room_width-$len) / 2) ; # leading spaces before name
$x = $xp + 3 + $i; # beginning of the string
$y = $yp + 2;
for ($i=0;$i<$len;$i++) {
draw_char (substr($name,$i,1),$x+$i,$y); # draw char by char
};
}
# number = empty_rows_y (floor)
# to compress output graphics compute number of rows
# that are blank (from y=0 to ...)
# -> gives a negative drawing offset for each floor
sub empty_rows_y {
my($floor) = @_;
my($return,$pfloor,$y,$z,$local_y);
$return = 0; # init return
if ($floor > 0) { # if it's not the first floor (z=0)
$pfloor = $floor - 1; # compute previous floor:
$local_y = 0; # find "most at front" - y
for ($i=0;$i<$maplen;$i++) {
$y = @map[($i*4)+2];
$z = @map[($i*4)+3];
if (($z == $pfloor) and ($y > $local_y)) {
$local_y = $y;
};
};
$return = $max_y - $local_y; # -> number of empty rows in front
};
$local_y = $max_y; # compute the "most at back" - y
for ($i=0;$i<$maplen;$i++) { # on the floor
$y = @map[($i*4)+2];
$z = @map[($i*4)+3];
if (($z == $floor) and ($y < $local_y)) {
$local_y = $y;
};
};
$return = ($return + $local_y) * $room_grid_y;
$return;
}
# ------- The subroutines for the connections ----------
# ----------------------------------------------
# draw the lines (''=bn ---, _to > >, _from < <
sub draw_line_w_e { # the coordinates are (east point,_,west point)
my ($x1,$y1,$x2,$style) = @_; # -> $x1 > $x2
my ($ystop,$ystart,$xp);
$xstart = ($room_grid_x * $x2) + $room_size_x + 1;
$xstop = ($room_grid_x * $x1) - 2;
$yp = ($room_grid_y * $y1) + 2;
if ($style == $bin) { # line like -----
for ($xp=$xstart;$xp<=$xstop;$xp++) {
draw_char("-",$xp,$yp);
};
} else { # line like > > or < <
for ($xp=$xstart;$xp<=$xstop;$xp=$xp+2) {
if ($style == $to) {
draw_char(">",$xp,$yp);
} else {
draw_char("<",$xp,$yp);
};
};
};
}
sub draw_line_s_n { # the coordinates are (north point,_,south point)
my ($x1,$y1,$y2,$style) = @_; # -> $y1 < $2
my( $ystop,$ystart,$xp);
$ystart = ($room_grid_y * $y1) + $room_size_y + 1;
$ystop = ($room_grid_y * $y2) - 1;
$xp = ($room_grid_x * $x1) + int ($room_size_x/2);
if ($style == $bin) { # line like |
for ($yp=$ystart;$yp<=$ystop;$yp++) { # |
draw_char("/",$xp,$yp);
};
} else { # line like ^ or v
for ($yp=$ystart;$yp<=$ystop;$yp++) {
if ($style == $to) {
draw_char("^",$xp,$yp);
} else {
draw_char("v",$xp,$yp);
};
};
};
}
sub draw_line_sw_ne { # the coordinates are (northeast - southwest)
my ($x1,$y1,$x2,$y2,$style) = @_;
my ($ystart,$ystop,$xp);
$xp = ($room_grid_x * $x1);
$ystart = ($room_grid_y * $y1) + $room_size_y;
$ystop = ($room_grid_y * $y2) - 1;
if ($style == $bin) { # line like ___
for ($yp=$ystart;$yp<=$ystop;$yp++) { # ___/
draw_char("_",$xp,$yp);
draw_char("_",$xp-1,$yp);
draw_char("_",$xp-2,$yp);
if ($yp != $ystop) { # suppress last / downwards
draw_char("/",$xp-2,$yp+1);
};
$xp = $xp - 3; # for the perspective
};
} else { # line like > or <
$xp--; # looks better
for ($yp=$ystart;$yp<=$ystop;$yp++) {
if ($style == $to) {
draw_char(">",$xp,$yp);
} else {
draw_char("<",$xp,$yp);
};
$xp = $xp - 3;
};
};
}
sub draw_line_se_nw { # the coordinates are (northwest - southeast)
my ($x1,$y1,$x2,$y2,$style) = @_;
my ($ystart,$ystop,$xp);
$xp = ($room_grid_x * $x1) + $room_size_x + 2; # looks best
$ystart = ($room_grid_y * $y1) + $room_size_y + 1;
$ystop = ($room_grid_y * $y2) - 1;
if ($style == $bin) { # line like \
for ($yp=$ystart;$yp<=$ystop;$yp++) { # \
draw_char("\\",$xp,$yp); # ! Perl ! is the single char \
$xp = $xp + 2; # watch perspective
};
} else { # line like > or <
for ($yp=$ystart;$yp<=$ystop;$yp++) {
if ($style == $to) {
draw_char("^",$xp,$yp);
} else {
draw_char("v",$xp,$yp);
};
$xp = $xp + 2;
};
};
}
# -------------------------------
# draw_room_name(Room,x,y)
# draw (=prints) a room name
# centered on a 2D-position
# on a defined floor
# uses $room_width!
# ">room"-rooms are recognized
# as single direction rooms
sub draw_room_name {
my($room,$xp,$yp) = @_;
my ($deliminiter,$len,$i,$x,$y);
$len = length($room);
if (substr($room,0,1) eq ">") { # if single direction
$room = substr($room,1,$len-1); # delete the ">"
$deliminiter = ">";
} else {
$deliminiter = "-";
};
$len = length($room); # again, for centering the name
if ($len > ($room_width-2)) { # -2 for the /deliminiters/
$len = $room_width-2;
};
$x = $xp - int($len/2) - 1; # alignment on the left
$y = $yp;
draw_char ($deliminiter,$x,$y); # left room deliminiter
draw_char ($deliminiter,$x+$len+1,$y); # right deliminiter
for ($i=0;$i<$len;$i++) {
draw_char (substr($room,$i,1),$x+$i+1,$y); # draw char by char
};
}
# -----------------------------------
# draw_map_name_[dir] (name,x,y)
# draw names for not drawable lines
# for each (really each) direction
# x and y are logical coordinates!
sub draw_map_name_w {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in);
$y = ($room_grid_y * $y_in) + 2;
draw_room_name($name,$x,$y);
}
sub draw_map_name_e {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in) + $room_size_x;
$y = ($room_grid_y * $y_in) + 2;
draw_room_name($name,$x,$y);
}
sub draw_map_name_nw {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in);
$y = ($room_grid_y * $y_in) + 1;
draw_room_name($name,$x,$y);
}
sub draw_map_name_ne {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in) + $room_size_x;
$y = ($room_grid_y * $y_in) + 1;
draw_room_name($name,$x,$y);
}
sub draw_map_name_sw {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in);
$y = ($room_grid_y * $y_in) + 3;
draw_room_name($name,$x,$y);
}
sub draw_map_name_se {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in) + $room_size_x;
$y = ($room_grid_y * $y_in) + 3;
draw_room_name($name,$x,$y);
}
sub draw_map_name_n {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in) + int($room_size_x/2);
$y = ($room_grid_y * $y_in) + 1;
draw_room_name($name,$x,$y);
}
sub draw_map_name_s {
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in) + int($room_size_x/2);
$y = ($room_grid_y * $y_in) + 3;
draw_room_name($name,$x,$y);
}
sub draw_map_name_u { # up is different
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in) + int($room_size_x/2) - 3;
$y = ($room_grid_y * $y_in) - 1;
draw_char("|",$x,$y);
draw_room_name($name,$x-1,$y-1);
}
sub draw_map_name_d { # down is different
my($name,$x_in,$y_in) = @_;
my($x,$y);
$x = ($room_grid_x * $x_in) + int($room_size_x/2) + 2;
$y = ($room_grid_y * $y_in) + 4;
draw_char("|",$x,$y);
draw_room_name($name,$x+1,$y+1);
}
# ------- end of subroutines for the connections -------
# ======= draw the map, each floor separately =======
# sets up the array
# @draw_offset_on_floor[$z]
# which holds the draw offset for each floor
# for further additions to the drawing
$draw_offset = $draw_offset_init;
for ($z=0;$z<=$max_z;$z++) { # for each floor
# draw floor $z
$draw_offset = $draw_offset - empty_rows_y($z); # adjust draw offset
$draw_offset_on_floor[$z] = $draw_offset; # store it in array
for ($i=0;$i<$maplen;$i++) { # loop trough every room on the map
if (@map[($i*4)+3] == $z) { # select if room is on the right floor
$name = @map[$i*4];
$x = @map[($i*4)+1];
$y = @map[($i*4)+2];
draw_room ($name,$x,$y);
};
};
$draw_offset = $draw_offset + # for next floor
$drawing_offset_xy +
$draw_offset_z;
};
# ---------- end of drawing the room map --------------
# ======= draw the connections, each floor separately =======
for ($z=0;$z<=$max_z;$z++) { # for each floor
# --- draw connections on floor $z ---
$draw_offset = $draw_offset_on_floor[$z]; # adjust draw offset
# w_e-pairs
$dirlen = int(@map_w_e/$n_map_dir); # west-east-directions
for ($i=0;$i<$dirlen;$i++) {
if (@map_w_e[($i*$n_map_dir)+3] == $z) { # only if on the right floor
$x1 = @map_w_e[($i*$n_map_dir)+1]; # starting of the line
$y1 = @map_w_e[($i*$n_map_dir)+2];
$x2 = @map_w_e[($i*$n_map_dir)+4]; # ($y2 == $y1)
$style = @map_w_e[($i*$n_map_dir)];
draw_line_w_e($x1,$y1,$x2,$style);
};
};
$dirlen = int(@map_name_w/4); # names in the west
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_w[($i*4)+3] == $z) { # only if on the right floor
$x = @map_name_w[($i*4)+1];
$y = @map_name_w[($i*4)+2];
$name = @map_name_w[($i*4)];
draw_map_name_w($name,$x,$y);
};
};
$dirlen = int(@map_name_e/4); # names in the east
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_e[($i*4)+3] == $z) {
$x = @map_name_e[($i*4)+1];
$y = @map_name_e[($i*4)+2];
$name = @map_name_e[($i*4)];
draw_map_name_e($name,$x,$y);
};
};
# s_n-pairs
$dirlen = int(@map_s_n/$n_map_dir); # south-north-directions
for ($i=0;$i<$dirlen;$i++) {
if (@map_s_n[($i*$n_map_dir)+3] == $z) { # only if on the right floor
$x1 = @map_s_n[($i*$n_map_dir)+1]; # starting of the line
$y1 = @map_s_n[($i*$n_map_dir)+2];
$y2 = @map_s_n[($i*$n_map_dir)+5]; # ($x2 == $x1)
$style = @map_s_n[($i*$n_map_dir)];
draw_line_s_n($x1,$y1,$y2,$style);
};
};
$dirlen = int(@map_name_s/4); # names in the south
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_s[($i*4)+3] == $z) { # only if on the right floor
$x = @map_name_s[($i*4)+1];
$y = @map_name_s[($i*4)+2];
$name = @map_name_s[($i*4)];
draw_map_name_s($name,$x,$y);
};
};
$dirlen = int(@map_name_n/4); # names in the north
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_n[($i*4)+3] == $z) {
$x = @map_name_n[($i*4)+1];
$y = @map_name_n[($i*4)+2];
$name = @map_name_n[($i*4)];
draw_map_name_n($name,$x,$y);
};
};
# sw_ne-pairs
$dirlen = int(@map_sw_ne/$n_map_dir); # southwest-northeast-directions
for ($i=0;$i<$dirlen;$i++) {
if (@map_sw_ne[($i*$n_map_dir)+3] == $z) { # only if on the right floor
$x1 = @map_sw_ne[($i*$n_map_dir)+1]; # starting of the line
$y1 = @map_sw_ne[($i*$n_map_dir)+2];
$x2 = @map_sw_ne[($i*$n_map_dir)+4];
$y2 = @map_sw_ne[($i*$n_map_dir)+5];
$style = @map_sw_ne[($i*$n_map_dir)];
draw_line_sw_ne($x1,$y1,$x2,$y2,$style);
};
};
$dirlen = int(@map_name_sw/4); # names in the southwest
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_sw[($i*4)+3] == $z) { # only if on the right floor
$x = @map_name_sw[($i*4)+1];
$y = @map_name_sw[($i*4)+2];
$name = @map_name_sw[($i*4)];
draw_map_name_sw($name,$x,$y);
};
};
$dirlen = int(@map_name_ne/4); # names in the northeast
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_ne[($i*4)+3] == $z) {
$x = @map_name_ne[($i*4)+1];
$y = @map_name_ne[($i*4)+2];
$name = @map_name_ne[($i*4)];
draw_map_name_ne($name,$x,$y);
};
};
# se_nw-pairs
$dirlen = int(@map_se_nw/$n_map_dir); # southeast-northwest-directions
for ($i=0;$i<$dirlen;$i++) {
if (@map_se_nw[($i*$n_map_dir)+3] == $z) { # only if on the right floor
$x1 = @map_se_nw[($i*$n_map_dir)+1]; # starting of the line
$y1 = @map_se_nw[($i*$n_map_dir)+2];
$x2 = @map_se_nw[($i*$n_map_dir)+4];
$y2 = @map_se_nw[($i*$n_map_dir)+5];
$style = @map_se_nw[($i*$n_map_dir)];
draw_line_se_nw($x1,$y1,$x2,$y2,$style);
};
};
$dirlen = int(@map_name_se/4); # names in the southeast
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_se[($i*4)+3] == $z) { # only if on the right floor
$x = @map_name_se[($i*4)+1];
$y = @map_name_se[($i*4)+2];
$name = @map_name_se[($i*4)];
draw_map_name_se($name,$x,$y);
};
};
$dirlen = int(@map_name_nw/4); # names in the northwest
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_nw[($i*4)+3] == $z) {
$x = @map_name_nw[($i*4)+1];
$y = @map_name_nw[($i*4)+2];
$name = @map_name_nw[($i*4)];
draw_map_name_nw($name,$x,$y);
};
};
# d_u-pairs
$dirlen = int(@map_d_u/$n_map_dir); # down-up-directions
for ($i=0;$i<$dirlen;$i++) {
if (@map_d_u[($i*$n_map_dir)+3] == $z) { # only if on the right floor
$x1 = @map_d_u[($i*$n_map_dir)+1]; # starting of the line
$y1 = @map_d_u[($i*$n_map_dir)+2];
$z1 = @map_d_u[($i*$n_map_dir)+3];
$x2 = @map_d_u[($i*$n_map_dir)+4];
$y2 = @map_d_u[($i*$n_map_dir)+5];
$z2 = @map_d_u[($i*$n_map_dir)+6];
$style = @map_d_u[($i*$n_map_dir)];
push (@stack_draw_d_u, ($x1,$y1,$z1,$x2,$y2,$z2,$style)); # on stack!
};
};
$dirlen = int(@map_name_d/4); # names downwards
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_d[($i*4)+3] == $z) { # only if on the right floor
$x = @map_name_d[($i*4)+1];
$y = @map_name_d[($i*4)+2];
$name = @map_name_d[($i*4)];
draw_map_name_d($name,$x,$y);
};
};
$dirlen = int(@map_name_u/4); # names upwards
for ($i=0;$i<$dirlen;$i++) {
if (@map_name_u[($i*4)+3] == $z) {
$x = @map_name_u[($i*4)+1];
$y = @map_name_u[($i*4)+2];
$name = @map_name_u[($i*4)];
draw_map_name_u($name,$x,$y);
};
};
};
# ========= draw the up-down-connections at last =========
# They are held in the Array
# @stack_draw_d_u[n] = ($x1,$y1,$z1,$x2,$y2,$z2,$style)
# pop the first line
$style = pop(@stack_draw_d_u);
$z2 = pop(@stack_draw_d_u);
$y2 = pop(@stack_draw_d_u);
$x2 = pop(@stack_draw_d_u);
$z1 = pop(@stack_draw_d_u);
$y1 = pop(@stack_draw_d_u);
$x1 = pop(@stack_draw_d_u);
while (defined($x1)) {
# first part from up to down
$offset1 = $draw_offset_on_floor[$z1]; # z-offset 1
$x3d1 = ($room_grid_x * $x1) + int ($room_size_x / 2) + 2;
$y3d1 = ($room_grid_y * $y1) + int ($room_size_y / 2) + 2;
$x2d1 = $x3d1 - $y3d1 + $drawing_offset_xy;
$y2d1 = $y3d1 + $offset1;
$index2d = ($y2d1 * $drawing_size_x) + $x2d1; # index for start of the line
for ($i=0;$i<=$room_space_y-2;$i++) {
$drawindex = $index2d + ($i*$drawing_size_x);
if ($style == $bin) {
$drawing [$drawindex] = "|";
};
if ($style == $to) {
$drawing [$drawindex] = "^";
};
if ($style == $from) {
$drawing [$drawindex] = "v";
};
};
$dp_index1 = $index2d+(($room_space_y-1)*$drawing_size_x);
$drawing [$dp_index1] = ":"; # last char of line
# second part from down to up
$offset2 = $draw_offset_on_floor[$z2]; # z-offset 2
# $x3d2 = ($room_grid_x * $x2) + int ($room_size_x / 2) + 2; #not needed
$y3d2 = ($room_grid_y * $y1) + int ($room_size_y / 2) - 2;
# $x2d2 = $x3d2 - $y3d2 + $drawing_offset_xy; #not needed
$y2d2 = $y3d2 + $offset2;
$index2d = ($y2d2 * $drawing_size_x) + $x2d1; # index for start of the line
# it's the same as from up-down
for ($i=0;$i<=$room_space_y-2;$i++) {
$drawindex = $index2d - ($i*$drawing_size_x); # upwards
if ($style == $bin) {
$drawing [$drawindex] = "|";
};
if ($style == $to) {
$drawing [$drawindex] = "^";
};
if ($style == $from) {
$drawing [$drawindex] = "v";
};
};
$dp_index2 = $index2d-(($room_space_y-1)*$drawing_size_x);
$char = $drawing[$dp_index2];
if ($char ne ":") {
$drawing [$dp_index2] = ":"; # last char of line
} else {
if ($style == $bin) {
$drawing [$dp_index2] = "|";
};
if ($style == $to) {
$drawing [$dp_index2] = "^";
};
if ($style == $from) {
$drawing [$dp_index2] = "v";
};
};
# print lose dot connections between two rooms (afterwards!)
$dp_index1 = $dp_index1 + ($drawing_size_x * 3); # init value
while ($dp_index2 > $dp_index1) {
$drawing [$dp_index1] = ".";
$dp_index1 = $dp_index1 + ($drawing_size_x * 3); # continue
};
# pop next room
$style = pop(@stack_draw_d_u);
$z2 = pop(@stack_draw_d_u);
$y2 = pop(@stack_draw_d_u);
$x2 = pop(@stack_draw_d_u);
$z1 = pop(@stack_draw_d_u);
$y1 = pop(@stack_draw_d_u);
$x1 = pop(@stack_draw_d_u);
};
# ------------ end of drawing the connections ----------------
####################### SECTION 6: SAVE GRAPHICAL MAP ########################
#######################
# save map into file(s)
# If the map is larger
# than $column_width
# draw multiple maps
#######################
# draws only the really printed map width ("if point in space")
if ($column_width >= $drawing_size_x) { # --- single file for 1 column ---
$outfile = "$outfile_name$outfile_suffix$outfile_type";
# STATUS
print "Saving '$outfile'\n";
unless (open(OUTFILE, ">$outfile")) {
die ("Can't write to output file '$outfile'\n");
};
$drawing_size_y = int(@drawing/$drawing_size_x)+1;
for ($y=0;$y<$drawing_size_y;$y++) { # every line
$out_buffer = ""; # reset output line buffer
$y_offset = $drawing_size_x * $y; # offset into @drawing-array
for ($x=$leftmost_point;$x<$drawing_size_x;$x++) { # draw each line
if ($x <= $rightmost_point) { # put only if in space
$char = $drawing[$y_offset+$x];
if ($char eq "") {
$out_buffer = "$out_buffer "; # add space to buffer
} else {
$out_buffer = "$out_buffer$char"; # else add char to buffer
};
};
};
print OUTFILE "$out_buffer\n"; # write one line to output
};
close(OUTFILE);
} else { # --- multiple files for n columns ---
$column_number = int($drawing_size_x/$column_width)+1;
if ($column_number>999) {
print "Abort due to $column_number columns...\n";
die ("-> increase the 'c=$column_width' flag\n");
};
$outfile_body = "$outfile_name$outfile_suffix";
# STATUS
print "Saving the columns '$outfile_body.xxx$outfile_type'\n";
for ($j=0;$j<$column_number;$j++) { # loop through the columns
if ($j<=999) {$digit = "$j";};
if ($j<=99) {$digit = "0$j";};
if ($j<=9) {$digit = "00$j";};
if ($j==0) {$digit = "000";};
if ( (($j*$column_width)+$leftmost_point) # leftmost point of this column
<= $rightmost_point) { # open file if point in space
unless (open(OUTFILE, ">$outfile_body.$digit$outfile_type")) {
die ("Can't write to output file '$outfile'\n");
};
$drawing_size_y = int(@drawing/$drawing_size_x)+1;
for ($y=0;$y<$drawing_size_y;$y++) { # every line
$out_buffer = ""; # reset output line buffer
$y_offset = $drawing_size_x * $y; # offset into @drawing-array
$x_start = ($j*$column_width)+$leftmost_point;
if ($j == ($column_number-1)) { # last column
$x_end = $drawing_size_x;
} else {
$x_end = $x_start + $column_width; # intermediate column
};
for ($x=$x_start;$x<$x_end;$x++) { # draw each line
$char = $drawing[$y_offset+$x];
if ($x <= $rightmost_point) { # put only if in space
if ($char eq "") {
$out_buffer = "$out_buffer "; # add space to buffer
} else {
$out_buffer = "$out_buffer$char"; # else add char to buffer
};
};
};
print OUTFILE "$out_buffer\n"; # write one line to output
};
close(OUTFILE);
};
};
};
# STATUS
print "Done\n";
####################### end of INFORMAP "float the cave" ########################
