@q
@program jmap.muf
1 99999 d
i
( jmap.muf v1.0 Jessy @ FurryMUCK 9/00
A utility for creating and displaying area maps.
INSTALLATION:
Set jmap.muf M3. Link a global action with a name such as 'map' or
'+map' to the program. The program requires lib-lmgr, lib-editr,
and lib-strings, all of which should be available on an established
MUCK.
USAGE:
+map ..................... Display map of current area
+map <map> ............... Display <map>
+map #list ............... Display list of available maps
+map #create ............. Create a map in current environment room
+map #edit ............... Edit current map
+map #remove ............. Remove current map
+map #position ........... Set position of current room on map
If your current location has an identified position on the map, the
position will be shown as an 'X'. Maps for an area should be created
in an environment room parenting the area. Once a map is created, it
can be edited or removed from any room in the area. You must control
the environment room in order to create, edit, or remove the map. You
must control the current room in order to configure its position.
Command options that require additional information will prompt for
the information. You can talk and pose while at a map prompt, but
cannot use other MUCK commands. #Option strings do not have to be
typed in full: for example '+map #position' and '+map #p' will produce
the same result.
jmap.muf may be freely ported. Please comment any changes.
)
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
$define Tell me @ swap notify $enddef
lvar ourBoolean (* int: flow control var *)
lvar ourCounter (* int or str: loop counter *)
lvar ourScratch (* int, dbref, or var: workspace var *)
lvar ourString (* string: workspace var *)
lvar maxColumns (* int: number of columns on current map *)
lvar maxRows (* int: number of rows on current map *)
: DoPad ( s i -- s' ) (* pad string s to i characters *)
" "
rot swap strcat swap strcut pop
;
: DoEditLoop ( listname dbref {rng} mask currline cmdstring -- )
(* read input for list editor *)
EDITORloop
dup "save" stringcmp not if
pop pop pop pop
3 pick 3 + -1 * rotate
over 3 + -1 * rotate
dup 5 + pick over 5 + pick
over over LMGR-DeleteList
1 rot rot LMGR-PutRange
4 pick 4 pick LMGR-GetList
dup 3 + rotate over 3 + rotate
">> List saved." Tell
"" DoEditLoop exit
then
dup "abort" stringcmp not if
">> List not saved." Tell
pop pop pop pop pop pop pop pop pop exit
then
dup "end" stringcmp not if
pop pop pop pop pop pop
dup 3 + rotate over 3 + rotate
over over LMGR-DeleteList
1 rot rot LMGR-PutRange
">> List saved." Tell exit
then
;
: DoEditList ( d s -- ) (* edit list s on d *)
swap
">> Welcome to the list editor. You can get help by entering '.h' on"
Tell
">> a line by itself. '.end' will save and exit. '.abort' will abort"
Tell
">> any changes. To save changes and continue editing, use '.save'."
Tell
over over LMGR-GetList
"save" 1 ".i $" DoEditLoop
;
: DoRemoveList ( d s -- ) (* remove list s from d *)
"#" strcat ourString ! ourScratch !
ourScratch @ ourString @ remove_prop
ourString @ "/" strcat ourString !
"1" ourCounter !
begin (* begin line-removing loop *)
ourScratch @ ourString @ ourCounter @ strcat over over
getpropstr while
remove_prop
ourCounter @ atoi 1 + intostr ourCounter !
repeat (* end line-removing loop *)
pop pop
ourScratch @ ourString @
dup "*/" smatch if
dup strlen 1 - strcut pop strip
then
remove_prop
;
: DoShowList ( d s -- ) (* display list s on object d *)
"#/" strcat swap LMGR-GetList
begin (* begin line-listing loop *)
dup while
dup 1 + rotate Tell
1 -
repeat (* end line-listing loop *)
pop
;
: DoReadLine ( -- s )
(* read keyboard input; emit poses|says and continue, else return *)
begin (* begin input-scanning loop *)
read (* does input begin with 'say ' or " ? Emit if so *)
dup "\"" stringpfx if
1 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "say " stringpfx if
4 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
(* does input begin with 'pose ' or : ? Emit if so *)
dup ":" stringpfx if
1 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "pose " stringpfx if
5 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
(* continue for strings of all spaces; i.e., treat as null *)
dup strip not if
pop continue
then
break (* it's not a pose or say; break and exit *)
repeat
;
: QCheck ( -- i )(* wrap smatch for .q in an if, to avoid null string
match error if user enters a string of all spaces,
which DoReadLine would strip to a null string *)
dup if
dup ".quit" swap stringpfx
over ".end" swap stringpfx or if
pop ">> Done." Tell pid kill
then
then
;
: DoReadYesNo ( -- i )
(* read from keyboard; accept only vars of yes|no; return 1 for yes *)
begin (* begin input-scanning loop *)
DoReadLine
QCheck
"yes" over stringpfx if
pop 1 break
then
"no" over stringpfx if
pop 0 break
then
pop
">> Please enter 'Yes' or 'No'." Tell
repeat (* end input-scanning loop *)
;
: DoHelp ( -- ) (* display help screen *)
" "
prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell
"A utility for creating and displaying area maps." Tell " " Tell
" $com ..................... Display map of current area"
command @ "$com" subst Tell
" $com <map> ............... Display <map>"
command @ "$com" subst Tell
" $com #list ............... Display list of available maps"
command @ "$com" subst Tell
" $com #create ............. Create a map in current environment room"
command @ "$com" subst Tell
" $com #edit ............... Edit current map"
command @ "$com" subst Tell
" $com #remove ............. Remove current map"
command @ "$com" subst Tell
" $com #position ........... Set position of current room on map"
command @ "$com" subst Tell " " Tell
"If your current location has an identified position on the map, the "
"position will be shown as an 'X'. Maps for an area should be created "
"in an environment room parenting the area. Once a map is created, it "
"can be edited or removed from any room in the area. You must control "
"the environment room in order to create, edit, or remove the map. You "
"must control the current room in order to configure its position. "
"Command options that require additional information will prompt for the "
"information. You can talk and pose while at a map prompt, but cannot "
"use other MUCK commands. #Option strings do not have to be typed in "
"full: for example '$com #position' and '$com #p' will produce the same "
"result."
strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat
command @ "$com" subst Tell
;
: DoGetMapName ( -- s ) (* return name of map for current area *)
loc @ "_map#" envpropstr if
#0 "_maps/" rot intostr strcat getpropstr
else
pop ""
then
;
: DoDisplayMap ( -- ) (* display map of current room *)
(* replace char at current position, if configured, with 'X' *)
ourScratch @ not if (* get map room if needed *)
loc @ "_map#" envpropstr if
ourScratch !
else
">> You are in an unmapped area." Tell exit
then
then
(* verify that we have a map room *)
ourScratch @ not if
">> Map not found." Tell exit
then
(* verify that map room really has a map *)
ourScratch @ "_map#/" nextprop not if
">> Map not found." Tell exit
then
(* if current room has a position on current map, set ourBool true *)
0 ourBoolean !
loc @ "_map#" envpropstr pop dup if
ourScratch @ dbcmp if
1
else
0
then
then
loc @ "_mapy" getpropstr and
loc @ "_mapx" getpropstr and if 1 ourBoolean ! then
ourScratch @ "_map#/" "1" ourCounter !
begin (* begin emitting map lines *)
over over ourCounter @ strcat getpropstr dup while
ourBoolean @ if (* show position as X if applicable *)
loc @ "_mapy" getpropstr ourCounter @ smatch if
loc @ "_mapx" getpropstr atoi strcut
swap dup strlen 1 - strcut pop
"X" strcat swap strcat
then
then
Tell
ourCounter @ atoi 1 + intostr ourCounter !
repeat (* end line-emitting loop *)
pop pop pop
;
: DoCreateMap ( -- ) (* edit a new map list on current room *)
(* check permission *)
me @ loc @ controls not if ">> Permission denied." Tell exit then
">> What is the name of this map?" Tell (* get map name *)
">> [Enter map name, or .q to quit]" Tell
DoReadLine strip QCheck
dup "@*" smatch if (* make sure we're not setting a wiz prop *)
">> Sorry, invalid map name." Tell exit
then
loc @ "_map" DoEditList (* create and edit map list *)
loc @ "_map#/" nextprop if (* record loc and name of map *)
#0 "_maps/" loc @ intostr strcat rot setprop
then
;
: DoEditMap ( -- ) (* edit current map *)
loc @ "_map#" envpropstr if (* check: do we have a current map? *)
(* if so, check permission and edit *)
me @ over controls not if ">> Permission denied." Tell exit then
"_map" DoEditList
else
pop DoCreateMap (* otherwise, create a new map *)
then
;
: DoRemoveMap ( -- ) (* remove map of current area *)
loc @ "_map#" envpropstr if (* check: do we have a current map? *)
(* if so, check permission, get confirmation, and delete map *)
me @ over controls not if ">> Permission denied." Tell exit then
DoGetMapName dup if
">> Please confirm: You want to remove the $name map? (y/n)"
swap "$name" subst
else
">> Please confirm: You want to remove "
"the map of the this area? (y/n)" strcat swap pop
then
Tell DoReadYesNo not if ">> Aborted." Tell exit then
dup "_map" DoRemoveList
#0 "_maps/" rot intostr strcat remove_prop
">> Map removed." Tell
else (* otherwise, notify no-go *)
">> You are in an unmapped area. No map to remove." Tell pop
then
;
: DoSetMapPos ( -- )(* set position of current room on current map *)
(* check permission *)
me @ loc @ controls not if ">> Permission denied." Tell exit then
loc @ "_map#" envpropstr if (* if we have a current map... *)
ourScratch !
0 maxColumns ! (* loop through once, getting num rows and columns *)
0 maxRows !
ourScratch @ "_map#/" nextprop
begin
dup while
ourScratch @ over getpropstr strlen
dup maxColumns @ > if
maxColumns !
else
pop
then
maxRows @ 1 + maxRows !
ourScratch @ swap nextprop
repeat
pop
(* display current map, with row and column indices *)
" 123456789012345678901234567890123456789012345678901234567890123456789012345678"
maxColumns @ 3 + strcut pop
" 000000000111111111122222222223333333333444444444455555555556666666666777777777"
maxColumns @ 3 + strcut pop
Tell Tell " " Tell
"1" ourCounter !
begin
ourScratch @ "_map#/" ourCounter @ strcat getpropstr
dup while
ourCounter @ 3 DoPad swap strcat Tell
ourCounter @ atoi 1 + intostr ourCounter !
repeat
pop
" " Tell
(* prompt for row of current room; verify input; record as 'y' *)
begin
">> What is this room's row number on the map?" Tell
">> [Enter row number, or .q to quit]" Tell
DoReadLine strip QCheck
dup number? not if
">> Sorry, that's not a number." Tell pop continue
then
dup atoi 0 <= if
">> Invalid entry: the row number must be at least 1."
Tell pop continue
then
dup atoi maxRows @ > if
">> Invalid entry: there are only $num rows on the map."
maxRows @ intostr "$num" subst Tell pop continue
then
loc @ "_mapy" rot setprop break
repeat
(* prompt for row of current room; verify input; record as 'x' *)
begin
">> What is this room's column number on the map?" Tell
">> [Enter column number, or .q to quit]" Tell
DoReadLine strip QCheck
dup number? not if
">> Sorry, that's not a number." Tell pop continue
then
dup atoi 0 <= if
">> Invalid entry: the column number must be at least 1."
Tell pop continue
then
dup atoi maxColumns @ > if
">> Invalid entry: there are only $num columns on the map."
maxColumns @ intostr "$num" subst Tell pop continue
then
loc @ "_mapx" rot setprop break
repeat
">> Set." Tell (* notify and exit *)
else
">> Sorry, you're in an unmapped location." Tell
then
;
: DoListMaps ( -- ) (* display list of available maps *)
#0 "_maps/" nextprop
dup if
">> Available maps:" Tell " " Tell
begin
dup while
" " #0 3 pick getpropstr
1 strcut swap toupper swap strcat strcat Tell
#0 swap nextprop
repeat
pop
" " Tell
else
">> Sorry, no maps have been installed." Tell
then
;
: DoShowMap ( -- ) (* display a specified map *)
ourString @ if (* if map specified as cmd arg, find and display *)
#0 "_maps/" nextprop
begin
dup while
#0 over getpropstr ourString @ stringpfx if
"" "_maps/" subst atoi dbref ourScratch !
DoDisplayMap exit
then
#0 swap nextprop
repeat
">> Map '$name' not found."
ourString @ "$name" subst Tell
else (* if no map specifed, prompt for map name and then display *)
DoListMaps
begin
">> Which map do you want to display?" Tell
">> [Enter map name, or .q quit]" Tell
DoReadLine strip QCheck
ourString !
#0 "_maps/" nextprop
begin
dup while
#0 over getpropstr ourString @ stringpfx if
"" "_maps/" subst atoi dbref "_map" DoDisplayMap exit
then
#0 swap nextprop
repeat
">> Map '$name' not found."
ourString @ "$name" subst Tell pop
repeat
then
;
: main
dup if
"#help" over stringpfx if DoHelp exit then
"#position" over stringpfx if DoSetMapPos exit then
"#create" over stringpfx if DoCreateMap exit then
"#remove" over stringpfx if DoRemoveMap exit then
"#edit" over stringpfx if DoEditMap exit then
"#list" over stringpfx if DoListMaps exit then
"#show" over stringpfx if DoShowMap exit then
dup "#*" smatch if
">> #Option not understood." Tell exit
else
ourString ! DoShowMap
then
else
DoDisplayMap
then
;
.
c
q