# Tool to create IFM maps from ASCII art maps. Intended to be an easy

#!/usr/bin/perl -w
# Tool to create IFM maps from ASCII art maps. Intended to be an easy
# way to draw a map and have it converted to IFM format.
#
# Use "asciimapper -t -i -o template.art" to generate a blank template.
# The -t option specifies a template should be made.
# The -i option specifies it should include instructions in comments.
# The -o option specifies the output file (stdout would be used otherwise).
# A -x ROWS,COLS option can be used to specify the size of the template.
#
# Use "asciimapper -k -i template.art" to generate a key file for a map.
# The input template may be filled in or blank. The output file will be
# "template.key"
# The -t option specifies a template should be made.
# The -i option specifies it should include instructions in comments.
#
# Use "asciimapper -g 4 template.art" to enlarge (grow) a map by 4 squares
# in all directions. Or use any combination of [NSEW]{num} in one string
# to more finely tune the growth. If "template.key" is found, it will be
# enlarged as well.
#
# Use "asciimapper -m template.art" to generate an IFM map from the art
# file, the "template.key" file (if found) and save it to "template.ifm".
#
# Use "asciimapper -d demo.art" to generate a demo ASCII art map, from
# which a key file will be made and filled in, then an IFM map will be
# generated. Template mode, key mode, and generation mode options will
# be honored.
#
# This was written to work with IFM 5.1. Other versions may or may not work.
#
# Get IFM: http://www.ifarchive.org/indexes/if-archiveXmapping-tools.html
#
# 23 June 2005 Eli the Bearded [email protected]
use strict;
use vars qw( $o_include $o_mode $o_out $o_file $o_rows $o_cols $o_verbose
$o_preserve $o_inup $o_size $o_demo $o_n $o_e $o_s $o_w $nokey
$title $r $c $sr $sc
@map @rooms %names %tasks %items %styles @key @seen %links
$id $VERSION $LONG_VERSION_INFO
);

$id = $0;
$id =~ s:.*/::;
$VERSION = "1.0.1";
$LONG_VERSION_INFO = "Revised initial release";

$o_rows = 10;
$o_cols = 20;
$o_size = 1;
$o_inup = 'in';
$o_n = $o_e = $o_s = $o_w = 0;

sub dotemplate();
sub dokeytemplate($);
sub dogrowth();
sub dodemo();
sub readfiles($);
sub tagrooms();
sub makeifm($$$$);
sub findexits($$);
sub usage($);

