#!/usr/local/bin/perl
#################################################################################
# MK_ROOM_NAME
#
# (c) 1999 by Toni Arnold, Zurich
# ------------------------------------------------------------------------------
# Perl-Script that creates automatically room names for goto.h
# If you don't use goto.h this script is totally useless for you
#
# Version 1.0
# Serial Number 990620
#
# 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
# ------------------------------------------------------------------------------
#
# Description
# -----------
# The script searches all room objects for their directions attached.
# For every room it extracts each word of its short_name and writes
# it separately into the name-array of the room_name.
# The room_name-objects are floating objets seen everywhere wich are
# used by the go to verb.
# If you use that script you don't have to write these objects by yourself.
#
# Rooms which cannot be identified by their name are put out as one single
# room which is commented out with 
#  ! ######## name "schilfrohr" not unique ########,
# If you like to mark one of these ambiguous rooms as the target room
#  (in the example the "schilfrohr"-object of more than one object)
#  add at the end (!) of the object definition line the comment ! #goto
# e.g.: AboveGround In_Forest_1 "In Forest" ! #goto
#
# ------------------------------------------------------------------------------
# Call
# ----
#
# perl informap.pl infile [outfile] [flags]
#
# inflie
# ------
# The main inform file. Include-Paths are followed (see below).
#
# outfile
# -------
# The default filename is [inflie].room_name.inform
#
# 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
#
# 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.
#
# c=[on/off]  e.g. c=on
# ----------
# If this flag is set the script really works: it copies
# all the source code containing room descriptions to
# source.goto in the same directories and adjusts the
# include statements in the main file, too.
# To build a game compile the file source.goto
# Default is off.
#
# d=[on/off] e.g. d=on
# ----------
# If this flag is set the script makes a dictionary of the rooms
# in the order they appeared. If you want the order 
# alphabetivally then sort it with your ASCII-editor.
# Default is off.
#
# l=[language]  e.g. N=deutsch
# ------------
#
# This is for my german translation and creates additionally
# an (null) declination property. 
# range: [english/deutsch]
# Defaults to english.
#
#
# 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
#
# ------------------------------------------------------------------------------
#
# Known Bugs and lacks
# --------------------
#
# - The names of the room have to be given in its object header, the
#    short_name - property is not looked at.
# - Doors (door_dir) are not handled
# - in_to/out_to is not handled
# - before go-routines are handled here, but not n goto.h!
# 
# ------------------------------------------------------------------------------
# This file contains the whole commented source code.
#################################################################################


# 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", "Infix", "infix.h", "goto.h",
                   "GermanG");			# language library



$outfile_suffix = ".room_name";		# change it if you like it different
$outfile_type = ".txt";
$copyfile_suffix = ".goto";


#######################
# Print title message #
#######################

print "\nMK_ROOM_NAME  V1.0b0\n";
print "(c) 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

$include_flag = "on";
$copy_flag = "off";
$dict_flag = "off";
$language = "english";


# facualtative more arguments
# n=13  width of the room Names (default = 11)



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 (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 "c=on") {		# --- C=ON ---
      $copy_flag = "on";
      $arg = "";
    };
    if (lc($arg) eq "f=off") {		# --- C=OFF ---
      $copy_flag = "off";
      $arg = "";
    };

    if (lc($arg) eq "d=on") {		# --- d=ON ---
      $dict_flag = "on";
      $arg = "";
    };
    if (lc($arg) eq "d=off") {		# --- d=OFF ---
      $dict_flag = "off";
      $arg = "";
    };

    if (lc($arg) eq "l=deutsch") {		# --- L=german ---
      $language = "deutsch";
      $arg = "";
    };

    if (lc($arg) eq "l=english") {		# --- L=english ---
      $language = "english";
      $arg = "";
    };


    if ($arg ne "") {		# !! die on invalid arguments !!
      die ("Invalid argument: $arg\n");
    };
  };    
};







##############################################
# -------------------------------------------
# accommodate_new_room
# -------------------------------------------
# The hash array @room[n] contains afterwards
# for each room n an entry with its
# textual name.
# -------------------------------------------
# It 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
# and stores it in the @rooms-Array
# ------
# It is not object oriented and makes use
# of global variables. Sorry.
##############################################


@room_name = ("name","short_name","new_name","input_name");

