#!/usr/bin/perl
#
# Program: ifm2i7 (source code)
#
#          Convert raw format files generated by ifm (Interactive
#          Fiction Mapper) to Inform 7 source code.
#
# .
#
# Author:  Sergey Goldgaber http://code.wetash.com
#
#-------------------------------------------------------------------

#-------------------------------------------------------------------
#
# BEGIN - Includes (DO NOT MODIFY)                              {{{1
#
# Section: Includes
#
# Topic: Internal includes
#
#           Please do not modify.
#
#    Carp               - Warns of errors.
#      http://search.cpan.org/author/RGARCIA/perl-5.10.0/lib/Carp.pm
#
#    Carp::Assert::More - Assures certain conditions never happen.
#      http://search.cpan.org/author/PETDANCE/Carp-Assert-More-1.12/More.pm
#
#    diagnostics        - Produce verbose warning diagnostics.
#      http://search.cpan.org/author/RGARCIA/perl-5.10.0/lib/diagnostics.pm
#
#    English            - Use nice English words for ugly
#      punctuation variables.
#      http://search.cpan.org/~rgarcia/perl-5.10.0/lib/English.pm
#
#    Fatal              - Replaces functions with equivalents
#      which succeed or die.
#      http://search.cpan.org/author/RGARCIA/perl-5.10.0/lib/Fatal.pm
#
#    Getopt::Lucid      - Clear, readable syntax for option processing
#      http://search.cpan.org/~dagolden/Getopt-Lucid-0.16/lib/Getopt/Lucid.pm
#
#    Readonly           - Facility for creating read-only scalars,
#      arrays, hashes.
#      http://search.cpan.org/author/ROODE/Readonly-1.03/Readonly.pm
#
#    strict             - Perl pragma to restrict unsafe constructs
#      http://search.cpan.org/author/RGARCIA/perl-5.10.0/lib/strict.pm
#
#    Switch             - An alternative to if/elsif
#      http://search.cpan.org/~rgarcia/Switch-2.13/Switch.pm
#
#    warnings           - Perl pragma to control optional warnings.
#      http://search.cpan.org/author/RGARCIA/perl-5.10.0/lib/warnings.pm
#
#--------------

use Carp                   ; 
use Carp::Assert::More     ; 
use diagnostics            ; 
use English                ; 
use Fatal                  ; 
use Getopt::Lucid qw(:all) ; 
use Readonly               ; 
use Switch 'Perl6', '__'   ; 
use strict                 ; 
use warnings               ; 

#--------------
#
# END - Includes (DO NOT MODIFY)                                }}}
#
#-------------------------------------------------------------------

#-------------------------------------------------------------------
#
# BEGIN - User-configurable region                              {{{1
#
#--------------

# Topic:  User configurable includes
#
#    Smart::Comments       - Use comments for diagnostics.  Feel free
#                            to (un)comment it if you feel the need.
#                            http://search.cpan.org/author/DCONWAY/Smart-Comments-v1.0.2/lib/Smart/Comments.pm

#use Smart::Comments "###" ; 

# Section: Variables
#
# Topic: Global, user configurable
#
# $EOL - End of line character
#
Readonly my $EOL         => "\n"   ;

#--------------
#
# END - User-configurable region                                 }}}
#
#-------------------------------------------------------------------

#-------------------------------------------------------------------
#
# BEGIN - Internal variables ( DO NOT MODIFY )                  {{{1
#
#--------------

# Topic: Global, internal
#
#               Please do not modify.
#
#
# Exit values
#
# $EXIT_ERROR    - Program exiting with an error.
# $EXIT_NO_ERROR - Program exiting withou an error.
#
# Truth and falseness
#
# $FALSE         - Self explanatory.
# $TRUE          - Self explanatory.
#
# Directions
#
# $NORTH     - Self explanatory.
# $SOUTH     - Self explanatory.
# $EAST      - Self explanatory.
# $WEST      - Self explanatory.
# $NORTHEAST - Self explanatory.
# $NORTHWEST - Self explanatory.
# $SOUTHEAST - Self explanatory.
# $SOUTHWEST - Self explanatory.
# $UP        - Self explanatory.
# $DOWN      - Self explanatory.
# $IN        - Self explanatory.
# $OUT       - Self explanatory.
#
# Others
#
# $EXITS_CODE - Inform 7 source code for printing all possible exits
#               from a room.  Useful for debugging maps.
#
# $NOWARNINGS - Disables warning messages (false by default)
#
# $USAGE      - What to print to show how this program is used.
#
Readonly my $EXIT_ERROR    => 1           ; 
Readonly my $EXIT_NO_ERROR => 0           ; 
Readonly my $FALSE         => "false"     ; 
Readonly my $TRUE          => "true"      ; 
Readonly my $NORTH         => "North"     ; 
Readonly my $SOUTH         => "South"     ; 
Readonly my $EAST          => "East"      ; 
Readonly my $WEST          => "West"      ; 
Readonly my $NORTHEAST     => "Northeast" ; 
Readonly my $NORTHWEST     => "Northwest" ; 
Readonly my $SOUTHEAST     => "Southeast" ; 
Readonly my $SOUTHWEST     => "Southwest" ; 
Readonly my $UP            => "Up"        ; 
Readonly my $DOWN          => "Down"      ; 
Readonly my $IN            => "Inside"    ; 
Readonly my $OUT           => "Outside"   ; 

my $NOWARNINGS = "false" ;

Readonly my $EXITS_CODE    => <<"END_EXITS_CODE";

Chapter - Status line exits - Not for release

[The code below (from Example 307 in Writing With Inform) prints
a list of exits from the current room on to the status line.  You can
disable the automatic generation of this code with ifm2i7's
--noexits option.]

When play begins:
        change left hand status line to "Exits: [exit list]";
        change right hand status line to "[location]".

To say exit list:
        let place be location;
        repeat with way running through directions
        begin;
                let place be the room way from the location;
                if place is a room, say " [way]";
        end repeat.
Rule for printing the name of a direction (called the way) while constructing the status line:
        choose row with a heading of the way in the Table of Abbreviation;
        say "[shortcut entry]".

Table of Abbreviation
heading	shortcut
north	"N"
northeast	"NE"
northwest	"NW"
east	"E"
southeast	"SE"
south	"S"
southwest	"SW"
west	"W"
up	"U"
down	"D"
inside	"IN"
outside	"OUT"

END_EXITS_CODE