while(defined($ARGV[0]) and substr($ARGV[0], 0, 1) eq '-') {
if (($ARGV[0] eq '-t') or ($ARGV[0] eq '--template')) {
shift;
$o_mode = 't';
} elsif (($ARGV[0] eq '-k') or ($ARGV[0] eq '--key')) {
shift;
$o_mode = 'k';
} elsif (($ARGV[0] eq '-m') or ($ARGV[0] eq '--makemap')) {
shift;
$o_mode = 'm';
} elsif (($ARGV[0] eq '-g') or ($ARGV[0] eq '--grow')) {
shift;
$o_mode = 'g';
if($ARGV[0] =~ /^\s*([1-9]\d*)\s*$/) {
$o_n = $o_e = $o_s = $o_w = $1;
} elsif ($ARGV[0] =~ /^\s*((?:[nesw]\d+,?)+)\s*$/i) {
$_ = $1;
if(s/n(\d+)//i) { $o_n = $1; }
if(s/e(\d+)//i) { $o_e = $1; }
if(s/s(\d+)//i) { $o_s = $1; }
if(s/w(\d+)//i) { $o_w = $1; }
} else {
print STDERR "$id: -g (--grow) requires a growth size\n";
usage(2);
}
shift;
} elsif (($ARGV[0] eq '-d') or ($ARGV[0] eq '--demo')) {
shift;
$o_mode = 'd';
$o_demo = 1;
} elsif (($ARGV[0] eq '-i') or ($ARGV[0] eq '--include')) {
shift;
$o_include = 1;
} elsif (($ARGV[0] eq '-p') or ($ARGV[0] eq '--preserve')) {
shift;
$o_preserve = 1;
} elsif (($ARGV[0] eq '-u') or ($ARGV[0] eq '--updown')) {
shift;
$o_inup = 'up';
} elsif (($ARGV[0] eq '-s') or ($ARGV[0] eq '--size')) {
shift;
if($ARGV[0] =~ /^\s*([1-9]\d*)\s*$/) {
$o_size= $1;
shift;
} else {
print STDERR "$id: -s (--size) requires a positive number\n";
usage(2);
}
} elsif (($ARGV[0] eq '-x') or ($ARGV[0] eq '--rowsxcols')) {
shift;
if($ARGV[0] =~ /^\s*([1-9]\d*)\s*[Xx,]\s*([1-9]\d*)\s*$/) {
$o_rows = $1;
$o_cols = $2;
shift;
} else {
print STDERR "$id: -x (--rowsxcols) requires a pair of positive numbers\n";
usage(2);
}
} elsif (($ARGV[0] eq '-o') or ($ARGV[0] eq '--out')) {
shift;
$o_out = shift;
if (!defined($o_out)) {
print STDERR "$id: -o (--out) requires an output file\n";
usage(2);
}
} elsif (($ARGV[0] eq '-v') or ($ARGV[0] eq '--verbose')) {
shift;
$o_verbose = 1;
} elsif ($ARGV[0] eq '--version') {
print "$0 version $VERSION -- $LONG_VERSION_INFO\n";
print "by Eli the Bearded / Benjamin Elijah Griffin\n";
exit(0);
} elsif ($ARGV[0] eq '--help') {
&usage(0);
} else {
print STDERR "$0: $ARGV[0] not a recognized option\n";
&usage(2);
}
}

$o_file = shift;

# Key mode does not use $o_out at all, so try it before creating $o_out
if($o_mode eq 'k') {
if(!defined($o_file)) {
die "$id: No input file specified\n";
} elsif ($o_verbose) {
print STDERR "Key template mode for $o_file\n";
}
dokeytemplate($o_file);
exit;
}

if(defined($o_out)) {
if(!open(STDOUT, "> $o_out")) {
die "$id: cannot open $o_out for output: $!\n";
} elsif ($o_verbose) {
print STDERR "Opened $o_out for output\n";
}
}

if($o_mode eq 't') {
if($o_verbose) {
print STDERR "Template creation mode\n";
}
dotemplate();
exit;
}

if($o_mode eq 'g') {
if($o_verbose) {
print STDERR "Template growth mode: N$o_n,E$o_e,S$o_s,W$o_w\n";
}
dogrowth();
exit;
}

if($o_mode eq 'd') {
if($o_verbose) {
print STDERR "Demonstration mode\n";
}
dodemo();
$o_mode = 'm';
}

if($o_mode eq 'm') {
if($o_verbose) {
print STDERR "IFM map creation mode\n";
}
# readfiles might also open an outfile
readfiles($o_file);

# Gives rooms unique tags based on map co-ordinates,
# sets $r and $c to the map size row & col
# sets $sr and $sc to the starting room row & col
# initializes @seen
tagrooms();

if($o_verbose) {
print STDERR "Map starting from room at $sr,$sc\n";
}
# from-tag,direction,current-row,current-col
makeifm( '', '', $sr, $sc);
exit;
}

die "$id: fell through modeselect if()s\n";

#####################################################################
# Functions follow

#####################################################################
# This recursive function is the heart of the mapping process.
# Don't be surprised to get deep recursion warnings on large maps,
# eg an 8x8 chess board.
#
# Reads and writes @seen to know when to print a new room or merely link
# to it.
#
# Reads and writes %links to know if a particular link has been processed,
# in either direction, previously. If all links from a room have been
# processed, we recurse no further for that room.
#
# Reads from @rooms, @key, %names, %items, %tasks, and %styles to
# know what to print with a room. (Calls findexits() which reads @map.)
#
# Return value should be ignored.
sub makeifm($$$$) {
my $from = shift; # previous room tag
my $dir = shift; # direction we entered
my $rr = shift; # room row
my $rc = shift; # room col
my @exits = findexits($rr,$rc);
my $exit;
my $tag = $rooms[$rr][$rc];
my $key = $key[$rr][$rc];
my $name;
my $item;
my $task;
my $style;
my $new;

if(length($key) and $key =~ /\S/) {
$key =~ s/\s+//g;
$name = defined($names{$key} ) ? $names{$key} : '';
$item = defined($items{$key} ) ? $items{$key} : '';
$task = defined($tasks{$key} ) ? $tasks{$key} : '';
$style = defined($styles{$key}) ? $styles{$key} : '';
}

if(!$seen[$rr][$rc]) {
$dir ||= '';

if($dir) {
# $dir at this point is either a bare direction (eg "n", "sw")
# or a direction and a go clause (eg "n go up", "s go down").
# The "go up" (etc) clause must appear after the "from ROOM"
# clause. The double parens avoid $2 being uninitialized.
$dir =~ s/(\w+)\s*((?:go\s+\w+)?)/dir $1 from $from $2/;
}

if($tag =~ /\S/) {
if($from) {
$links{"$tag:$from"} = $links{"$from:$tag"} = 1;
}
$tag =~ s/^/tag /;
}

if($style =~ /\S/) {
$style =~ s/^/style /;
}

if($o_verbose) {
print STDERR "adding room $name $dir " .
($tag? $tag : "($rr,$rc)" ) .
" $style\n";
}

print qq(room "$name" $dir $tag $style;\n);

if($item =~ /\S/) {
$item =~ s/^/ item "/;
$item =~ s/$/";\n/;
$item =~ s/,/";\n item "/g;
print $item;
}

if($task =~ /\S/) {
$task =~ s/^/ task "/;
$task =~ s/$/";\n/;
$task =~ s/;([^\n])/";\n task "$1/g;
print $task;
}

print "\n";

$seen[$rr][$rc] = 1;
} else {
# seen this room, just add a link to it
if(($from =~ /\S/) and ($tag =~ /\S/)) {
if($o_verbose) {
print STDERR "adding link $from, $tag, $dir\n";
}

$links{"$tag:$from"} = $links{"$from:$tag"} = 1;
print "link $from to $tag dir $dir;\n\n";
}

# No good reason to increment at this time, but...
$seen[$rr][$rc] ++;
}

$tag = $rooms[$rr][$rc];
if($tag !~ /^\s*$/) {
for $exit (@exits) {
$new = $rooms[$$exit[1]][$$exit[2]];
if(!$links{"$tag:$new"}) {
if($o_verbose) {
print STDERR "recursing: $tag, $$exit[0], $$exit[1], $$exit[2]\n";
}
makeifm($tag, $$exit[0], $$exit[1], $$exit[2]);
}
} # for exit
} # if tag

} # end &makeifm

#####################################################################
# Called by the recursive makeifm() function, this reads from @map
# to find and give the proper names to all exits from a room,
# returning an array of arrays:
# [ [ exit-name, new-room-row, new-room-col ],
# ...
# ]
sub findexits($$) {
my $rr = shift; # room row
my $rc = shift; # room col
my @out;

if(!defined($rr) or !defined($rc) or ($rr < 0) or ($rc < 0)) {
die "$id: room co-ordinates out of bounds!\n";
}

my $mr = 1+2*$rr; # map row
my $mc = 1+2*$rc; # map col
my $go1;
my $go2;

if($o_inup eq 'in') {
$go1 = 'go in';
$go2 = 'go out';
} else {
$go1 = 'go up';
$go2 = 'go down';
}

# Search around $mr,$mc in the map file for exit paths, different
# co-ordinates have different exit markers:
# ($mr-1,$mc-1)[\xX] ($mr-1,$mc)[|^vV] ($mr-1,$mc+1)[/xX]
# ( $mr,$mc-1)[-<>] ( $mr,$mc)[#*] ( $mr,$mc+1)[-<>]
# ($mr+1,$mc-1)[/xX] ($mr+1,$mc)[|^vV] ($mr+1,$mc+1)[\xX]
# There are eight 2-d directions possible, but twenty "real"
# directions.

my $n = lc($map[$mr-1][$mc]);
my $ne = lc($map[$mr-1][$mc+1]);
my $e = $map[$mr][$mc+1];
my $se = lc($map[$mr+1][$mc+1]);
my $s = lc($map[$mr+1][$mc]);
my $sw = lc($map[$mr+1][$mc-1]);
my $w = $map[$mr][$mc-1];
my $nw = lc($map[$mr-1][$mc-1]);

if($n eq '|') { push(@out, ["n", $rr-1, $rc]); }
if($n eq '^') { push(@out, ["n $go1", $rr-1, $rc]); }
if($n eq 'v') { push(@out, ["n $go2", $rr-1, $rc]); }

if($ne eq '/') { push(@out, ["ne", $rr-1, $rc+1]); }
if($ne eq 'x') { push(@out, ["ne", $rr-1, $rc+1]); }

if($e eq '-') { push(@out, ["e", $rr, $rc+1]); }
if($e eq '>') { push(@out, ["e $go1", $rr, $rc+1]); }
if($e eq '<') { push(@out, ["e $go2", $rr, $rc+1]); }

if($se eq '\\'){ push(@out, ["se", $rr+1, $rc+1]); }
if($se eq 'x') { push(@out, ["se", $rr+1, $rc+1]); }

if($s eq '|') { push(@out, ["s", $rr+1, $rc]); }
if($s eq 'v') { push(@out, ["s $go1", $rr+1, $rc]); }
if($s eq '^') { push(@out, ["s $go2", $rr+1, $rc]); }

if($sw eq '/') { push(@out, ["sw", $rr+1, $rc-1]); }
if($sw eq 'x') { push(@out, ["sw", $rr+1, $rc-1]); }

if($w eq '-') { push(@out, ["w", $rr, $rc-1]); }
if($w eq '<') { push(@out, ["w $go1", $rr, $rc-1]); }
if($w eq '>') { push(@out, ["w $go2", $rr, $rc-1]); }

if($nw eq '\\'){ push(@out, ["nw", $rr-1, $rc-1]); }
if($nw eq 'x') { push(@out, ["nw", $rr-1, $rc-1]); }

if($o_verbose) {
my $i;
my $exits = "Exit(s) for $rr,$rc: ";
for ($i = 0; $i < @out; $i++) {
$exits .= $out[$i][0] . ",";
}
$exits =~ s/.$/\n/;
print STDERR $exits;
print STDERR "[$nw,$n,$ne],[$w,".$map[$mr][$mc].",$e],[$sw,$s,$se]\n";
}
@out;
} # end &findexits

#####################################################################
# Gives rooms unique tags based on map co-ordinates,
# sets $r and $c to the map size row & col
# sets $sr and $sc to the starting room row & col
# checks @key dimensions
# initializes @seen
# Exits the program if any errors are found.
sub tagrooms() {
my $i;
my $j;

local $";
$" = ',';

$r = 1 + $#rooms;
$c = 1 + $#{$rooms[0]};

if($o_verbose) {
print STDERR "Naming rooms, grid size ${r}x$c\n";
}

if(!$nokey and $r-1 != $#key) {
die "$id: key map is not $r rows\n";
}

for($i = 0; $i < $r; $i ++) {
if($c-1 != $#{$rooms[$i]}) {
die "$id: room row $i is not $c long\n";
}
if(!$nokey and $c-1 != $#{$key[$i]}) {
die "$id: key map room row $i is not $c long\n";
}

for($j = 0; $j < $c; $j ++) {
$seen[$i][$j] = '';

if($rooms[$i][$j] eq ' ') {
next;
}

if($rooms[$i][$j] eq '*') {
if(!defined($sr)) {
$sr = $i;
$sc = $j;
} else {
die "$id: Found a second start room ($i,$j), first at $sr,$sc.\n" .
"Only one start room is allowed.\n";
}
}

$rooms[$i][$j] = "R${i}C$j";
} # for $j

if($o_verbose) {
print STDERR "@{$rooms[$i]}\n";
}
} # for $i

} # end &tagrooms

#####################################################################
# Reads files prior to making a map. From one input file (the map art
# file) probes for the associated key file.
# Initializes @map, @key, %names, %items, %tasks, %styles.
# Opens the output file and starts writing to it.
# Exits the program if any errors are found.
sub readfiles($) {
my $in = shift;
my $key;
my $line;
my $name;
my $value;
my $type;
my $data;
my $seen_title;

local $";
$" = ',';

if(defined($in) and $in ne '-') {
if(!open(STDIN, "< $in")) {
die "$id: cannot open $in for reading: $!\n";
} elsif ($o_verbose) {
print STDERR "Reading map from $in\n";
}

$key = $in;

$key =~ s/([.]art$|$)/.key/i;

if(-f $key) {
if(!open(KEY, "< $key")) {
die "$id: cannot open $key for reading: $!\n";
} elsif($o_verbose) {
print STDERR "Will read key data from $key\n";
}
} else {
$key = undef;
$nokey = 1;
}

if(!defined($o_out)) {
$o_out = $in;
$o_out =~ s/([.]art$|$)/.ifm/i;
if(!open(STDOUT, "> $o_out")) {
die "$id: cannot open $o_out for output: $!\n";
} elsif ($o_verbose) {
print STDERR "Writing to $o_out\n";
}
}
} elsif($o_verbose) {
print STDERR "Using stdin for input.\n";
if(!defined($o_out)) {
print STDERR "Using stdout for output.\n";
}
}

if($o_verbose) {
print STDERR "Starting on the art file\n";
}

while(<STDIN>) {
if($o_preserve and /^:/) {
s/^:/#/;
print;
next;
} elsif (/^:/) {
next;
}

chomp;

if(!$seen_title) {
$seen_title = 1;
if ($o_verbose) {
print STDERR "Map title: $_\n";
if($o_preserve) {
print STDERR "Preserving any source comments\n";
}
}

print qq(title "$_";\n\n);

next;
}

if($_ eq '') {
next;
}

push(@map,[split(//, $_)]);
if($#map % 2) {
# odd lines have rooms
s:^[-|xXvV^/\\<>.]::;
s:\G([#* ])[-|xXvV^/\\<>.]:$1:g;

if(!/^[#* ]+/) {
die "$id: Syntax error line $., found a non-room char when expecting".
" a room\nPartially processed line: $_\n";
}

push(@rooms,[split(//, $_)]);
if($o_verbose) {
print STDERR "@{$rooms[-1]}\n";
}

} else {
# even lines have connections only
if(!m:^[-|xXvV^/\\<>.]+$:) {
die "$id: Syntax error line $., found a non-connecting char when".
" expecting a connecting char\nLine: $_\n";
}

}
} # while STDIN

if(defined($key)) {
$line = 1;

if($o_verbose) {
print STDERR "Starting on the key file\n";
}

while(<KEY>) {
if($o_preserve and /^:/) {
s/^:/#/;
print;
next;
} elsif (/^:/) {
next;
}

chomp;

if($_ eq '') {
next;
}

if(/^(\S+):\s*(.+)/) {
# key explanation line
$name = $1;
$value = $2;

# Global style stuff should apper before all the room declarations.
if($name eq 'OVERALL') {
# blank is allowed
$value =~ s/style\s*\{(.*)\}/$1\n/;
print $value;
}

while($value =~ /\G\s* # anchor and optional space
(name|item|task|style) # type of data
\s*\{ # space and open brace
( (?: [^{}\\]+ # non brace or backslash
| \\[{}\\] # escaped brace or backslash
)* ) # zero or more either above
\} # close brace
/xg # extended format, global
) {

$type = $1;
$data = $2;

if($data =~ /^\s*$/) {
# blank is a non-statement
next;
}

# The different types have different rules for multiple
# appearances.

if($type eq 'name') {
# Multiseen: Last value wins
$names{$name} = $data;
}

if($type eq 'item') {
# Multiseen: concatenate with comma
if(defined($items{$name})) {
$items{$name} .= ",$data";
} else {
$items{$name} .= $data;
}
}

if($type eq 'task') {
# Multiseen: concatenate with semicolon
if(defined($tasks{$name})) {
$tasks{$name} .= ";$data";
} else {
$tasks{$name} .= $data;
}
}

if($type eq 'style') {
# Multiseen: Last value wins
$styles{$name} = $data;
}

} # while processing values
next;
}

# Not blank, not key explanation, not comment. Must be the map.

$line ++;
if($line % 2) {
# odd lines have rooms

s:^[.]::;
s:[.]$::;

push(@key,[split(/[.]/, $_)]);
if($o_verbose) {
print STDERR "@{$key[-1]}\n";
}

} else {
# even lines have connections only
if(!m:^[.]+$:) {
die "$id: Syntax error $name line $., expected a line of periods,".
" got:\n$_\n";
}
}
} # while KEY
close KEY;
} # if name
elsif ($o_verbose) {
print STDERR "No key file\n";
}

} # end &readfiles

#####################################################################
# Print a map template, with or without the instruction comments.
# Output is to the default filehandle, the main program sets that up.
# Return value should be ignored.
sub dotemplate() {
my $i;
my $block;

print "Map Title\n";
if($o_include) {
if($o_verbose) {
print STDERR "Including instruction comments.\n";
}
print <<IncludeBit;
: Art file syntax
: The first line is used as the map title. Don't use quotes in it.
: Comments are lines that begin with a colon. Comments cannot start mid-line.
: There are several recognized file types, but the most important one has
: the .art suffix. It is the ASCII art file that defines where the rooms are
: and how they are connected. It is a grid of spaces surrounded by periods
: initially. The spaces are grid squares where a room can be. The periods are
: places for room connectors. All rooms should be connected somehow.
: The other files have .name, .item, .task suffixes, and correspond to the
: room names, items, and tasks. These are space and period grids as well,
: but do not have the room connectors, and room contents are not limited to
: single characters. This makes these files hard to visualize. The best way
: create one is to use a .art file and replace the rooms starting with the
: lower right (southeast) and working up and left (northeast).
: Character Meaning
: space no room there
: * start room (must be exactly one)
: # other rooms
: . no connection
: - connect rooms west-east
: | connect rooms north-south
: \\ connect rooms northwest-southeast
: / connect rooms northeast-southwest
: X or x connect two pairs of rooms nw-se and ne-sw
: ^ connect two rooms in-out, laid out north-south
: v or V connect two rooms out-in, laid out south-north
: < connect two rooms in-out, laid out west-east
: > connect two rooms out-in, laid out east-west
IncludeBit
}

$block = (".." x $o_cols) . ".\n" . (". " x $o_cols) . ".\n";
for ($i = 0; $i < $o_rows; $i ++) {
print $block;
}
print ".." x $o_cols . ".\n";

} # end &dotemplate

#####################################################################
# Reads a map (art) template and converts it to a key template. All
# room exits need to be wiped for a key template, and room sizes may
# be enlarged for larger keys.
# The input and output files are opened here.
# Return value should be ignored.
sub dokeytemplate($) {
my $in = shift;
my $key = $in;
my $seen_title;
my $seen_start;
my $seen_hash;

if(!open(STDIN, "< $in")) {
die "$id: cannot open $in for reading: $!\n";
}
$key =~ s/([.]art$|$)/.key/i;

if(!open(KEY, "> $key")) {
die "$id: cannot open $key for writing: $!\n";
} elsif ($o_verbose) {
print STDERR "Opened $key for output\n";
}

if($o_include) {
# We'll put a comment block with some explanations here.
print KEY <<KeyComments;
: Key file syntax
: In key files room connections are not shown. Rooms are separated always
: by dots. Whitespace only in a room means either no room or no key for
: that room. Keys can be any non-whitespace characters. Explanation lines
: are used to assign attributes to the keys. The format is key at the start
: of the line; a colon; optional spaces; an attribute name; an attribute
: value in a set of {braces}. A key can be used in multiple explanation
: lines. Each explanation line can contain multiple attributes. Multiple
: items are comma (,) delimited. Multiple tasks are semicolon (;) delimited.
: Multiple assignments of name or style will result in the last one being
: used. The special key OVERALL can be used with the style attribute to
: put literal text (eg, style definitions) into the output IFM file.
KeyComments
}

while(<STDIN>) {
if($o_preserve and /^:/) {
print KEY;
next;
} elsif (/^:/) {
next;
}
if(!$seen_title) {
$seen_title = 1;

if ($o_verbose) {
print STDERR "Map title: $_";
if($o_preserve) {
print STDERR "Preserving any source comments\n";
}
}

next;
}

tr: #*\n:.:c;
if ($o_size > 1) {
s/[.]([ #*.])/'.' . $1 x $o_size/eg;
}

if(tr:*:*:) {
$seen_start = 1;
}
if(tr:#:#:) {
$seen_hash = 1;
}

print KEY;
} # while STDIN

print KEY "OVERALL: style {}\n";

if ($seen_start) {
print KEY '*' x $o_size . ": name {}\n";
print KEY '*' x $o_size . ": item {}\n";
print KEY '*' x $o_size . ": task {}\n";
print KEY '*' x $o_size . ": style {}\n";
}
if ($seen_hash) {
print KEY '#' x $o_size . ": name {}\n";
print KEY '#' x $o_size . ": item {}\n";
print KEY '*' x $o_size . ": task {}\n";
print KEY '#' x $o_size . ": style {}\n";
}
close KEY;
} # end &dokeytemplate

#####################################################################
# Reads in an art file (specified or STDIN) and adds extra cells to
# the map. If an outfile is specified, that is used for output.
# Otherwise, if an artfile is specified, that will be rewritten.
# Lastly, if the art file is from STDIN and no outfile given, STDOUT
# will get the grown map.
# The outfile will have already been opened, if being used.
# If an art file was specified, and no outfile specified, and a key
# file is found for it, that will be grown too.
# Existing map features, including comments, will be preserved.
sub dogrowth() {
my $queue;
my $key;
my $line;
my $new1;
my $new2;
my $key1;
my $key2;
my $keyroom;
my $keywall;
my $hold;
my $lart;
my $lkey;
my $i;
my @lines;
my $seen_title;

if(defined($o_file)) {
if(!open(STDIN, "< $o_file")) {
die "$id: cannot open $o_file for reading: $!\n";
} elsif($o_verbose) {
print STDERR "Opened $o_file for input.\n";
}

if(!defined($o_out)) {
$queue = 1; # store output for printing after reopen
$key = $o_file;
$key =~ s/([.]art$|$)/.key/i;
if(! -f $key) {
$key = undef;
}
}
}

$line = 0;
while(<STDIN>) {
if(/^:/) {
if($queue) {
push(@lines, $_);
} else {
print;
}
next;
} # if comment

if(!$seen_title) {
$seen_title = 1;
if($queue) {
push(@lines, $_);
} else {
print;
}

if ($o_verbose) {
print STDERR "Map title: $_";
}

next;
} # if title

if(/^\s*$/) {
if($queue) {
push(@lines, $_);
} else {
print;
}
} # if blank

# Not comment, title, or blank. Must be map data.

if(!defined($new1)) {
# First time through. Figure out current size.
$new1 = $_;
$new1 =~ s/\s+$//;
$new1 =~ tr:.:.:c;
$hold = $new1;

if($o_e) {
$new1 .= '..' x $o_e;
}
if($o_w) {
$new1 .= '..' x $o_w;
}
if($o_n or $o_s) {
$new2 = $new1;
$new2 =~ s/\.\./. /g;
}

$i = $o_n;
while($i) {
if($queue) {
push(@lines, "$new1\n", "$new2\n");
} else {
print "$new1\n$new2\n";
}
$i --;
} # while $i

} # if !$new1

if($o_e) {
chomp;
if($line % 2) {
# odd lines have rooms
$_ = $_ . ' .' x $o_e . "\n";
} else {
$_ = $_ . '..' x $o_e . "\n";
}
} # if $o_e

if($o_w) {
if($line % 2) {
# odd lines have rooms
$_ = '. ' x $o_w . $_;
} else {
$_ = '..' x $o_w . $_;
}
} # if $o_w

if($queue) {
push(@lines, $_);
} else {
print;
}
$line ++;
} # while STDIN

$i = $o_s;
while($i) {
if($queue) {
push(@lines, "$new2\n", "$new1\n");
} else {
print "$new2\n$new1\n";
}
$i --;
} # while $i

close STDIN;

if($queue) {
if(!open(ART, "> $o_file")) {
die "$id: cannot open $o_file for writing: $!\n";
} elsif($o_verbose) {
print STDERR "Opened $o_file for output.\n";
}
print ART @lines;
close ART;
} # if $queue

if($key) {
if(!open(KEY, "< $key")) {
die "$id: cannot open $key for reading: $!\n";
} elsif($o_verbose) {
print STDERR "Opened $key for input.\n";
}
undef(@lines);
} else {
if($o_verbose) {
print STDERR "Not processing a key file.\n";
}
return;
}

$line = 0;
while(<KEY>) {
if(/^:/) {
push(@lines, $_);
next;
} # if comment

if(/^\S+:\s*.+/) {
# key explanation line
next;
} # if key data

if(/^\s*$/) {
push(@lines, $_);
} # if blank

# Not comment, key data, or blank. Must be map data.

if(!defined($key1)) {
# First time through. Figure out current size.
# This is more complicated for a key file, since the rooms
# may be wider than one character.
$key1 = $_;

$key1 =~ s/\s*$//;
$hold =~ s/\s*$//;

# Minus one for final dot.
$lart = length($hold) - 1;
$lkey = length($key1) - 1;

if($lart != $lkey) {
# Figure original number of rooms wide.
$lart /= 2;
# Divide by that and we get the key room size plus one (for the .)
$lkey /= $lart;
$lkey --;

$keyroom = ' ' x $lkey;
$keywall = '.' x $lkey;
} else {
# We still need to figure original number of rooms wide.
$lart /= 2;
$lkey = 1;

$keyroom = ' ';
$keywall = '.';
}

if($o_verbose) {
print STDERR "Original map is $lart rooms wide, " .
"with $lkey chars per room.\n"
}
if($o_e) {
$key1 .= ".$keywall" x $o_e;
}
if($o_w) {
$key1 .= ".$keywall" x $o_w;
}
if($o_n or $o_s) {
$key2 = ".$keyroom" x ($lart + $o_e + $o_w) . '.';
}

$i = $o_n;
while($i) {
push(@lines, "$key1\n", "$key2\n");
$i --;
} # while $i

} # if !$new1

if($o_e) {
chomp;
if($line % 2) {
# odd lines have rooms
$_ = $_ . "$keyroom." x $o_e . "\n";
} else {
$_ = $_ . "$keywall." x $o_e . "\n";
}
} # if $o_e

if($o_w) {
if($line % 2) {
# odd lines have rooms
$_ = ".$keyroom" x $o_w . $_;
} else {
$_ = ".$keywall" x $o_w . $_;
}
} # if $o_w

push(@lines, $_);
$line ++;
} # while KEY
close KEY;

$i = $o_s;
while($i) {
push(@lines, "$key2\n", "$key1\n");
$i --;
} # while $i

if(!open(KEY, "> $key")) {
die "$id: cannot open $key for writing: $!\n";
} elsif($o_verbose) {
print STDERR "Opened $key for output.\n";
}
print KEY @lines;
close KEY;
} # end &dogrowth

#####################################################################
# Run a demonstration.
sub dodemo() {
my $key;
my $line;
my @lines;

if(!defined($o_out)) {
if(!defined($o_file)) {
die "$id: a file name is needed\n";
}
if(!open(STDOUT, "> $o_file")) {
die "$id: cannot open $o_file for output: $!\n";
} elsif ($o_verbose) {
print STDERR "Using $o_file for output.\n";
}
} else {
$o_file = $o_out;
$o_out = undef;
}

if(($o_rows < 4) or ($o_cols < 7)) {
die "$id: The demo map needs to be at least 4x7.\n";
}
if($o_verbose) {
print STDERR "Creating a blank template.\n";
}

dotemplate();
close STDOUT;

if(!open(BLANK, "< $o_file")) {
die "$id: cannot open $o_file for reading: $!\n";
}
if($o_verbose) {
print STDERR "Reading back the blank template.\n";
}

$line = 0;
$_ = <BLANK>; # map title
push(@lines, "Demo Map\n");
while(<BLANK>) {
if(/^[.]/) {
# line 0 unchanged
if($line == 1) { s{...............}{. . . .#.#. . .}; }
if($line == 2) { s{...............}{.......v.^.....}; }
if($line == 3) { s{...............}{. .#. .#.#.#>#.}; }
if($line == 4) { s{...............}{../.\\...x|/....}; }
if($line == 5) { s{...............}{.#. .#-#-#. . .}; }
if($line == 6) { s{...............}{.....|../|\\....}; }
if($line == 7) { s{...............}{. . .*.#.#.#<#.}; }
# line 8 (and up) unchanged

$line ++;
}
push(@lines, $_);
} # while BLANK
close BLANK;

if(!open(MAP, "> $o_file")) {
die "$id: cannot open $o_file for writing: $!\n";
}
if($o_verbose) {
print STDERR "Writing back the filled in template.\n";
}
print MAP @lines;
close MAP;
undef(@lines);

if($o_verbose) {
print STDERR "Creating the key template.\n";
}
dokeytemplate($o_file);

$key = $o_file;
$key =~ s/([.]art$|$)/.key/i;

if(!open(KEYBLANK, "< $key")) {
die "$id: cannot open $key for reading: $!\n";
}
if($o_verbose) {
print STDERR "Reading back the blank key template.\n";
}

$line = 0;
while(<KEYBLANK>) {
if(/^[.]/) {
# line 0 unchanged
if($line == 1) { s/#+/'H'x$o_size/e; s/#+/'T'x$o_size/e; }
# line 2 unchanged
if($line == 3) { s/#+/'C'x$o_size/e; s/#+(\.\s)/'c'x$o_size.$1/e; }
# line 4 unchanged
if($line == 5) { s/#+/'A'x$o_size/e; s/#+(\.\s)/'@'x$o_size.$1/e; }
# line 6 unchanged
if($line == 7) { s/#+\.#+\.#+\.#+/'1'x$o_size.'.'.
'2'x$o_size.'.'.
'3'x$o_size.'.'.
'|'x$o_size/e; }
# map lines 8 (and up) unchanged

$line ++;
}

if(/^OVERALL: style/) {
s/\{\s*\}/{room_colour = "gray60" in style Dark; }/;
}

if(/^([*]+: name)/) {
$_ = "$1 {Cell} item{paperclip} task{bend paperclip;pick lock}\n";
} elsif(/^[*]/) {
next;
}

push(@lines, $_);
} # while KEYBLANK
close KEYBLANK;

push(@lines, 'H'x$o_size . ": name{Hole} item{flashlight} style {Dark}\n");
push(@lines, 'H'x$o_size . ": task{search;take flashlight;turn on light}\n");
push(@lines, 'T'x$o_size . ": name{Tree} item{apple}\n");
push(@lines, 'T'x$o_size . ": task{eat apple;open cellphone}\n");
push(@lines, 'T'x$o_size . ": task{put battery in cellphone}\n");
push(@lines, 'T'x$o_size . ": task{call for help}\n");
push(@lines, 'C'x$o_size . ": name{Closet} style{Dark}\n");
push(@lines, 'c'x$o_size . ": name{Cupboard} item{cellphone battery}\n");
push(@lines, 'A'x$o_size . ": name{Alcove} style{Dark} item{cellphone}\n");
push(@lines, '@'x$o_size . ": name{Round room}\n");
push(@lines, '1'x$o_size . ": name{Exam room 1} item {bed,gloves}\n");
push(@lines, '2'x$o_size . ": name{Exam room 2} item {bed} item{towel}\n");
push(@lines, '3'x$o_size . ": name{Exam room 3} item {bed,broken sink}\n");
push(@lines, '|'x$o_size . ": name{Large sewer pipe} item {filthy rags}\n");

if(!open(KEYCUT, "> $key")) {
die "$id: cannot open $key for writing: $!\n";
}
if($o_verbose) {
print STDERR "Writing back the filled in key template.\n";
}
print KEYCUT @lines;
close KEYCUT;
undef(@lines);

} # end &dodemo

#####################################################################
# Prints a usage message. If the message is from a non-error condition
# it goes to STDOUT. Errors go to STDERR.
# Exits the program.
sub usage($) {
my $exit = shift;

if($exit) {
# Exiting with error, show brief usage
print STDERR "$0: use '$id --help' for usage summary.\n";
exit $exit;
}

print <<"UsageSummary";
$0: usage '$id {mode-option} [additional options] [infile]'

Mode options:
-t --template print an art template
-k --key make a key template from an art template
-g --grow SIZE grow template(s) by SIZE (eg "5" or "N2E1S4W7")
-m --makemap make the IFM map
-d --demo make a demo map

Additional options:
-i --include include instruction comments in templates
-p --preserve preserve comments in derived files
-u --updown use up-down instead of in-out (makemap only)
-x --rowsxcols R,C use R rows and C cols for template (template only)
-s --size NUM use NUM as room width (for key template mode only)
-o --out OUT use OUT for output file (unused for key mode)
-v --verbose verbose output to STDERR
--version print version info
--help print this help

STDIN and STDOUT are used when input or output files not specified, except
for --key mode. The demo option will run asciimapper in template mode,
then key template mode, and then makemap mode. Options for each honored.
UsageSummary
exit $exit;
} # end &usage

__END__

=pod

=head1 NAME

asciimapper - make IFM maps from ascii art

=head1 SYNOPSIS

asciimapper {mode-option} [additional options] [infile]

=head1 DESCRIPTION

A simple tool to create IFM (interactive fiction mapper) maps from
ASCII art maps. Intended to be an easy way to draw a map and have it
converted to IFM format.

There are four principle modes of operation each effected by different
options.

The main mode is the map making mode. In this mode an art map file
(suffix I<.art>) will be read. If a corresponding key file (suffix
I<.key>) is found, it will be read as well. Then a map (suffix I<.ifm>)
file will be created.

There is a template mode which will create a blank art template.

There is a key template mode which will convert an art file, blank or
filled in, to a key template. Using a filled in art file makes matching
rooms to squares easier.

There is a grow template mode which will add extra squares to an
existing art template (and key template if found), in case the original
size was inadequate.

While C<asciimapper> can produce a large variety of maps, it does not
come close to the full range of IFM. In some cases it may be necessary
to edit the IFM file created to achieve the desired map. See the
L<"LIMITATIONS"> section for details.

This was written to work with IFM 5.1. Other versions may or may not work.

=head1 EXAMPLES

asciimapper -t -x 9x4 -i -o template.art

This will create a new, blank art template nine squares tall and four
squares wide, including instruction comments, in "F<template.art>".

asciimapper -k -s 2 -i template.art

This will create a "F<template.key>" file from the art template, and
include instruction comments in it. The squares for the keys will be
two characters wide.

asciimapper -g 4 template.art

This will grow the art template file four squares in each direction.
If a "F<template.key>" file is found, it too, will be so enlarged.

asciimapper -g N2S2W5 template.art

This will grow the art template file two squares in each of the
north and south directions, and five squares on the west side.
If a "F<template.key>" file is found, it too, will be so enlarged.

asciimapper -m -p template.art

This will read the art template, and a corresponding key template if
found, and create a "F<template.ifm>" file with IFM map data. Any comments
in either of the source files will be preserved, as comments, in the
output.

asciimapper -d demo.art

This will run C<asciimapper> through template creation, key template
creation, and map generation modes. It creates a small (4x6) map to
demonstrate all features. All options for the modes exercised will be
honored -- except a request to create a too-small map template.

=head1 USAGE

Options must be specified individually. Order is not important, but
options that take a parameter must be paired with that parameter.

=head2 Mode

=over 4

=item *

-t --template

Generate an art template.

=item *

-k --key

Generate a key template from an art template.

The key file must be named after the input template. This mode will
not use -o (--out) or STDOUT for output, and requires an I<infile>
to be specified.

=item *

-g --grow SIZE

Enlarge an art template, and if found, a corresponding key template.
The I<SIZE> can be a bare number to grow the same amount on all edges,
or a list of one letter directions (C<N>, C<E>, C<S>, C<W>) followed
by a number, eg C<N3,S2,W4> to grow by three on the north side (top),
two on the south (bottom), and four on the west (left). Commas are
optional in the direction list.

=item *

-m --makemap

This will make an IFM format map from an art file. The art file
specifies the locations of all the rooms and the connections between
them. The key file, if available, will be used to name rooms, place
items, list tasks, and specify styles. On largish maps this may
produce "deep recursion" warning messages.

=item *

-d --demo

Not a true mode, this will generate a demo ASCII art map, from
which a key file will be made and filled in, then an IFM map will be
generated. Template mode, key mode, and generation mode options will
be honored.

=back

=head2 Additional options

=over 4

=item *

-i --include

Include, as comments, instructions in template files.

=item *

-p --preserve

Preserve comments in template files in derived files. Art file
comments will be copied to key templates. Art and key file
comments will be copied to IFM output, with the comment character
appropriately changed.

=item *

-u --updown

When making maps, use "go up" and "go down" in place of "go in" and
"go out".

=item *

-x --rowsxcols RxC

When making an art template, make it I<R> rows and I<C> columns. The
two values can be separated with a comma or an C<x>.

=item *

-s --size NUM

When making a key template, use I<NUM> characters for each key
square. Art templates always use one character squares, but a map
with a lot of rooms might need more keys than one character would
allow.

=item *

-o --out OUT

Use I<OUT> as the output file. Different modes use this differently.

For art template creation, this is used instead of STDOUT.

For key template creation, this is not used.

For grow mode, a new map file, I<OUT>, will be created instead of
overwriting the existing map or using STDOUT.

For map making mode, I<OUT> will be the IFM file.

For the demo, this will be preferred over I<infile> for naming the
output.

=item *

-v --verbose

Be verbose about what is happening. In the map making mode, this will
produce a lot of output. All verbose comments go to STDERR.

=back

=head2 Special options

=over 4

=item *

--version

Print version information and exit.

=item *

--help

Print a usage summary and exit.

=back

Except for key mode, C<asciimapper> tries to be good about accepting
STDIN and STDOUT as files.

=head1 ART SYNTAX

The art file starts out with a map title on the first non-comment line.
Comment lines begin with a colon (:), comments must start at the
begining of the line. After the title, blank lines are ignored.

The map section is a block of walls and connectors and room spaces.
Rooms are denoted with either an asterisk (C<*>) for the start room or
hash marks (C<#>) for all other rooms. There must be exactly one
start room. Empty spaces on the map are denoted with space characters.

Walls are periods (C<.>), indicating no connection there. Hyphens and
vertical bars (C<-> and C<|>) are used to indicate west-east and
north-south connections. Slash and backslash (C</> and C<\>) are used
for the diagonal directions. Crossing diagonal exits can be indicated
with an C<X> (case insignificant).

To connect with the special directions of in-out (or up-down) the
angle backets (aka less-than and greater-than, C<E<lt>> and C<E<gt>>) can be
used to point the in (or up) direction to a room laid out to the west
or east. While a caret (C<^>) or a C<V> (case insignificant) can be
used to point the in (or up) direction to a room laid out to the north
or the south.

Except for a map that will be grown, the outer edges must all be periods.
After growth, the outer edges must all be periods.

All map lines must be the same length.

=head1 KEY SYNTAX

The key file is initially very much like the art file, but all edges
must be periods. The spaces are filled with space characters, hashs
and one asterisk room -- at least when a key template is built from
a filled in art template.

Comments have the same format, and blank lines are ignored. There is
no map title line in the key file. There are key explanation lines,
which may be before, after, or interspersed with the map data.

An explanation line starts with the key name (which cannot contain
whitespace, periods, or colons) and is followed by a colon, and a list
of attributes. Attributes can have spaces around them and consist of
an attribute type and a brace (C<{> and C<}>) enclosed block with the
value.

Key names can be used for multiple rooms, and key names can be used
on multiple explanation lines. When there are multiple rooms with
the same key, they will have the same items, tasks, etc. When there
are multiple explanation lines, the attributes will be merged.

The attribute types are:

=over 4

=item *

name

Specifies the room name. If used multiple times for a key, the last
case is used.

=item *

item

Specifies one or more items in a room. If used multiple times for a
key, they are joined with commas (C<,>). Use commas within the value
field to separate items, too.

=item *

task

Specifies one or more tasks in a room. If used multiple times for a
key, they are joined with semicolons (C<;>). Use semicolons within the
value field to separate tasks, too.

=item *

style

Specifies a room style. If used multiple times for a key, the last
case is used. There are not predefined styles, but the special key
C<OVERALL> can be used to define styles.

=back

Key names are not fixed width except for the convience of the map staying
roughly similar looking. The special key C<OVERALL> can be used with
the style attribute to include literal IFM commands. These will all appear
in the IFM file before the first room is mentioned.

All map lines must have the same number of rooms, and the size of the
map must match the art file.

=head1 MAPPING PROCESS

When generating the IFM map, C<asciimapper> will first read in one or
both template files, storing them in memory and noting the location of
the start room.

It will then recursively wander through the map, starting from the
specified place, describing the path and rooms along the way. When a
path reaches a previously seen room, the link to it is noted. When a
room is reached with no previously used exits, C<asciimapper> backtracks
(returns from the recursed function). This mimicks the way IFM is meant
to be used.

All rooms must be connected for C<asciimapper> to find them. The
recursive nature of the wander can produce deep recursion warnings from
Perl when there are a lot of possible paths.

=head1 LIMITATIONS

Here is a list of some significant limitations in C<asciimapper> not
shared by IFM:

Maps can contain ins and outs or ups and downs, but not both. In either
case, in/out or up/down links cannot be placed in a diagonal direction.
Arbitrary command directions are not possible.

While IFM can easily express room links that are not straight,
C<asciimapper> has no way to do so. This prevents exits from pointing
back into the same room.

There is no way to stylize links, such as oneway paths or directions
that are initially blocked.

Placeholder exits to unexplored areas do not work.

Rooms cannot be anything but the standard shape.

An output file can only contain a single map.

Many IFM commands cannot be specified.

=head1 REVISION HISTORY

Version 1.0 was shown to Glenn Hutchings, author of IFM, but had a
much more awkward method of specifying room contents. 23 June 2005

Version 1.0.1 now uses key files, has a grow template mode, separates
preserving comments from including them, fixes several bugs (most
notably the proper use of the go clause), includes documentation.
28 June 2005

=head1 SEE ALSO

C<ifm> -- interactive fiction mapper

Get IFM: http://www.ifarchive.org/indexes/if-archiveXmapping-tools.html

=head1 PREREQUISITES

This was written against IFM version 5.1, and using Perl 5.6.1. The
Perl modules C<strict> and <vars> are used.

=head1 AUTHOR AND COPYRIGHT

Copyright 2005 by Eli the Bearded / Benjamin Elijah Griffin,
E<lt>[email protected]<gt>.

Released under the same license(s) as Perl.

=head1 BUGS

See the L<"LIMITATIONS"> section above. Anything not covered that that
seems wrong might be a bug, and should be reported to the author.

=cut