#!/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 asciimapper@eli.users.panix.com 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() { 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() { 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 < 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 <) { 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() { 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() { 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; $_ = ; # map title push(@lines, "Demo Map\n"); while() { 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() { 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 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". asciimapper -k -s 2 -i template.art This will create a "F" 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" 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" 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" 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 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 to be specified. =item * -g --grow SIZE Enlarge an art template, and if found, a corresponding key template. The I can be a bare number to grow the same amount on all edges, or a list of one letter directions (C, C, C, C) followed by a number, eg C 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 rows and I columns. The two values can be separated with a comma or an C. =item * -s --size NUM When making a key template, use I 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 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, will be created instead of overwriting the existing map or using STDOUT. For map making mode, I will be the IFM file. For the demo, this will be preferred over I 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 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 (case insignificant). To connect with the special directions of in-out (or up-down) the angle backets (aka less-than and greater-than, C> and C>) 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 (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 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 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 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 backtracks (returns from the recursed function). This mimicks the way IFM is meant to be used. All rooms must be connected for C 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 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 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 -- 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 and are used. =head1 AUTHOR AND COPYRIGHT Copyright 2005 by Eli the Bearded / Benjamin Elijah Griffin, Easciimapper@eli.users.panix.comE. 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