Readonly my $USAGE         => <<"END_USAGE";
Usage: $0 [OPTIONS] [input.ifm [output.ni]]

       --help
        -h
               Display this usage information.

       --input  <FILE>
        -i      <FILE>
               Path to a map file in ifm format (Optional)
               Can be "-" for STDIN (Default)

       --noexits
        -n
               Disable generation of Inform 7 code that puts
               all the current room's exits up on the status line.

       --output <FILE>
        -o      <FILE>
               File to write Inform 7 source code to.  (Optional)
               Can be "-" for STDOUT (Default)

       --verbosity=X
        -v=X
               Set the verbosity level to X.
               Valid settings are:

                   silent - (almost no errors, and no warnings)
                   quiet  - (all errors, but no warnings)
                   normal - (all errors and warnings) (Default)
                   debug  - (everything and then some)

       --version
        -V
               Print the version of this program and exit.
       
       input.ifm
               Path to a map file in ifm format (Optional)
               Can be "-" for STDIN (Default)
       
       output.ni
               File to write Inform 7 source code to.  (Optional)
               Can be "-" for STDOUT (Default)

NOTE: If you do not specify "input.ifm" or "output.ni", the input
      will come from STDIN and the output will go to STDOUT by default
END_USAGE

#--------------
#
# END - Internal variables ( DO NOT MODIFY )                    }}}
#
#-------------------------------------------------------------------

#-------------------------------------------------------------------
#
# BEGIN - Subroutines                                           {{{1
#
#--------------

# Subroutine: are_opposite_directions
#
# Checks to see if two directions are opposites of one another.
#
# Parameters:
#
#   scalar - first direction
#   scalar - second direction
#
# Returns:
#
#   $TRUE  - given directions are opposites
#   $FALSE - given directions are not opposites
#
# Output:
#
#   nothing
#
sub are_opposite_directions { #{{{2
    my $direction_from_source = shift ;
    my $direction_from_dest   = shift ;

    if    ( ( $direction_from_source eq $NORTH     ) and
            ( $direction_from_dest   eq $SOUTH     ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $SOUTH     ) and
            ( $direction_from_dest   eq $NORTH     ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $EAST      ) and
            ( $direction_from_dest   eq $WEST      ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $WEST      ) and
            ( $direction_from_dest   eq $EAST      ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $NORTHEAST ) and
            ( $direction_from_dest   eq $SOUTHWEST ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $NORTHWEST ) and
            ( $direction_from_dest   eq $SOUTHEAST ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $SOUTHEAST ) and
            ( $direction_from_dest   eq $NORTHWEST ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $SOUTHWEST ) and
            ( $direction_from_dest   eq $NORTHEAST ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $IN        ) and
            ( $direction_from_dest   eq $OUT       ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $OUT       ) and
            ( $direction_from_dest   eq $IN        ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $UP        ) and
            ( $direction_from_dest   eq $DOWN      ) ) { return $TRUE }
    elsif ( ( $direction_from_source eq $DOWN      ) and
            ( $direction_from_dest   eq $UP        ) ) { return $TRUE }
    else { return $FALSE }

} #}}}

# Subroutine: canonical_direction
#
# Standardize direction names
#
# Parameters:
#
#   scalar - direction
#
# Returns:
#
#   standardized direction name
#
# Output:
#
#   Error when an unknown direction is encountered.
#
# Example:
#
#   "east" returns "East"
#
#   "i"    returns "In"
#
#   "out"  returns "Out"
#
sub canonical_direction { #{{{2
    my $direction = shift ;

    given ( $direction ) {
        when m{^n$}i          { return $NORTH      }
        when m{^s$}i          { return $SOUTH      }
        when m{^e$}i          { return $EAST       }
        when m{^w$}i          { return $WEST       }
        when m{^ne$}i         { return $NORTHEAST  }
        when m{^nw$}i         { return $NORTHWEST  }
        when m{^se$}i         { return $SOUTHEAST  }
        when m{^sw$}i         { return $SOUTHWEST  }
        when m{^north$}i      { return $NORTH      }
        when m{^north$}i      { return $SOUTH      }
        when m{^east$}i       { return $EAST       }
        when m{^west$}i       { return $WEST       }
        when m{^northeast$}i  { return $NORTHEAST  }
        when m{^northwest$}i  { return $NORTHWEST  }
        when m{^southeast$}i  { return $SOUTHEAST  }
        when m{^southwest$}i  { return $SOUTHWEST  }
        when m{^i$}i          { return $IN         }
        when m{^in$}i         { return $IN         }
        when m{^o$}i          { return $OUT        }
        when m{^out$}i        { return $OUT        }
        when m{^u$}i          { return $UP         }
        when m{^up$}i         { return $UP         }
        when m{^d$}i          { return $DOWN       }
        when m{^down$}i       { return $DOWN       }
        default {
            croak( "FATAL ERROR: Unknown direction: '$direction'" )
        }
    }

} #}}}

# Subroutine: check_ifm
#
#   Exit with an error if ifm could not be found in the user's $PATH,
#   or if it isn't executable.
#
# Parameters:
#
#   none
#
# Returns:
#
#   nothing
#
# Output:
#
#   Error if above conditions are not met
#
sub check_ifm { #{{{2
    system( "which ifm 2> /dev/null > /dev/null" ) ;

    if ( $CHILD_ERROR ne "0" ) { #{{{3
        exiterr(
          'FATAL ERROR: Could not find ifm in your $PATH' . $EOL
        ) ;
    } #}}}
    else { #{{{3
        my $location_of_ifm = `which ifm` ;
        chomp $location_of_ifm ;
        if ( not ( -x $location_of_ifm ) ) { #{{{4
            exiterr(
              "FATAL ERROR: '$location_of_ifm' is not executable"
              . $EOL
            ) ;
        } #}}}
    } #}}}

    return ;
} #}}}

# Subroutine: choose_input_file_name
#
#   Set the default file name, if there isn't one, or use the
#   first command line argument, if it's there.
#
# Parameters:
#
#   scalar - input file name from the --input command line option
#
# Returns:
#
#   scalar - chosen input file name
#
# Output:
#
#   nothing
#
sub choose_input_file_name { #{{{2
    my $input_file_name = shift ;

    if ( $input_file_name  eq "" ) { #{{{3
        if ( ( defined $ARGV[0] ) and ( $ARGV[0] ne "" ) ) { #{{{4
            $input_file_name  = $ARGV[0] ;
        } #}}}
        else { #{{{4
            $input_file_name  = "-" ;
        } #}}}
    } #}}}

    return $input_file_name ;
} #}}}

# Subroutine: choose_output_file_name
#
#   Set the default file name, if there isn't one, or use the
#   first command line argument, if it's there.
#
# Parameters:
#
#   scalar - input file name from the --input command line option
#
# Returns:
#
#   scalar - chosen input file name
#
# Output:
#
#   nothing
#
sub choose_output_file_name { #{{{2
    my $output_file_name = shift ;

    if ( $output_file_name  eq "" ) { #{{{3
        if ( ( defined $ARGV[1] ) and ( $ARGV[1] ne "" ) ) { #{{{4
            $output_file_name  = $ARGV[1] ;
        } #}}}
        else { #{{{4
            $output_file_name  = "-" ;
        } #}}}
    } #}}}

    return $output_file_name ;
} #}}}