sub accommodate_new_room {
  my($i,$existing_input_name,$existing_room_name,@existing_list,$once);

  if ($room_detected eq "false") { # if it's not already recogn. as a room

    if ($room_input_name ne "") {	# only for real names unique test

      $once = 0;			# reset $once flag to prevent multiple "&"
      foreach $existing_room_name (@room_list) { # loop through every existing name

         $existing_input_name = $room{$existing_room_name.$room_name[3]};

         if ($existing_input_name ne "") {	# test only against real names

           if ((($existing_input_name eq $room_input_name) || # if not unique name array!
               ($existing_input_name eq "& $room_input_name"))  # or already marked as not unique
               && ($once == 0)) { 
             $room_input_name = "& $room_input_name";	     # non-alphanumerics dont' occur here,
	     $once = 1;					     # so this is safe
             if ($room{$existing_room_name.$room_name[3]} !~ /&.*/) {
                $room{$existing_room_name.$room_name[3]} = 
                  "& $room{$existing_room_name.$room_name[3]}"; # prefix original room wit & too
             }
	   }
         }
      }

    }

    $room_number++; 		  # increase room number to new room
    @room_list[$room_number] = $possible_room;		# possible room is now really a room

    $room{$possible_room.$room_name[1]} = "$room_short_name";	  # short_name of the room object
    $room{$possible_room.$room_name[2]} = "r_n$room_number";	  # inform name of the room object
    $room{$possible_room.$room_name[3]} = "$room_input_name";     # concat. of all name-propertoes                                               

    $room_file_history{$input_file} = 1;			# file is recognized as containing rooms

    $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($i,$end,$out);

   $out = "true";		# init default value
   $end = @include_ignore;

   for ($i=0;$i<$end;$i++) {	# loop trough every skip filename
     if ($file =~ /.*$include_ignore[$i]\Z/i) {
       $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

$InfClass[0] = "object";  # Initialize; is always of class object

sub input_line_loop {

  my($i,$objclass);

  $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/!\s*#\s*goto.*\Z/#goto/i;	# uncomment the #goto-marker

    $line =~ s/!.*//;	# remove other comments at the end


  # pattern matching: recognize Include-Statements

    if (($line =~ /include\s*"(.+)"/i) and
        (is_valid_filename($1) eq "true")) {
       if ($include_flag eq "on") {
         push (@file_stack,$1);
       }
       if (($include_flag eq "on") || ($input_file eq $inform)) {
         $room_file_history{$input_file} = 1;	# file is recognized as containing includes
       }
    }

  # pattern matching: recognize new inform classes
    if ($line =~ /class\s+(\w+)/i) {
       $InfClass[@InfClass] = lc($1);   # add at the end of array
    };


  # repeated pattern matching: recognize object header (= new room)
    $obj_class = "false";
    for ($i=0;$i<@InfClass;$i++) {
      if ($line =~ /$InfClass[$i]\s+(\w+)(.*)\Z/i) {
                    # ^word "object" or any class
                          # ^word boundary
                               # ^name of the (possible) room object
        $obj_class = "true";
        $possible_room = lc($1);   # "room" that matched with object or class
                                   #  (could be any object up to now)

        $room_short_name = $2; 
        if ($room_short_name =~ /.*".*".*/) {

        if ($language ne "english") {
          if ($language eq "deutsch") {
            $room_short_name =~   s/ä/\@:a/g;		# change foreign ascii chars
            $room_short_name =~   s/Ä/\@:a/g;
            $room_short_name =~   s/ö/\@:o/g;
            $room_short_name =~   s/Ö/\@:o/g;
            $room_short_name =~   s/ü/\@:u/g;
            $room_short_name =~   s/Ü/\@:u/g;
            $room_short_name =~   s/ß/\@ss/g;
        } }

          $room_short_name =~ s/^[^"]*//o;		# remove anything before name
          $room_short_name =~ s/[^"]*$//o;			# remove anything after name

          $room_input_name = lc($room_short_name);
          $room_input_name =~ s/[^\w\s\@:]//g;		# only alphanum. and spaces
          $room_input_name =~   s/\@:a/ae/g;		# change foreign ascii chars
          $room_input_name =~   s/\@:o/oe/g;
          $room_input_name =~   s/\@:u/ue/g;
          $room_input_name =~   s/\@ss/ss/g;

          @name_list = split(/ /,$room_input_name);	# create array of words
          undef %saw;					# make words unique
          @name_list_unique = grep(!$saw{$_}++, @name_list);
          @name_list_unique = sort(@name_list_unique);

          $room_input_name = "";			# rebuild input name
          foreach $element (@name_list_unique) {
             if ($element ne "") {			# never add spaces
               if ($room_input_name eq "") {
                 $room_input_name = $element;
               } else {
                 $room_input_name = "$room_input_name $element";
               }
             }
          }

          if ($line =~ /#goto$/i) {		# the target for ambiguous rooms
            push(@go_to_rooms,$possible_room);
          }

        } else {
          $room_short_name = "";			# only "names" are reconized
          $room_input_name = "";
        }

      }
    }
    if ($obj_class eq "true") {	   # recognizes any objects and classes

      $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
    };



  # DO NOT recognize short_name (because it would have to happen before 
  # a room is detected as such and it's not really inform style

#  if ($line =~ /short_name\s*"([^"])"\s"/i) {
#     $room_short_name = $1;
#  };


  # === pattern matching: assign the explicite directions ===

    if ($line =~ /\bn_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };
   
    if ($line =~ /\bne_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\be_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bse_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bs_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bsw_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bw_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bnw_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bu_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bd_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bin_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };

    if ($line =~ /\bout_to\s+(\w+)/i ) {
      &accommodate_new_room;
    };


  # === 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;
    };
   
    if (($go_obj_detected eq "ne_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "e_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "se_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "s_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "sw_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "w_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "nw_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "u_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

    if (($go_obj_detected eq "d_obj") && ($line =~ /\bplayerto\((\w+)/i )) {
      &accommodate_new_room;
    };

  # --- 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 "Extracting room names out of the file '$inform'\n";

$room_number=-1; # initialize room counter (-1 for no room)


$input_file = $inform;		# main file = first input file
$outfile = "$outfile_name$outfile_suffix$outfile_type";

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]\n";
 };
 print "\n\n";
}



# STATUS

print "Got map data\n";



###########################
# test wether go_to_rooms
# are unique.
# die otherwise
###########################


undef %saw;
undef %memory;

foreach $unique_go_room (@go_to_rooms) {
  $name_of_ugr = $room{$unique_go_room.$room_name[3]};
  $name_of_ugr =~ s/^& //o;		# remove duplicate marker & 

  $saw{$name_of_ugr}++;

  if ($saw{$name_of_ugr} >= 2) {
    die ("\n\n! #goto ERROR: room names '$name_of_ugr' of $unique_go_room equal as of $memory{$name_of_ugr}\n");
  }
  $memory{$name_of_ugr} = $unique_go_room;
}



############################
# save room names into file
############################

if ($dict_flag eq "on") {

# STATUS
  print "Saving '$outfile'\n";


# do the save operation

  unless (open(OUTFILE, ">$outfile")) {
    die ("Can't write to output file '$outfile'\n");
  };


    print OUTFILE "! ------------------------------\n";
    print OUTFILE "! $inform\n";
    print OUTFILE "! Dictionary for\n";
    print OUTFILE "! room name objects for goto.h\n";
    print OUTFILE "! created by mk_room_name\n";
    print OUTFILE "! from Toni Arnold\n";
    print OUTFILE "! ------------------------------\n\n\n";
    

   
    foreach $name (@room_list) {		# loop through each room
     
      $short_name = $room{$name.$room_name[1]};
      $in_name = $room{$name.$room_name[3]};	# cleaned short_name
      @name_list = split(/ /,$in_name);		# list of all name properties of room
      
# --- object header (without ,) --- 

      print OUTFILE "$short_name | $name |";


# --- object name property (with , because of comments) ---

      if ($in_name ne "") {
        if ($in_name !~ /&.*/) {	# if not marked as not unique
          foreach $parse_name (@name_list) {
            if ($parse_name ne "") {
              print OUTFILE " \"$parse_name\"";
            }
          }
          
        } else {			# if not unique room could be in @go_to_rooms
 
          $member = 0;
          foreach $element (@go_to_rooms) {
            if ($element eq $name) {
              $member = 1;
            }
          }
          if ($member == 1) {		# if it *is* in @to_to_rooms
            foreach $parse_name (@name_list) {
              if (($parse_name ne "") && ($parse_name ne "&")) {
                print OUTFILE " \"$parse_name\"";
              }
            }
            print OUTFILE " ! ### goto ###";	# COMMA of name-property
          } else {
            print OUTFILE " ! ######## name";	# COMMA of name-property
            foreach $parse_name (@name_list) {
              if (($parse_name ne "") && ($parse_name ne "&")) {
                print OUTFILE " \"$parse_name\"";
              }
            }
            print OUTFILE " not unique ########";
          }
        }		# end of if not unique
      } # end of empty in name
      


# -- language specific stuff --

#      if ($language ne "english") {
#        if ($language eq "deutsch") {
#          print OUTFILE "\n  dekl 0, has male";
#        }
#      }

      print OUTFILE ";\n\n";
    }

  close(OUTFILE);

}


################################################################################
# Copy all files contining rooms
# to file.goto and add to each room
# the goto_steps property
# and the name array
# ----------------------------

sub copy_inform_file_loop {

 $obj_to_adjust = 0;	# init flag

 while (<INFORMFILE>) {
   $line = $_;		 # $line contains the actual line
   chomp($line);

   if ($line !~ /^\s*!/) {	# skip commented lines


     # pattern matching: recognize Include-Statements and adjust them with suffix
     if (($line =~ /include\s*"(.+)"/i) and
         (is_valid_filename($1) eq "true")) {
       if ($room_file_history{$1} == 1) { 
          $line =~ s/include\s*"(.+)"/include "$1$copyfile_suffix"/i;
       }
     }

     # room object headers
     for ($i=0;$i<@InfClass;$i++) {
       if ($line =~ /$InfClass[$i]\s+(\w+)(.*)\Z/i) {
                     # ^word "object" or any class
                           # ^word boundary
                                # ^name of the (possible) room object print ($1);
         $possible_room = lc($1);
         $room_index = $room_list_hash{$possible_room};
         if ($room_index >= 1) {  # if the obj is in the room list
           $obj_to_adjust = 2; 	     # flag ist true (with is to be replaced)
         } else {		     # but not before the next line
           $obj_to_adjust = 0;
         }
       }
     }

     # adjusting lines including with
     if ($obj_to_adjust >= 1) {
    
      if ($obj_to_adjust == 2) { $obj_to_adjust=1; } else {
       if ($line =~ s/\bwith\b(.*)/with/i) {  
          $line_rest = $1;	# remember rest of the line that was cut here

          $obj_to_adjust = 0;

          $line_name = "goto_steps 0,           ! ----> room <---- ";	# declare goto_steps property

# --- object name property (with , because of comments) ---
          $in_name = $room{$possible_room.$room_name[3]};
          @name_list = split(/ /,$in_name);		# list of all name properties of room

          if ($in_name ne "") {
            if ($in_name !~ /&.*/) {	# if not marked as not unique

              $line_name = $line_name."\n   name ";

              foreach $parse_name (@name_list) {
                if ($parse_name ne "") {
                  $line_name = $line_name." \"$parse_name\"";
                }
              }
              $line_name = $line_name.",";		# COMMA of name-property
              
            } else {			# if not unique room could be in @go_to_rooms
     
              $member = 0;
              foreach $element (@go_to_rooms) {
                if ($element eq $possible_room) {
                  $member = 1;
                }
              }
              if ($member == 1) {		# if it *is* in @to_to_rooms
                $line_name = $line_name."\n   name";
                foreach $parse_name (@name_list) {
                  if (($parse_name ne "") && ($parse_name ne "&")) {
                    $line_name = $line_name." \"$parse_name\"";
                  }
                }
                $line_name = $line_name.",           ! >#>#> goto <#<#<";	# COMMA of name-property

              } else {
                $line_name = $line_name."\n           ! ##### name";	# COMMA of name-property
                foreach $parse_name (@name_list) {
                  if (($parse_name ne "") && ($parse_name ne "&")) {
                    $line_name = $line_name." \"$parse_name\"";
                  }
                }
                $line_name = $line_name." not unique #####";
              }
            }		# end of if not unique

          } # end of name property (in_name ne "")

       } # end of "with" recognized

       $line =~ s/\bwith\b/with $line_name\n$line_rest/io; # compose line again
      }
     } # end of obj to adjust

   print COPYFILE "$line\n";	# print the line, whether adjusted or not

   } # end of not commented lines

 } # Loop für while INFORMFILE

}  
# --------- end of subroutine --------



if ($copy_flag eq "on") {

# STATUS
  print "\nCopying files out of the file '$inform' to '$inform$copyfile_suffix'\n";

  $i=1;	# index counter for rooms

  foreach $room (@room_list) {
    $room_list_hash{$room} = $i++;	# init hash field
  }

  $room_number=-1; # initialize room counter (-1 for no room)

  while ( ($input_file, $dummy) = each %room_file_history) {	# loop through all examined files

    $skip_nonfile = "false";		# for skipping nonexistent files


    unless (open(INFORMFILE, $input_file)) {
      die ("Cant't open $input_file for some strange reason...");
    }

     unless (open(COPYFILE, ">$input_file$copyfile_suffix")) {
      die ("Can't write to output file '$outfile'\n");
     }
 
     print "Reading '$input_file' and writing '*$copyfile_suffix'\n";

     &copy_inform_file_loop;		# copy the whole information from the file


    close(INFORMFILE);		# close it
    close(COPYFILE);			# close output file

  }
}


# STATUS

print "\nDone\n";

####################### end of mk_room_name ########################
