#!/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: # tarnold@cl.unizh.ch # # 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 () { $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" ########################