# Subroutine: clean_name
#
# Remove illegal characters from the room, region, and item names,
# converting some of them to spaces as needed.
#
# Parameters:
#
#   scalar - room name
#
# Returns:
#
#   scalar - room name
#
# Output:
#
#   nothing
#
sub clean_name { #{{{2
    my $room_name = shift ;

    $room_name =~ s{:}{ }g  ; # Colons to spaces.
    $room_name =~ s{ +}{ }g ; # Multiple spaces to a single space.

    return $room_name ;
} #}}}

# Subroutine: close_output_file
#
#   Redirects the output filehandle back to STDOUT and closes
#   the open output file.
#
# Parameters:
#
#   filehandle - output filehandle
#   filehandle - old output filehandle (STDOUT)
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
sub close_output_file { #{{{2
    my ( $output_filehandle, $old_output_filehandle ) = shift ;

    if ( defined $output_filehandle ) { #{{{3
        close( $output_filehandle ) ;

        # Restore STDOUT
        select( $old_output_filehandle ) ;
    }

    return ;
} #}}}

# Subroutine: enable_debug
#
#   Enable debugging messages.
#
# Parameters:
#
#   none
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
sub enable_debug { #{{{2

    return ;
} #}}}

# Subroutine: enable_quiet
#
#   Disable warnings.
#
# Parameters:
#
#   none
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
sub enable_quiet { #{{{2
    $NOWARNINGS = "true" ;
    return ;
} #}}}

# Subroutine: enable_silence
#
#   Silence almost all errors and warnings by redirecting
#   STDERR to /dev/null
#
# Parameters:
#
#   none
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
sub enable_silence { #{{{2
    open STDERR, ">>/dev/null" ;

    return ;
} #}}}

# Subroutine: exiterr
#
# Print an error on STDERR and exit.
#
# Parameters:
#
#   scalar - Error to print
#
# Returns:
#
#   nothing
#
# Output:
#
#   Error on STDERR
#
sub exiterr { #{{{2
    my $error = shift ;
    printerr( $error ) ;
    exit $EXIT_ERROR   ; 
} #}}}

# Subroutine: file_exists
#
# Complain and exit if the given file does not exist, or is not a "-".
#
# Parameters:
#
#   scalar - file name
#
# Returns:
#
#   nothing
#
# Output:
#
#   Error when the file does not exist.
#
sub file_exists { #{{{2
    my $File = shift ;

    # Skip file existance check if file is STDIN
    return if $File eq "-" ;

    # Check to see if file exists.
    if ( not( -f $File ) ) { #{{{3
        printerr( "ERROR: File '$File' does not exist.  Exiting." ) ;
        printerr( $EOL ) ;
        exit $EXIT_ERROR ;
    }
    else { #{{{3
        # File exists.  Do nothing.
    } #}}}

    return ;
} #}}}

# Subroutine: find_direction
#
# Given two positions on the map, find which direction the
# second is from the first.
#
# Parameters:
#
#   scalar (two integers, separated by a space) - source position
#   scalar (two integers, separated by a space) - destination position
#
# Returns:
#
#   direction
#
# Output:
#
#   Errors when positions are not integers, or when
#   source and destination positions are the same.
#
# Examples:
#
#   Given: "0 0" and "0 1", the direction is "North"
#
#   Given: "0 1" and "1 1", the direction is "East"
#
#   Given: "1 1" and "1 0", the direction is "South"
#
#   Given: "1 0" and "0 0", the direction is "West"
#
#   Given: "1 1" and "0 0", the direction is "Southwest"
#
sub find_direction { #{{{2
    my $source_position = shift ;
    my $dest_position   = shift ;
    my $direction       = ""    ;

    assert_defined( $source_position ) ;
    assert_defined( $dest_position   ) ;

    my ( $source_x, $source_y ) = split( / / , $source_position ) ;
    my ( $dest_x,   $dest_y   ) = split( / / , $dest_position   ) ;

    assert_defined( $source_x ) ;
    assert_defined( $source_y ) ;
    assert_defined( $dest_x   ) ;
    assert_defined( $dest_y   ) ;

    assert_integer( $source_x ) ;
    assert_integer( $source_y ) ;
    assert_integer( $dest_x   ) ;
    assert_integer( $dest_y   ) ;

    assert_isnt( $source_position, $dest_position,
        "Source and destination positions differ." );

    # Note that below whenever "__" is used, it just refers to
    # whatever is in the nearest enclosing "given" statement.
    #
    # See the Switch module documentation for more information.
    given ( $source_y ) { #{{{3
        when __ == $dest_y { #{{{4
            given ( $source_x ) { #{{{5
                when __ < $dest_x { $direction = $EAST       }
                when __ > $dest_x { $direction = $WEST       }
            } #}}}
        } #}}}
        when __  < $dest_y { #{{{4
            given ( $source_x ) { #{{{5
                when __ == $dest_x { $direction = $NORTH     }
                when __  < $dest_x { $direction = $NORTHEAST }
                when __  > $dest_x { $direction = $NORTHWEST }
            } #}}}
        } #}}}
        when __  > $dest_y { #{{{4
            given ( $source_x ) { #{{{5
                when __ == $dest_x { $direction = $SOUTH     }
                when __  < $dest_x { $direction = $SOUTHEAST }
                when __  > $dest_x { $direction = $SOUTHWEST }
            } #}}}
        } #}}}
    } #}}}

    return $direction ;
} #}}}

# Subroutine: fix_5J39_room_bug
#
# Inform 7 build 5J39 has a bug where using the "called" directive
# can cause rooms to not be connected to one another, in certain
# cases.  See the README file for more details.
#
# So in order to avoid this bug and still generate code that the
# Inform 7 build 5J39 compiler likes, we're going to have to
# change some room names.
#
# Parameters:
#
#   scalar - dirty room name
#
# Returns:
#
#   scalar - cleaned room name
#
# Output:
#
#   Warnings when the room name has been changed.
#
# Example:
#
#   "to House" returns "to_House"
#
sub fix_5J39_room_bug { #{{{2
    my $dirty_room_name   = shift            ; 
    my $cleaned_room_name = $dirty_room_name ; 

    $cleaned_room_name =~ s{^to }{to_} ;
    $cleaned_room_name =~ s{^in }{in_} ;


    if ( $dirty_room_name ne $cleaned_room_name ) { #{{{3
        printerr( "[WARNING: Renamed a room called " .
                  "'$dirty_room_name' " .
                  "to '$cleaned_room_name', " .
                  "to avoid an Inform 5J39 bug.]" . $EOL
        ) ;
    } #}}}

    return $cleaned_room_name ;
} #}}}

# Subroutine: get_height
#
# Get a height, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_height { #{{{2
    my $line = shift ;
    if ( $line =~ m{^height: (.*)} ) { #{{{3
        $Main::height = $1 ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_item
#
# Get a item, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_item { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^item: (.*)} ) and
         ( $Main::in_block eq "false" ) ) { #{{{3
        $Main::in_block      = "true" ;
    } #}}}

    return ;
} #}}}


# Subroutine: get_link_and_join
#
# Get a link or join, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_link_and_join { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^(link|join): (.*)} ) and
         ( $Main::in_block eq "false" ) ) { #{{{3
        my $link = $2 ;
        $Main::in_block      = "true" ;
        $Main::in_link_block = "true" ;
        ( $Main::link_source, $Main::link_dest ) =
            split( / / , $link ) ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_link_go
#
# Gets the link's 'go:' direction, if there is one.
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_link_go { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^go: (.*)} ) and
         ( $Main::in_link_block eq "true" ) ) { #{{{3
        $Main::link_go = canonical_direction( $1 ) ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_link_oneway
#
# Gets the link's 'oneway:' value, if there is one.
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_link_oneway { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^oneway: (.*)} ) and
         ( $Main::in_link_block eq "true" ) ) { #{{{3
        $Main::link_oneway = $1 ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_link_position
#
# Get a link position, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_link_position { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^lpos: (.*)} ) and
         ( $Main::in_link_block eq "true" ) ) { #{{{3
        my $link_position = $1 ;
        # Skip the first link position
        if ( $Main::skipped_first_link_position eq "true" ) {#{{{4
            # We must be on the second or later link position.
            if ( $Main::second_link_position eq "" ) { #{{{5
                #We must be on the second link position.
                $Main::second_link_position   = $link_position ;
                $Main::previous_link_position =
                    $Main::current_link_position ;
                $Main::current_link_position  = $link_position ;
            } #}}}
            else { #{{{5
                #We must be past the second link position.
                $Main::previous_link_position =
                    $Main::current_link_position ;
                $Main::current_link_position  = $link_position ;
            } #}}}
        } #}}}
        else { #{{{4
            # Skipping the first link position
            $Main::current_link_position       = $link_position ; 
            $Main::skipped_first_link_position = "true"         ; 
        } #}}}
    } #}}}

    return ;
} #}}}

# Subroutine: getopt_exception_handler
#
#   Handle exceptions from Getopt::Lucid->getopt() threw
#
# Parameters:
#
#   exception - the exception that Getopt::Lucid->getopt() threw
#
# Returns:
#
#   nothing
#
# Output:
#
#   A descriptive message about the exception.
#
sub getopt_exception_handler { #{{{2
    my $EVAL_ERROR = shift ;

    if ( $EVAL_ERROR ) { #{{{3
        my $Exception_Type = ref $EVAL_ERROR ;

        if ( $Exception_Type =~ s{^Getopt::Lucid::Exception::}{} ) {
            given ( $Exception_Type ) { #{{{4
                when 'ARGV' { #{{{4
                    # Invalid command line arguments
                    exiterr( "FATAL ERROR: $EVAL_ERROR" . $EOL ) ; 
                } #}}}
                when 'Usage' { #{{{4
                    # Getopt::Lucid methods called incorrectly.
                    exiterr( "FATAL ERROR: $EVAL_ERROR" . $EOL ) ; 
                } #}}}
                when 'Spec' { #{{{4
                    # Getopt::Lucid specification array contains
                    # incorrect or invalid data.
                    exiterr( "FATAL ERROR: $EVAL_ERROR" . $EOL ) ; 
                } #}}}
                default { #{{{4
                    ref $EVAL_ERROR ? $EVAL_ERROR->rethrow :
                        die $EVAL_ERROR;
                } #}}}
            } #}}}
        }
        else {
            ref $EVAL_ERROR ? $EVAL_ERROR->rethrow :
                die $EVAL_ERROR;
        }

    } #}}}

    return ;
} #}}}

# Subroutine: get_options
#
#   Use the Getopt::Lucid module to get and return options.
#
# Parameters:
#
#   none
#
# Returns:
#
#   scalar - Result->get_noexits
#   scalar - Input_File
#   scalar - Output_File
#
# Output:
#
#   Errors when Getopt::Lucid has been called incorrectly or
#   invalid options were used.
#
#   Usage and/or version, if the user requests either.
#
sub get_options { #{{{2
    ##### Getting options...
    
    # Getopt::Lucid can operate in "strict" mode by setting
    # $Getopt::Lucid::STRICT to a true value.
    #
    # In strict mode, option names and aliases may still be specified
    # in any of the three styles, but they will only be parsed from
    # the command line if they are used in exactly the same style.
    #
    # E.g., given the name and alias "--help|-h", only "--help" and
    # "-h" are valid for use on the command line.
    $Getopt::Lucid::STRICT = 1 ;

    my @Option_Specifications = ( #{{{3
        Switch( "--noexits" ) ,
        Switch( "--help|-h"            ) ,
        Param(  "--input|-i"           ) ,
        Param(  "--output|-o"          ) ,
        Param(  "--verbosity|-v"       ) ,
        Switch( "--version|-V"         ) ,
    ) ; #}}}

    # Get command line options and any exceptions
    my $Result     = "" ;
    eval {
        $Result = Getopt::Lucid->getopt(
                    \@Option_Specifications
        )
    } ;

    # Print error and die on exceptions.
    getopt_exception_handler( $EVAL_ERROR ) ;

    # Handle --help option
    if ( $Result->get_help ) { #{{{3
        usage() ;
        exit($EXIT_NO_ERROR);
    } #}}}

    # Handle --version option
    if ( $Result->get_version ) { #{{{3
        printerr( "Version: FIXME" ) ;
        printerr( $EOL ) ;
        exit($EXIT_NO_ERROR);
    } #}}}

    # Handle --verbosity option
    verbosity_handler( $Result->get_verbosity ) ;

    # Handle --input and --output options
    my $Input_File  = $Result->get_input  ;
    my $Output_File = $Result->get_output ;

    return $Result->get_noexits, $Input_File, $Output_File ;
} #}}}

# Subroutine: get_room_number
#
# Get a room number, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_room_number { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^room: (.*)} ) and
         ( $Main::in_block eq "false" ) ) { #{{{3
        $Main::room_number   = $1     ;
        $Main::in_room_block = "true" ;
        $Main::in_block      = "true" ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_room_name
#
# Get a room name, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_room_name { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^name: (.*)} ) and
         ( $Main::in_room_block eq "true" ) ) { #{{{3
            my $dirty_room_name   = $1                    ; 
            my $cleaned_room_name = clean_name( $1 ) ; 
            $cleaned_room_name    = fix_5J39_room_bug(
                                      $cleaned_room_name ) ; 
            $Main::room_name      = $cleaned_room_name     ; 
    } #}}}

    return ;
} #}}}

# Subroutine: get_room_position
#
# Get a room position, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_room_position { #{{{2
    my $line = shift ;
    if ( ( $line =~ m{^rpos: (.*)} ) and
         ( $Main::in_room_block eq "true" ) ) { #{{{3
        $Main::room_position = $1 ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_region
#
# Get a region ("section" in ifm lingo), if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_region { #{{{2
    my $line = shift ;

    if ( $line =~ m{^section: (.*)} ) { #{{{3
        my $dirty_region = $1 ;
        my $cleaned_region = clean_name( $dirty_region ) ;
        $Main::region      = $cleaned_region ;
        $Main::in_block    = "true" ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_task
#
# Get a task, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_task { #{{{2
    my $line = shift ;

    if ( ( $line =~ m{^task: (.*)} ) and
         ( $Main::in_block eq "false" ) ) { #{{{3
        $Main::in_block      = "true" ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_title
#
# Get a title, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_title { #{{{2
    my $line = shift ;

    if ( $line =~ m{^title: (.*)} ) { #{{{3
        $Main::title    = $1 ;
        $Main::in_block = "true" ;
        print "\"$Main::title\"" . $EOL . $EOL ;
    } #}}}

    return ;
} #}}}

# Subroutine: get_width
#
# Get a width, if it exists, from a line
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub get_width { #{{{2
    my $line = shift ;

    if ( $line =~ m{^width: (.*)} ) { #{{{3
        $Main::width = $1 ;
    } #}}}

    return ;
} #}}}

# Subroutine: handle_empty_links
#
#   Calculate a path to/from two linked rooms if there is no
#   explicit path in the just ended link/join block.
#
# Parameters:
#
#   scalar - line
#
# Returns:
#
#   nothing
#
# Output:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub handle_empty_links { #{{{2
    my $line = shift ;
    my $source = $Main::link_source ; 
    my $dest   = $Main::link_dest   ; 
    if (
            ( $line =~ m{^$} )
        and (       $source ne ""                 ) 
        and (       $dest ne ""                   ) 
        and ( $Main::previous_link_position eq "" )
        and ( $Main::second_link_position   eq "" )
        and ( $Main::link_go   eq "" )
    ) { #{{{3
        my $source_position = $Main::rooms{ $source }{ "position" } ;
        my $dest_position   = $Main::rooms{ $dest   }{ "position" } ;
        $Main::link_go =
            find_direction( $source_position, $dest_position ) ;
    } #}}}

    return ;
} #}}}

# Subroutine: ifm2raw
#
#   Calls ifm to convert ifm format files to ifm's raw format.
#
# Parameters:
#
#   scalar - path to ifm file
#
# Returns:
#
#   array - raw format file
#
# Output:
#
#   nothing
#
sub ifm2raw { #{{{2
    my $file_name = shift ;

    my $command = "ifm -w -m -i -f raw '$file_name'" ;
    my $raw_file = qx{$command} ;

    # Proceed only when ifm exits successfully.
    if ( $CHILD_ERROR ne "0" ) { #{{{3
        exiterr(
          'FATAL ERROR: ifm exited with one or more errors.' . $EOL
          . 'The command used to run ifm was:' . $EOL
          . "$command" . $EOL
        ) ;
    } #}}}
    else { #{{{3
        return( split( /$EOL/, $raw_file ) ) ;
    } #}}}

} #}}}

# Subroutine: increment_word
#
# Increment the number at the end of a word, or add "2" at the end if
# there is no existing number at the end of that word.
#
# Parameters:
#
#   scalar - word
#
# Returns:
#
#   word
#
# Output:
#
#   nothing
#
sub increment_word { #{{{2
    my $word = shift ;

    # Increment the number at the end, if there is one.
    # Otherwise, put the number "2" at the end.
    if ( $word =~ m{(\d+)$} ) { #{{{3
        # There's a number at the end.
        my $existing_number    = $1 ;
        my $incremented_number = $existing_number + 1 ;
        $word =~ s{(\d)$}{$incremented_number} ;
    } #}}}
    else { #{{{3
        # There's no number at the end.
        $word = $word . "2" ;
    } #}}}

    return $word ;
} #}}}

# Subroutine: main
#
# Main program
#
# Parameters:
#
#   scalar - none
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
sub main { #{{{2
    # Make sure ifm exists somewhere in $PATH and is executable
    check_ifm() ;

    # Get options from the command line
    my (
        $noexits,
        $input_file_name,
        $output_file_name,
    ) = get_options() ;

    # Set input and output filenames according to user's options,
    # or use the defaults.
    $input_file_name  = choose_input_file_name(  $input_file_name  ) ;
    $output_file_name = choose_output_file_name( $output_file_name ) ;

    # Make sure the input file exists (unless it's STDIN).
    file_exists( $input_file_name ) ;

    # Convert ifm format file to ifm's raw format.
    my @input_file = ifm2raw( $input_file_name ) ;

    # Unless the output should go to STDOUT: save the current
    # output filehandle, open the output file, and redirect STDOUT
    # to it.
    my ( $old_output_filehandle, $output_filehandle ) =
        open_output_file( $output_file_name ) ;

    # Convert the raw format input to internal data structures.
    my ( $rooms_ref, $links_ref, $regions_ref ) =
        raw2internal( @input_file ) ;

    # Time to print
    print_regions( $regions_ref           ) ;
    print_rooms(   $rooms_ref             ) ;
    print_links(   $links_ref, $rooms_ref ) ;
    print_exits(   $noexits               ) ;

    # Cleanup
    close_output_file( $output_filehandle, $old_output_filehandle ) ;

    return ;
} #}}}

# Subroutine: open_output_file
#
#   Redirect STDOUT to the output file.
#
# Parameters:
#
#   scalar - output file name
#
# Returns:
#
#   file handle - old file handle (save this to restore it later)
#
# Output:
#
#   nothing
#
sub open_output_file { #{{{2
    my $output_file_name = shift ;

    # Save STDOUT, to restore later, if needed.
    my $old_output_filehandle  = select ;

    my $output_filehandle = undef ;

    if ( $output_file_name ne "-" ) { #{{{3
        open( $output_filehandle, ">$output_file_name" ) or croak ;
        # Redirect stdout to $output_filehandle,
        select( $output_filehandle ) ;
    } #}}}
    else {
        # Do nothing
    } #}}}

    return ( $old_output_filehandle, $output_filehandle ) ;
} #}}}

# Subroutine: opposite_direction
#
# Return the opposite of the given direction.
#
# Parameters:
#
#   scalar - original direction
#
# Returns:
#
#   opposite direction
#
# Output:
#
#   Error if given an invalid direction.
#
sub opposite_direction { #{{{2
    my $original_direction = shift ;

    given ( $original_direction ) {
        when ( $NORTH     ) { return $SOUTH     }
        when ( $SOUTH     ) { return $NORTH     }
        when ( $EAST      ) { return $WEST      }
        when ( $WEST      ) { return $EAST      }
        when ( $NORTHEAST ) { return $SOUTHWEST }
        when ( $NORTHWEST ) { return $SOUTHEAST }
        when ( $SOUTHEAST ) { return $NORTHWEST }
        when ( $SOUTHWEST ) { return $NORTHEAST }
        when ( $UP        ) { return $DOWN      }
        when ( $DOWN      ) { return $UP        }
        when ( $IN        ) { return $OUT       }
        when ( $OUT       ) { return $IN        }
        default { croak( "FATAL ERROR:  Not a valid direction." ) }
    }
    return ;

} #}}}

# Subroutine: populate_links
#
# Populates %links and prints Inform 7 source code for
# the direction relation(s) between two rooms.
#
# Parameters:
#
#   none
#
# Returns:
#
#   nothing
#
# Output:
#
#   Inform 7 source code.
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub populate_links { #{{{2
    if ( ( defined $Main::link_source ) and
        ( $Main::link_source ne "" ) ) { #{{{3

        my $next_to_last_link_position =
            $Main::previous_link_position ;
        my $second_link_position =
            $Main::second_link_position ;

        my $source = $Main::link_source ;
        my $dest   = $Main::link_dest   ;
        my $go     = $Main::link_go     ;
        my $oneway = $Main::link_oneway ;

        # Populate oneway link
        $Main::links{ $source }{ $dest }{ "oneway" } = $oneway ;

        # Get the positions of the source and destination rooms
        my $source_position = $Main::rooms{ $source }{ "position" } ;
        my $dest_position   = $Main::rooms{ $dest   }{ "position" } ;

        # Find the directions from the source and to the
        # destintion, and vice versa.
        #
        # This is done either by using the link path, or using
        # a "go" direction.
        #
        # A "go" direction overrides the direction in the link
        # path, since (in the case that a go direction exists)
        # the direction in the link path is only used for the
        # ifm visual map, not the game map.
        my $direction_from_source = "" ;
        my $direction_from_dest   = "" ;
        my @directions = (
                            $NORTH,
                            $SOUTH,
                            $EAST,
                            $WEST,
                            $NORTHEAST,
                            $NORTHWEST,
                            $SOUTHEAST,
                            $SOUTHWEST,
                            $NORTHWEST,
                            $IN,
                            $OUT,
                            $UP,
                            $DOWN,
        ) ;

        # Intitialize any non-existing directions from source and
        # destination.
        foreach my $direction ( @directions ) { #{{{4
            my $source_direction =
                $Main::rooms{ $source }{ $direction } ;
            my $dest_direction =
                $Main::rooms{ $dest }{ $direction } ;

            # Don't clobber existing directions
            if ( not ( defined $source_direction ) )
            { #{{5
                # The value here tells us what lies in a given
                # direction from this room.
                $Main::rooms{ $source }{ $direction } = "nowhere" ;
            } #}}}
            if ( not ( defined $dest_direction ) )
            { #{{5
                # The value here tells us what lies in a given
                # direction from this room.
                $Main::rooms{ $dest   }{ $direction } = "nowhere" ;
            } #}}}
        } #}}}

        # Set $direction_from_source and $direction_from_destination
        # with $go overriding path links.
        if ( ( defined $go ) and ( $go ne "" ) ) { #{{{4
            # There is a go direction.
            $direction_from_source = $go ;
            $direction_from_dest   = opposite_direction( $direction_from_source ) ;
        } #}}}
        else { #{{{4
            # There is no go direction.
            $direction_from_source =
                find_direction( $source_position,
                                $second_link_position ) ;
            $direction_from_dest   =
                find_direction( $dest_position,
                                $next_to_last_link_position   ) ;
        } #}}}

        # Delete existing links from this room to another in
        # the same direction.
        my $conflicting_room =
            $Main::rooms{ $source }{ $direction_from_source } ;

        if ( ( $conflicting_room ne "nowhere" )
             and ( $conflicting_room ne $dest )
        ) { #{{{4
            # There's another room this room links to in
            # the same direction.

            # Get information we'll use to print a warning
            # about what we're doing.
            my $source_name      =
                $Main::rooms{ $source           }{ "name" } ;
            my $dest_name        =
                $Main::rooms{ $dest             }{ "name" } ;
            my $conflicting_name =
                $Main::rooms{ $conflicting_room }{ "name" } ;
            printerr( "[WARNING: "
                . "Instead of connecting "
                . "$source_name to $conflicting_name, "
                . "we are connecting "
                . "$source_name to $dest_name.]"
                . $EOL
            ) ;

            # Delete the offending link.
            delete $Main::links{ $source }{ $conflicting_room } ;
        } #}}}

        # Store the directions in source and destination rooms.
        $Main::rooms{ $source }{ $direction_from_source } = $dest   ; 

        # Only set the destination direction if this is not a oneway link.
        if ( $oneway eq "0" ) { #{{{4
            $Main::rooms{ $dest }{ $direction_from_dest } = $source ;
        } #}}}

        # Populate the rest of the link
        $Main::links{ $source }{ $dest }{ "go" } = $go ;
        $Main::links{ $source }{ $dest }{ "second_link_position" } =
            $Main::second_link_position  ;
        $Main::links{ $source }{ $dest }{ "next_to_last_link_position" } =
            $next_to_last_link_position ;
           
        # Reinitializing variables at the end of every region.
        $Main::link_source                 = ""      ;
        $Main::link_go                     = ""      ;
        $Main::link_dest                   = ""      ;
        $Main::link_oneway                 = "0"     ;
        $Main::current_link_position       = ""      ;
        $Main::previous_link_position      = ""      ;
        $Main::second_link_position        = ""      ;
        $Main::skipped_first_link_position = "false" ;
    } #}}}

    return ;
} #}}}

# Subroutine: populate_regions
#
# Populate %regions if we just exited a region block
# Then clear temporary region variables.
#
# Parameters:
#
#   none
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#   
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub populate_regions { #{{{2
    if ( $Main::region ne "" ) { #{{{3
        # Just exited a region block.
        $Main::regions{ "$Main::region" }{ "height" } =
            $Main::height ;
        $Main::regions{ "$Main::region" }{ "width"  } =
            $Main::width  ;
        $Main::height       = ""       ; 
        $Main::last_region = $Main::region ; 
        $Main::region      = ""       ; 
        $Main::width        = ""       ; 
    } #}}}

    return ;
} #}}}

# Subroutine: populate_rooms
#
# Populates %rooms and prints Inform 7 source code that
# creates a room and places it in a region.
#
# Parameters:
#
#   none
#
# Returns:
#
#   nothing
#
# Output:
#
#   Inform 7 source code.
#
# NOTE:
#
#   This subroutine directly modifies variables in <raw2internal>
#
sub populate_rooms { #{{{2
    if ( $Main::room_number ne "" ) { #{{{3
        # Make sure room name is unique
        if ( exists $Main::room_names{ $Main::room_name } ) { #{{{4
            # This is not a unique room name, so make it unique
            my $unique_room_name = increment_word( $Main::room_name );
            printerr( "[WARNING: Renaming a room called " .
                      "'$Main::room_name' " .
                      "to '$unique_room_name', for uniqueness.]" .
                      $EOL
            ) ;
            $Main::room_name = $unique_room_name ;
        } #}}}

        # Make an entry in %Main::room_names for this room.
        $Main::room_names{ $Main::room_name } = "" ;

        $Main::rooms{ "$Main::room_number" }{ "name"     } =
            $Main::room_name     ; 
        $Main::rooms{ "$Main::room_number" }{ "position" } =
            $Main::room_position ; 
        $Main::rooms{ "$Main::room_number" }{ "region"   } =
            $Main::last_region  ; 
        $Main::room_name     = "" ;
        $Main::room_number   = "" ;
        $Main::room_position = "" ;
    } #}}}

    return ;
} #}}}

# Subroutine: printerr
#
# Print to STDERR.  Only print warnings if $NOWARNINGS is false.
#
# Parameters:
#
#   scalar - message to print
#
# Returns:
#
#   nothing
#
# Output:
#
#   message on STDERR
#
sub printerr { #{{{2
    my ( $message, @IGNORED ) = @_ ;

    if ( $NOWARNINGS eq "false" ) { #{{{3
        print {*STDERR} $message ;
    } #}}}
    else { #{{{3
        if ( not ( $message =~ m{^\[WARNING: } ) ) { #{{{4
            print {*STDERR} $message ;
        } #}}}
    } #}}}
    return ;
} #}}}

# Subroutine: print_exits
#
#   Prints Inform 7 source code for putting all possible exits
#   from a room on to the status line.  This is very useful for
#   debugging maps.
#
# Parameters:
#
#   scalar - boolean value that controls whether to print the
#            exits code or not.
#
# Returns:
#
#   nothing
#
# Output:
#
#   Inform 7 source code.
#
sub print_exits { #{{{2
    my $noexits = shift ;

    if ( $noexits ) { #{{{3
        # Do nothing
    } #}}}
    else { #{{{3
        print $EXITS_CODE ;
    } #}}}

    return ;

} #}}}

# Subroutine: print_links
#
#   Print Inform 7 source code for every link in %links
#
# Parameters:
#
#   reference - to %links
#   reference - to %rooms
#
# Returns:
#
#   nothing
#
# Output:
#
#   Inform 7 source code for every link
#
sub print_links { #{{{2
    my $links_ref = shift ;
    my $rooms_ref = shift ;

    my %links = %{ $links_ref } ;
    my %rooms = %{ $rooms_ref } ;

    # Go through every link
    foreach my $source ( keys ( %links ) ) { #{{{3
        foreach my $dest ( keys ( %{ $links{ $source } } ) ) { #{{{3
            my $direction_from_source = "" ;
            my $direction_from_dest   = "" ;

            # Get the names of the source and destination rooms
            my $source_name = $rooms{ $source }{ "name" } ;
            my $dest_name   = $rooms{ $dest   }{ "name" } ;

            # Get the positions of the source and destination rooms
            my $source_position = $rooms{ $source }{ "position" } ;
            my $dest_position   = $rooms{ $dest   }{ "position" } ;

            # Find out which way we should go to get from the source
            # to the destination.
            my $go = $links{ $source }{ $dest }{ "go" } ;

            # Find out if this is a oneway link
            my $oneway = $links{ $source }{ $dest }{ "oneway" } ;

            # Get the positions of map locations on the link path
            # that are closest to the source and destination rooms.
            my $second_link_position =
                $links{ $source }{ $dest }{ "second_link_position" } ;
            my $next_to_last_link_position =
                $links{ $source }{ $dest }{ "next_to_last_link_position" } ;

            # Find the directions from the source and to the
            # destintion, and vice versa.
            #
            # This is done either by using the link path, or using
            # a "go" direction.
            #
            # A "go" direction overrides the direction in the link
            # path, since (in the case that a go direction exists)
            # the direction in the link path only used for the
            # visual map, not the game map.
            if ( ( defined $go ) and ( $go ne "" ) ) { #{{{4
                # There is a go direction.
                $direction_from_source = $go ;
                $direction_from_dest   = opposite_direction( $direction_from_source ) ;
            } #}}}
            else { #{{{4
                # There is no go direction.
                $direction_from_source =
                    find_direction( $source_position,
                                    $second_link_position ) ;
                $direction_from_dest   =
                    find_direction( $dest_position,
                                    $next_to_last_link_position   ) ;
            } #}}}

            #### $source
            #### $dest
            #### $source_name
            #### $dest_name
            #### $second_link_position
            #### $next_to_last_link_position
            #### $go
            #### $source_position
            #### $dest_position
            #### $direction_from_source
            #### $direction_from_dest

            # Inform 7 code
            print "$direction_from_source from $source_name " ;
            print "is $dest_name." ;
            print "$EOL" . "$EOL"  ;

            if ( are_opposite_directions(
                    $direction_from_source,
                    $direction_from_dest ) eq $TRUE
               ) { #{{{4
                # These are opposite directions.

                # Check to see if the link has been explicitly
                # specified as being one-way
                if (
                     ( defined $oneway )
                     and ( $oneway eq "1" )
                ) { #{{{5
                    # This link has been explicitly specified
                    # to be a one-way link.

                    # We'll need to check if the opposite directions
                    # from both the source and destination lead
                    # nowhere, and print Inform 7 code for them.

                    # First, make a note of the opposite directions
                    my $opposite_direction_from_source =
                        opposite_direction( $direction_from_source ) ;

                    # Print out Inform 7 code for the opposite
                    # direction that leads nowhere from the
                    # destination.
                    if ( $rooms{ $dest }{
                        $opposite_direction_from_source
                                          } eq "nowhere" )
                    { #{{{6
                        print "$opposite_direction_from_source" ;
                        print " from $dest_name is nowhere." ;
                        print "$EOL" . $EOL ;
                    } #}}}
                } #}}}
                else { #{{{5
                    # This link has not been explicitly specified
                    # to be a one-way link.
                    #
                    # So assume this to be a regular two-way link,
                    # which needs no return direction to be printed.
                } #}}}
            } #}}}
            else { #{{{4
                if (
                     ( defined $oneway )
                     and ( $oneway eq "1" )
                ) { #{{{5
                    # This link has been explicitly specified
                    # to be a one-way link.

                    # We'll need to check if the opposite directions
                    # from both the source and destination lead
                    # nowhere, and print Inform 7 code for them.

                    # First, make a note of the opposite directions
                    my $opposite_direction_from_source =
                        opposite_direction( $direction_from_source ) ;

                    # Print out Inform 7 code for the opposite
                    # direction that leads nowhere from the
                    # destination.
                    if ( $rooms{ $dest }{
                        $opposite_direction_from_source
                                          } eq "nowhere" )
                    { #{{{6
                        print "$opposite_direction_from_source" ;
                        print " from $dest_name is nowhere." ;
                        print "$EOL" . $EOL ;
                    } #}}}
                } #}}}
                else { #{{{5
                    # This link has not been explicitly specified
                    # to be a one-way link.

                    # These are not opposite directions, so we also
                    # need to print another direction.
                    print "$direction_from_dest from $dest_name " ;
                    print "is $source_name." ;
                    print "$EOL" . "$EOL" ;

                    # These are not regular two-way connections, so
                    # we'll need to check if the opposite directions
                    # from both the source and destination lead
                    # nowhere, and print Inform 7 code for them.

                    # First, make a note of the opposite directions
                    my $opposite_direction_from_dest =
                        opposite_direction( $direction_from_dest ) ;
                    my $opposite_direction_from_source =
                        opposite_direction( $direction_from_source ) ;

                    # Print out Inform 7 code for the opposite
                    # direction that leads nowhere from the source.
                    if ( $rooms{ $source }{
                        $opposite_direction_from_dest
                                          } eq "nowhere" )
                    { #{{{6
                        print "$opposite_direction_from_dest" ;
                        print " from $source_name is nowhere." ;
                        print "$EOL" . $EOL ;
                    } #}}}

                    # Print out Inform 7 code for the opposite
                    # direction that leads nowhere from the
                    # destination.
                    if ( $rooms{ $dest }{
                        $opposite_direction_from_source
                                          } eq "nowhere" )
                    { #{{{6
                        print "$opposite_direction_from_source" ;
                        print " from $dest_name is nowhere." ;
                        print "$EOL" . $EOL ;
                    } #}}}
                } #}}}
            } #}}}
        } #}}}
    } #}}}

    return ;
} #}}}

# Subroutine: print_regions
#
#   Print Inform 7 source code for every region in %regions
#
# Parameters:
#
#   reference - to %regions
#
# Returns:
#
#   nothing
#
# Output:
#
#   Inform 7 source code for every region.
#
sub print_regions { #{{{2
    my $regions_ref = shift ;

    foreach my $region ( keys %{ $regions_ref } ) { #{{{3
        print "$region is a region." . $EOL . $EOL ;
    } #}}}

    return ;
} #}}}

# Subroutine: print_rooms
#
# Print rooms
#
sub print_rooms { #{{{2
    my $rooms_ref = shift ;

    if ( not ( defined %$rooms_ref ) ) { #{{{3
        exiterr(
            "FATAL ERROR:  Could not find any rooms in ifm file." .
            $EOL
        ) ;
    } #}}}

    my %rooms = %{ $rooms_ref } ;

    foreach my $room_number ( sort ( keys %rooms ) ) { #{{{
        my $room_name = $rooms{ $room_number }{ "name" } ;
        my $region    = $rooms{ $room_number }{ "region" } ;
        print "A room called $room_name is in $region."
            . $EOL . $EOL ;
    } #}}}
    
    return ;
} #}}}

# Subroutine: raw2internal
#
# Read raw format in to internal format
#
# Parameters:
#
#   array - lines from input file
#
# Returns:
#
#   nothing
#
# Output:
#
#   nothing
#
# NOTE:
#
#   The lines fed to this routine must be in the raw format
#   generated by IFM.
#
sub raw2internal { #{{{2
    my @input_file = @_ ; 

    # Using local instead of my variables so that the script
    # won't have to pass around a ton of my variables back and
    # forth.  This makes the script a bit more prone to programming
    # errors, but also makes it much easier to read.  Just keep
    # in mind that all the following variables are global within
    # the scope of raw2internal() and all the subroutines it calls.
    #
    # Also,keep in mind that all these variables will have to
    # be explicitly referenced by packagname, which is Main.
    local $Main::height        = ""  ; 
    local $Main::last_region   = ""  ; 
    local $Main::link_source   = ""  ; 
    local $Main::link_go       = ""  ; 
    local $Main::link_dest     = ""  ; 
    local $Main::link_oneway   = "0" ; 
    local %Main::links         = ()  ; 
    local $Main::room_name     = ""  ; 
    local %Main::room_names    = ()  ; 
    local $Main::room_number   = ""  ; 
    local $Main::room_position = ""  ; 
    local %Main::rooms         = ()  ; 
    local $Main::region        = ""  ; 
    local %Main::regions       = ()  ; 
    local $Main::title         = ""  ; 
    local $Main::width         = ""  ; 

    # Only the second and last links are useful for
    # telling which direction a link is going to/from in.
    #
    # So in order to know if we're on the second or later link
    # position, we're going to keep track of whether we've skipped
    # the first link position.

    local $Main::skipped_first_link_position = "false" ;
    local $Main::current_link_position       = ""      ;
    local $Main::previous_link_position      = ""      ;
    local $Main::second_link_position        = ""      ;

    # The next two variables are used to make sure that the
    # correct attributes are read from the correct blocks,
    # as in ifm's raw format a line starting with "room:", for
    # example, can be part of a room block and an item block,
    # and we don't want to get the two mixed up.
    local $Main::in_block      = "false" ;
    local $Main::in_link_block = "false" ;
    local $Main::in_room_block = "false" ;

    LINE_READ:
    foreach my $line ( @input_file ) { #{{{3
        get_title(         $ line ) ;
        get_region(        $ line ) ;
        get_height(        $ line ) ;
        get_width(         $ line ) ;
        get_room_number(   $ line ) ;
        get_room_name(     $ line ) ;
        get_room_position( $ line ) ;
        get_item(          $ line ) ;
        get_task(          $ line ) ;
        get_link_and_join( $ line ) ;
        get_link_go(       $ line ) ;
        get_link_oneway(   $ line ) ;
        get_link_position( $ line ) ;
        handle_empty_links($ line ) ;
        # Blank lines indicate the end of a block.
        if ( $line =~ m{^$} ) { #{{{4
            $Main::in_block      = "false" ;
            $Main::in_link_block = "false" ;
            $Main::in_room_block = "false" ;
            populate_regions()  ;
            populate_rooms()    ;
            populate_links()    ;
        } #}}}
    } #}}}

    populate_regions()  ;
    populate_rooms()    ;
    populate_links()    ;

    return( \%Main::rooms, \%Main::links, \%Main::regions ) ;
} #}}}

# Subroutine: usage
#
# Print usage
#
# Parameters:
#
#   none
#
# Returns:
#
#   none
#
# Output:
#
#   Usage information on STDERR
#
sub usage { #{{{2
    printerr( $USAGE ) ;
    return ;
} #}}}

# Subroutine: verbosity_handler
#
#   Handle --verbosity options
#
# Parameters:
#
#   scalar - verbosity option setting
#
# Returns:
#
#   nothing
#
# Output:
#
#   Error if an invalid verbosity setting has been used.
#
sub verbosity_handler { #{{{2
    my $verbosity = shift ;
    given ( $verbosity ) { #{{{3
        when "silent" { enable_silence() } 
        when "quiet"  { enable_quiet()   } 
        when "normal" {                  } # Do nothing
        when "debug"  { enable_debug()   } 
        when ""       {                  } # Do nothing
        default { #{{{4
            exiterr(
                "FATAL ERROR: '$verbosity' is not a valid " .
                "setting for the --verbosity option" . $EOL
            ) ;
        } #}}}
    } #}}}

    return ;
} #}}}
#--------------
#
# END - Subroutines                                             }}}
#
#-------------------------------------------------------------------

main ;
