@program findroute.muf
1 99999 d
i
( findroute.muf v1.0 Jessy @ FurryMUCK 4/01
This program searches a cache or the MUCK database for rooms matching a
specified name and, if one or more matches is found, offers to try to find
and display a route from the user's current location to the selected
destination. The program cannot always find the shortest route to a given
destination, but -- using a 'best effort' approach -- it can usually find a
reasonably efficient path to a given room. Configuration options allow
administrators to limit the extent of route searches, and allow users
to exclude their own rooms from searches and search paths.
INSTALLATION:
Port the program and set it M3 or W. Either level will work; the Wizard
setting will be more reliable on large MUCKs where long search paths
are allowed. Create a global exit with a name such as 'findroute;fr',
and link it to the program. The program requires lib-reflist,
lib-lmgr, lib-editor, lib-strings, lib-match, and a .pmatch macro, all
of which should be available and installed on an established MUCK.
CONFIGURATION:
The #config option, available to wizards, allows administrators to set
global configuration parameters. Available parameters are listed below,
with defaults listed in parentheses.
<cmd> #config cache=<num> ........ Cache dbrefs of <num> selected rooms [0]
<cmd> #config cache=clear ........ Clear global cache
<cmd> #config globals=<yes|no> ... Include global exits in searches [y]
<cmd> #config manual=<yes|no> .... Room owner must manually allow searches [n]
<cmd> #config max=<num> .......... Set maximum distance of route [64]
<cmd> #config nolocks=<yes|no> ... Allow or disallow #nolocks option [y]
<cmd> #config public=<yes|no> .... Allow or dissalow public access [y]
<cmd> #config wildcards=<yes|no> . Allow or disallow wildcards in room
names [y]
Cache refers to a global cache of room-names/dbrefs. On a large MUCK,
allowing the program to keep a cache of recently selected rooms will
significantly speed up searches. On small MUCKs, it will not help much
and will actually make it harder to search for specific rooms in some
cases. To disable caching, set the cache size to zero.
The 'globals' parameter controls whether users may include global
exits in their searches. Note that Dark exits are excluded from
searches... Global exits will need to be !Dark in order to be picked
up in route searches.
If the 'manual' parameter is set to 'yes', only rooms that have been
explicitly enabled with the #include option may be searched for.
The 'max' parameter sets a limit on the length of routes searched. The
maximum distance can be up to 500 hops, but a lower limit is
recommended for reasons of efficiency and practicality.
If the 'nolocks' parameter is set to 'no', non-wiz users will not be
able to use the #nolocks option, and it will not appear on the
program's #help and #tips screen.
By default, wildcards and patterns can be used when specifying room
names. This can be disabled by setting 'wildcards' to 'no'.
USAGE:
The default behavior of findroute.muf is to attempt match the name specified
on the command line to an existing room and -- if a match is found -- search
for and display a route from the user's current location to the specified
room. The program's cache of recently selected rooms is searched first. If a
match is found in cache, it is automatically selected; otherwise, the
program searches the database for matches. Locks along the route are
checked: if an exit is locked against the user, it cannot be used in a
route. Default behavior is supplemented by the command options specified
below:
<cmd> .......................... Redisplay last route, if any
<cmd> <room name|dbref> ........ Search for a route to <room>
<cmd> #routes .................. List saved routes
<cmd> <route name> ............. Display route <route name>
<cmd> #route <route name> ...... Display route <route name>
<cmd> #save <route name> ....... Save last route as <name>
<cmd> #edit <route name> ....... Edit named route
<cmd> #delete <route name> ..... Delete named route
<cmd> #cache ................... Display cache contents
<cmd> #cache <num> ............. Set personal cache size
<cmd> #cache clear ............. Clear personal cache
<cmd> #force <room> ............ Force db search, ignoring cache
<cmd> #max <num> ............... Set maximum distance of routes
<cmd> #exclude ................. Exclude current room from searches [O]
<cmd> #include ................. Include current room in searches [O]
<cmd> #tips .................... Display program usage tips
<cmd> #users <player>=<y|n> .... Allow or prohibit specify players [W]
<cmd> #config .................. Display system configuration [W]
<cmd> #config <param>=<value> .. Set system configuration value [W]
In order to use the #exclude and #include options, you must control the
current room. Options marked [W] may only be used by wizards.
See the program's #tips screen for more information on using the
command and #options.
TERMS OF USE:
Findroute.muf may be freely ported, copied, or modified. Please comment
any changes.
)
(2345678901234567890123456789012345678901234567890123456789012345678901)
$include $lib/reflist (* go get some libraries! *)
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
$include $lib/match
$define Tell me @ owner swap notify $enddef
$define DEFMAX "64" $enddef (* default max search distance *)
lvar ourArg (* str: command line arg *)
lvar ourCounter (* int: loop control counter *)
lvar ourDepth (* int: depth of recursive calls *)
lvar ourDest (* dbref: room user is trying to find *)
lvar ourDistance (* int: length of shortest route found so far *)
lvar ourLine (* int: line number of current list *)
lvar ourMax (* int: max distance of searched routes *)
lvar ourOpt (* str: command line #option *)
lvar ourParam (* str: configuration parameter string *)
lvar ourRoom (* dbref: room marking current position in search *)
lvar ourStart (* dbref: room search begins from *)
lvar ourStatus (* str: used to manage recursion depth *)
lvar ourString (* str: workspace var *)
lvar ourValue (* str: configuration setting value *)
(* also used as boolean in DoFindRoute *)
lvar noCache (* bool: true if we're skipping cache *)
lvar noLocks (* bool: true if we're skipping lock checks *)
lvar noWilds (* bool: true if wildcard room names are disabled *)
: DoPad ( s i -- s' ) (* pad string s to i characters *)
" "
rot swap strcat swap strcut pop
;
: DoLPad ( s i -- s ) (* pad string s to i characters, spaces left *)
swap
" "
swap strcat dup strlen rot - strcut swap pop
;
: DoGetTotalRooms ( -- i ) (* return total number of rooms on MUCK *)
#-1 stats pop pop pop pop pop swap pop
;
: DoRemoveDir ( d s -- ) (* remove dir s and s's subdirs from d *)
dup "*/" smatch not if
"/" strcat
then
over over nextprop swap pop
begin
dup while
over over nextprop
3 pick rot remove_prop
repeat
pop 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 ReadLine would strip to a null string *)
dup if
dup ".quit" swap stringpfx
over ".end" swap stringpfx or if
pop ">> Done." Tell (* notify we're done *)
me @ "_prefs/fr/tmp/" DoRemoveDir (* clean up *)
pid kill (* kill process *)
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 *)
;
: DoSearchable? ( d -- i )
(* return true if room can be searched for *)
dup "_noroute" envpropstr pop if
pop 0
else
prog "_cfg/manual" getprop if
"_route" getprop if
1
else
0
then
else
pop 1
then
then
;
: DoCheckPerm ( -- )
(* kill process if user isn't allowed to search *)
me @ "W" flag? if exit then (* wizards always allowed *)
prog "_cfg/!auth" getpropstr if (* see if user is prohibited *)
prog "_cfg/!auth" me @ REF-inlist? if
me @ "_prefs/fr/tmp/" DoRemoveDir
">> Permission denied." Tell pid kill
then
then
prog "_cfg/no_public" getprop if (* see if prog is set !public *)
prog "_cfg/auth" getpropstr if (* if so, look up user *)
prog "_cfg/auth" me @ REF-inlist? not if
me @ "_prefs/fr/tmp/" DoRemoveDir
">> Permission denied." Tell pid kill
then
then
then
;
: DoHelp ( -- ) (* put user's soul in a random body *)
prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell
"This program allows users to search for routes to named rooms."
Tell " " Tell
" %cmd .......................... Redisplay last route, if any"
command @ "%cmd" subst Tell
" %cmd <room name|dbref> ........ Search for a route to <room>"
command @ "%cmd" subst Tell
" %cmd #routes .................. List saved routes"
command @ "%cmd" subst Tell
" %cmd <route name> ............. Display route "
command @ "%cmd" subst Tell
" %cmd #route <route name> ...... Display route "
command @ "%cmd" subst Tell
" %cmd #save <route name> ....... Save last route as "
command @ "%cmd" subst Tell
" %cmd #edit <route name> ....... Edit named route"
command @ "%cmd" subst Tell
" %cmd #delete <route name> ..... Delete named route"
command @ "%cmd" subst Tell
" %cmd #cache ................... Display cache contents"
command @ "%cmd" subst Tell
" %cmd #cache <num> ............. Set personal cache size"
command @ "%cmd" subst Tell
" %cmd #cache clear ............. Clear personal cache"
command @ "%cmd" subst Tell
" %cmd #globals <yes|no> ........ If yes, include global exits in searches"
command @ "%cmd" subst Tell
" %cmd #force <room> ............ Force db search, ignoring cache"
command @ "%cmd" subst Tell
prog "_cfg/no_nolocks" not if
" %cmd #nolocks <room> .......... Skip lock checking when finding routes"
command @ "%cmd" subst Tell
then
" %cmd #max <num> ............... Set maximum distance of routes"
command @ "%cmd" subst Tell
" %cmd #exclude ................. Exclude current room from searches (O)"
command @ "%cmd" subst Tell
" %cmd #include ................. Include current room in searches (O)"
command @ "%cmd" subst Tell
" %cmd #tips .................... Display program usage tips"
command @ "%cmd" subst Tell
me @ "W" flag? if
" %cmd #users ................... List authorized & prohibited players (W)"
command @ "%cmd" subst Tell
" %cmd #users <player>= .... Allow or prohibit specify players (W)"
command @ "%cmd" subst Tell
" %cmd #config .................. Display system configuration (W)"
command @ "%cmd" subst Tell
" %cmd #config <param>= .. Set system configuration value (W)"
command @ "%cmd" subst Tell
then
" " Tell
"Commands marked (O) require that you own or control the current room. "
prog "_cfg/no_wildcards" getpropstr not if
"Room names may include wildards and patterns. Type 'man smatch' for "
"a complete listing of pattern matching rules." strcat strcat
then
Tell
;
: DoTips ( --- ) (* display useage tips *)
"On large MUCKs, finding the room you want can be the most time-"
"consuming step. For this reason, FindRoute keeps a two caches of "
"recently found rooms, a global one and one of rooms you have "
"searched for. On small MUCKs, the cache doesn't help much, "
"and can slow things down. So, use a cache only if the program takes "
"a noticable time to find rooms."
strcat strcat strcat strcat strcat Tell " " Tell
"The cache only stores room names and #dbrefs; it does not store "
"routes. Use the #save command to store routes." strcat Tell " " Tell
"Although the route-searching alogrithm is fairly robust, it will "
"not always find existing routes, and -- when a route is found -- it "
"will not always be the shortest available route. If the program "
"reports that no route is available, you might try moving to another "
"location and searching again"
strcat strcat strcat strcat
prog "_cfg/no_nolocks" getprop not if
", or searching with the #nolocks option" strcat
then
". To force FindRoute to look for shorter route, set the #max route "
"distance to a value equal to or lower than the distance of a "
"reported route."
strcat strcat strcat Tell " " Tell
"The program cannot track routes through non-traditional exits, such as "
"jumprooms, teleporters, terraform, etc. Similarly, it cannot verify "
"whether you can use exits locked to non-traditional locks, such as "
"programs that lock and unlock rooms. In these cases, it may report "
"that no route is available, even though one is."
strcat strcat strcat strcat Tell " " Tell
"The program will not use exits that are set Dark that you don't "
"control as part of a search path." strcat Tell " " Tell
"When searching for a room a name that may be similar to that of "
"other rooms, such as 'Bedroom', try the #db option if the room you "
"want doesn't appear in list of possibilities."
strcat strcat Tell " " Tell
prog "_cfg/no_wildcards" getpropstr not if
"The room name specified on the command line may include wildcards "
"and patterns. For example, to find all rooms with names like "
"'The Magic Shop', 'Megan's Magic Shop', 'Ye Olde Magic Shoppe', "
"use a command like"
strcat strcat strcat Tell " " Tell
" fr *magic*shop*" Tell " " Tell
"Type 'man smatch' for a complete description of wildcard and pattern "
"matching rules." strcat Tell " " Tell
then
"Partial strings may be used when specifying options. For example, "
"typing 'fr #force Unicorn Inn' and 'fr #f Unicorn Inn' will both "
"have the same effect." strcat strcat Tell " " Tell
"You can use 'home' instead of a room name." Tell " " Tell
"You may talk and pose normally when at a findroute prompt, but "
"cannot use other MUCK commands. You can use MUCK commands "
"normally while the program is searching for a route. You cannot "
"use any commands while the program is searching the database "
"to match a room name."
strcat strcat strcat strcat Tell " " Tell
"You can exclude searches from an area of rooms by using the "
"#exclude option while in a parent room of the area."
strcat Tell " " Tell
"If you know a room's #dbref, you can use this instead of the room's "
"name to avoid ambiguity and avoid the time and overhead of "
"database searches." strcat strcat Tell
;
: DoExcludeRoom ( -- ) (* set: room may not be in a found route *)
loc @ me @ controls if
loc @ "_route" remove_prop
loc @ "_noroute" "yes" setprop
">> Set. Room may not be included in route searches." Tell
else
">> Permission denied." Tell
then
;
: DoIncludeRoom ( -- ) (* set: room may be included in routes *)
loc @ me @ controls if
loc @ "_route" "yes" setprop
loc @ "_noroute" remove_prop
">> Set. Room may be included in route searches." Tell
else
">> Permission denied." Tell
then
;
: DoSetUserMax ( -- ) (* set user pref for max dist of routes *)
ourArg @ if
ourArg @ number? if
ourArg @ atoi dup 0 < not if
dup if
dup 500 > if
me @ "_prefs/fr/max_dist" "500" setprop
">> Maximum route distance set to 500 (maximum allowed)."
Tell pop
else
prog "_prefs/fr//max_dist" rot intostr setprop
">> Maximum route distance set." Tell
then
else
prog "_prefs/fr//max_dist" DEFMAX setprop pop
">> Maximum route distance set to default value %def."
DEFMAX "%def" subst Tell
then
else
">> The maximum distance value must be a non-negative number."
Tell
then
else
">> The maximum distance value must be a number." Tell
then
else
">> Syntax: %cmd #max <number>"
command @ "%cmd" subst Tell
then
;
: DoSetUserGlobals ( -- ) (* set user pref for include-globals *)
prog "_cfg/no_globals" getprop not if
ourArg @ if
"yes" ourArg @ stringpfx
"no" ourArg @ stringpfx or if
me @ "_prefs/fr/no_globals"
"yes" ourArg @ stringpfx if
remove_prop
">> Set. Global exits will be included in your searches."
else
"yes" setprop
">> Set. Global exits will not be included in your searches."
then
Tell
else
">> Syntax: %cmd #globals <yes|no>"
command @ "%cmd" subst Tell
then
else
">> Syntax: %cmd #globals <yes|no>"
command @ "%cmd" subst Tell
then
else
">> Staff settings prohibit globals from inclusion in searches."
Tell
then
;
: DoShowRoute ( s -- ) (* display route named s *)
"_prefs/fr/routes/%name#/"
swap "%name" subst ourString !
1 ourCounter !
begin
me @ ourString @ ourCounter @ intostr strcat
getpropstr dup while
Tell
ourCounter @ 1 + ourCounter !
repeat
pop
;
: DoFormatRoute ( -- ) (* put the saved list in a nice format *)
(* first see if we have a route *)
me @ "_prefs/fr/tmp/route#/" nextprop if
(* remove anything from last run *)
me @ "_prefs/fr/routes/Current#/" DoRemoveDir
me @ "_prefs/fr/routes/Current#/1" (* stick on a header *)
loc @ name " >>> " ourDest @ name
strcat strcat setprop
me @ "_prefs/fr/routes/Current#/2" " " setprop
1 ourCounter !
(* loop through raw list of dbrefs *)
(* convert to exit names and store )
begin ( as route named 'Current' *)
me @ "_prefs/fr/tmp/route#/"
ourCounter @ intostr strcat
getpropstr dup while
me @ "_prefs/fr/routes/Current#/"
ourCounter @ 2 + intostr strcat
rot atoi dbref name
dup ";" instr if
dup ";" instr 1 - strcut pop
then
ourCounter @ intostr
")" strcat 5 DoPad
swap strcat setprop
ourCounter @ 1 + ourCounter !
repeat
pop
me @ "_prefs/fr/routes/Current#"
ourCounter @ 1 + intostr setprop
then
;
: DoShowLastRoute ( -- ) (* last route is called 'Current'; show *)
"Current" DoShowRoute
;
: DoListSavedRoutes ( -- ) (* display list of user's saved routes *)
me @ "_prefs/fr/routes/" nextprop dup if
">> Your saved routes:" Tell " " Tell
1 ourCounter !
begin
dup while
dup "" "_prefs/fr/routes/" subst
dup strlen 1 - strcut pop
ourCounter @ intostr ")" strcat
4 DoPad swap strcat Tell
ourCounter @ 1 + ourCounter !
me @ swap nextprop
repeat
pop
else
">> Currently you do not have any saved routes." Tell pop
then
;
: DoShowNamedRoute ( -- ) (* display specified saved route *)
ourArg @ if
me @ "_prefs/fr/routes/%name#/"
ourArg @ "%name" subst over over
nextprop if
swap LMGR-GetList
begin
dup while
dup 1 + rotate Tell
1 -
repeat
pop
else
">> Route '%name' not found."
ourArg @ "%name" subst Tell pop pop
then
else (* if no route is specified, show a list of possibles *)
DoListSavedRoutes
then
;
: DoSaveLastRoute ( -- ) (* save last route found with a name *)
ourArg @ if (* check: prop name won't mess us up? *)
ourArg @ "current" smatch if
">> Please choose a different route name."
">> Sorry, the name 'Current' is used internally by this program."
Tell Tell exit
then
ourArg @ "[@.~#/]*" smatch if
">> Please choose a different route name."
">> Sorry, that name would really confuse this program."
Tell Tell exit
then
me @ "_prefs/fr/routes/Current#/" nextprop if
(* check: overwriting existing saved route? *)
me @ "_prefs/fr/routes/%name#/"
ourArg @ "%name" subst nextprop if
(* if so, get confirmation *)
">> You already have a route name '%name'."
ourArg @ "%name" subst Tell
">> Do you want to overwrite it? (y/n)" Tell
DoReadYesNo not if
">> Aborted." Tell exit
then
then
1 ourCounter ! (* ok, copy 'last route' to named list *)
"_prefs/fr/routes/%name#/"
ourArg @ "%name" subst ourString !
me @ ourString @ DoRemoveDir
begin
me @ "_prefs/fr/routes/Current#/"
ourCounter @ intostr strcat getpropstr
dup while
me @ ourString @ ourCounter @ intostr strcat
rot setprop
ourCounter @ 1 + ourCounter !
repeat
pop
me @ ourString @ dup strlen 1 - strcut pop
ourCounter @ intostr setprop
">> Route saved as '%name'."
ourArg @ "%name" subst Tell
else
">> You don't have a current route to save!" Tell
then
else
">> Syntax: %cmd #save <name to save as>"
command @ "%cmd" subst Tell
then
;
: DoEditLoop ( listname dbref {rng} mask currline cmdstring -- )
(* read input for list editor *)
(* I swiped this from lsedit... thanks Revar *)
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
;
: DoEditRoute ( -- ) (* edit a specified saved route *)
ourArg @ if
me @ "_prefs/fr/routes/%name#/"
ourArg @ "%name" subst nextprop if
"_prefs/fr/routes/%name" ourArg @ "%name" subst me @
">> any changes. To save changes and continue editing, use '.save'."
">> a line by itself. '.end' will save and exit. '.abort' will abort"
">> Welcome to the list editor. You can get help by entering '.h' on"
Tell Tell Tell
over over LMGR-GetList
"save" 1 ".i $" DoEditLoop
else
">> Route '%name' not found."
ourArg @ "%name" subst Tell
then
else
">> Syntax: %cmd #edit <route name>"
command @ "%cmd" subst Tell
then
;
: DoDeleteRoute ( -- ) (* delete a specified saved route *)
ourArg @ if
"_prefs/fr/routes/%name#/" ourArg @ "%name" subst ourString !
me @ ourString @ nextprop if
ourArg @ DoShowNamedRoute
">> Please confirm: You want to delete this route? (y/n)" Tell
DoReadYesNo if
me @ ourString @ DoRemoveDir
me @ ourString @ dup strlen 1 - strcut pop remove_prop
">> Route deleted." Tell
else
">> Done." Tell
then
else
">> Route '%name' not found."
ourArg @ "%name" subst Tell
then
else
">> Syntax: %cmd #delete <route name>"
command @ "%cmd" subst Tell
then
;
: DoDisplayCache ( -- ) (* display rooms in global and user cache *)
">> Rooms currently in global cache:" Tell
prog "_cache" REF-allrefs (* here are da globals *)
dup if
begin
dup while
" " depth rotate name strcat Tell
1 -
repeat
pop
else
pop " <none>" Tell
then
" " Tell
">> Rooms currently in your personal cache:" Tell
me @ "_prefs/fr/cache" REF-allrefs (* here are da user's *)
dup if
begin
dup while
" " depth rotate name strcat Tell
1 -
repeat
pop
else
pop " <none>" Tell
then
;
: DoCacheSettings ( -- )
(* show, clear, or set limit on user's cache *)
ourArg @ if
"show" ourArg @ stringpfx (* check: user wants to see cache? *)
"display" ourArg @ stringpfx or if
DoDisplayCache
else
"clear" ourArg @ stringpfx if (* ... or to clear it? *)
me @ "_prefs/fr/cache" remove_prop
">> Personal cache cleared." Tell
else
ourArg @ number? if (* ... or to set a limit on its size? *)
ourArg @ atoi 0 < not if (* cache size 0 disables caching *)
ourArg @ atoi if (* anything else up to 500 is max size *)
ourArg @ atoi 500 > if
">> Caches that large can cause problems." Tell
"500" ourArg !
then
me @ "_prefs/fr/max_cache" ourArg @ setprop
">> Maximum user cache size set to %num."
ourArg @ "%num" subst Tell
else
me @ "_prefs/fr/max_cache" remove_prop
me @ "_prefs/fr/cache" remove_prop
">> Personal cache disabled." Tell
then
else
">> Cache size cannot be negative." Tell
then
else
">> Cache value must be a number, or 'clear'." Tell
then
then
then
else
DoDisplayCache
then
;
: DoUpdateCache ( -- ) (* add recently searched room to cache *)
prog "_cfg/max_cache" getpropstr dup if (* ... if we have one ... *)
atoi ourCounter !
ourCounter @ if (* add ourDest to global cache *)
prog "_cache" ourDest @ REF-add
prog "_cache" REF-allrefs
begin (* trim cache to max allowed size *)
dup ourCounter @ > while
prog "_cache" depth rotate REF-delete
1 -
repeat
begin depth while pop repeat
then
else
pop
then
me @ "_prefs/fr/max_cache" getpropstr dup if
atoi ourCounter ! (* ... if user has a cache ... *)
ourCounter @ if (* add ourDest to user cache *)
me @ "_prefs/fr/cache" ourDest @ REF-add
me @ "_prefs/fr/cache" REF-allrefs
begin (* trim cache to max allowed size *)
dup ourCounter @ > while
me @ "_prefs/fr/cache" depth rotate REF-delete
1 -
repeat
begin depth while pop repeat
then
else
pop
then
;
: DoStoreRoute ( -- ) (* store route in temp form *)
me @ "_prefs/fr/tmp/route#/" DoRemoveDir (* delete old routes *)
1 ourLine ! (* copy stack o' dbrefs to list *)
begin
depth while
me @ "_prefs/fr/tmp/route#/"
ourLine @ intostr strcat
depth rotate intostr
setprop
ourLine @ 1 + ourLine !
repeat
ourLine @ 1 - ourDistance ! (* this is the number of hops *)
(* we'll use ourDistance later...)
( only save new routes found )
( if they're shorter than this *)
1 ourLine !
begin (* reconstruct stack from list *)
me @ "_prefs/fr/tmp/route#/"
ourLine @ intostr strcat
getpropstr dup while
atoi dbref
ourLine @ 1 + ourLine !
repeat
pop
;
: DoFindRoute ( d i -- i ) (* attempt to find route *)
(* This function is the heart of the program. It's a recursive function
that attempts to find a route from exit d to room ourDest. i should
be true if the exit has already been checked, and false if it
hasn't. The opening, left-indenting portion of the main code block
is a series of checks -- is the exit linked?, is it linked to a
room?, is the room searchable?, etc. If any of the tests fails, the
program puts a 1 on the stack, meaning 'this exit has already been
checked', and recalls itself. If the linked room matches our
destination, then route is saved. If the route was only one exit
long, then we're done... Otherwise, it keeps searching, attempting
to find a shorter route. The search ends when either all routes
have been checked or a one-exit route has been found. *)
(* This first block of code manages the system stack; that is, the
depth of recursion. Maximum allowed is 512; if we're more than 500
levels deep, it backs out, trying to make the depth of recursion
the same as the depth of the stack, in which case it can start up
again *)
(* if status is 'backout', then we need to be un-recursing *)
ourStatus @ "backout" smatch if (* system stack depth and MUF )
depth ourDepth @ = if ( stack depth are same; we can )
"normal" ourStatus ! ( reset status and continue *)
exit
then
depth ourDepth @ < if (* still haven't backed out far enough *)
ourDepth @ 1 - ourDepth !
exit
then
depth ourDepth @ > if (* shouldn't happen, but just to be safe *)
exit
then
then
(* keep track of recursion depth; back out if it gets close to max *)
ourDepth @ 1 + ourDepth !
ourDepth @ 502 > if
"backout" ourStatus !
exit
then
if (* if exit has already been checked, advance to the next one *)
next
dup not if
pop
then
then
(* search ends if we've exhausted all exits *)
depth not if exit then
(* make sure that we're not losing dbrefs in 'rooms check' list )
( because of the line length limit by trimming earliest entries *)
(
me @ "_prefs/fr/tmp/rooms" getpropstr dup strlen 200 > if
begin
dup strlen 200 > if
dup " " instr dup if
strcut swap pop
else
pop
me @ "_prefs/fr/tmp/rooms" rot setprop
break
then
else
me @ "_prefs/fr/tmp/rooms" rot setprop
break
then
repeat
else
pop
then
)
depth ourMax @ <= if (* check: max reached? *)
noLocks @ if
1
else
me @ over locked? not
then
if (* ... locked? *)
dup "D" flag? not (* exit hidden by a Dark flag? *)
over me @ swap controls or if
dup getlink dup if (* ... linked to something? *)
dup #-3 dbcmp not if (* make sure it's not a 'HOME' link *)
dup room? if (* ... linked to a room? *)
dup DoSearchable? if (* ... searchable? *)
me @ "_prefs/fr/tmp/rooms" 3 pick REF-inlist? not if
ourRoom !
ourRoom @ ourDest @ dbcmp if (* are we there yet? *)
ourDistance @ if
depth ourDistance @ < if (* if so, store route! *)
DoStoreRoute
then
else
DoStoreRoute
then
depth 1 = if
pop exit
then
depth if
pop
depth if
pop
depth if
1 DoFindRoute
then
else
exit
then
else
exit
then
else
me @ "_prefs/fr/tmp/rooms" ourRoom @ REF-add
ourRoom @ exits
dup if
0 DoFindRoute
else
pop 1 DoFindRoute
then
then
else
pop 1 DoFindRoute
then
else
pop 1 DoFindRoute
then
else
pop 1 DoFindRoute
then
else
pop 1 DoFindRoute
then
else
pop 1 DoFindRoute
then
else
1 DoFindRoute
then
else
1 DoFindRoute
then
else
depth if pop then
1 DoFindRoute
then
;
: DoSearchGlobals ( -- ) (* start searches from env rooms of loc *)
begin depth while pop repeat (* clear stack for new searches *)
"normal" ourStatus ! (* start off with status 'normal' *)
begin (* work our way up env tree, starting a search from each room *)
ourStart @ location dup while
ourStart !
ourStart @ exits
dup if
dup #-3 dbcmp if
pop
else
0 DoFindRoute
then
else
pop
then
repeat
pop
;
: DoLaunchSearch ( -- ) (* start search from user's location *)
(* if globals can be used, start additional searches from env rooms *)
loc @ ourDest @ dbcmp if (* ju-usst in case... *)
">> You're already there!" Tell
me @ "_prefs/fr/tmp/" DoRemoveDir
pid kill
then
background (* could take a while... get out of the way *)
0 ourDepth !
"normal" ourStatus ! (* start off with status 'normal' *)
loc @ exits dup if (* search from user's location *)
0 DoFindRoute
else
pop
then
prog "_cfg/no_globals" getprop not (* and from env rooms if allowed *)
me @ "_prefs/fr/no_globals" getprop not and if
ourDistance @ if
ourDistance @ 1 = not if
DoSearchGlobals
then
else
DoSearchGlobals
then
then
begin depth while pop repeat
;
: DoGetChoice ( -- ) (* if matches were found, get user choice *)
(* bail out if no matches were found *)
me @ "_prefs/fr/tmp/poss" REF-allrefs dup if
#-1 ourDest !
dup 1 = if (* found one match *)
pop
">> Match found in cache: " (* show user *)
ourValue @ if "" " in cache" subst then
over name strcat " (" strcat
over owner name strcat ")" strcat Tell
ourDest ! (* store its dbref *)
(* ... or ... *)
else (* found multiple possible matches *)
">> Matches found in cache: "
ourValue @ if "" " in cache" subst then
Tell " " Tell
1 ourCounter ! (* show user *)
begin
dup while
dup 1 + rotate
dup name " (" strcat
swap owner name strcat ")" strcat
ourCounter @ intostr ")" strcat
4 DoPad swap strcat Tell
1 - ourCounter @ 1 + ourCounter !
repeat
pop
ourCounter @ 1 - ourCounter ! (* this is how many hits *)
" " Tell
begin
">> Enter number of the room you want, or type .q to quit." Tell
DoReadLine QCheck
dup number? not if
">> Sorry, that's not a number." Tell pop continue
then
atoi dup dup 1 < swap ourCounter @ > or if
">> Sorry, that's outside the displayed range."
Tell pop continue
then
ourCounter ! break
repeat
#-1 ourDest !
me @ "_prefs/fr/tmp/poss" REF-allrefs
begin
dup while
dup 1 + rotate
ourCounter @ 1 - ourCounter !
ourCounter @ not if
ourDest ! break
else
pop
then
1 -
repeat
begin depth while pop repeat
ourDest @ not if
">> Internal error." Tell
">> Entry not found." Tell exit
then
then
else (* didn't find any matches *)
">> No rooms with names matching '%str' were found."
ourArg @ "%str" subst Tell exit
then
;
: DoSearchDBForRoom ( -- ) (* loop search db form room matches *)
0 ourCounter !
#0
begin
dup dbtop dbcmp not while
dup room? if
dup DoSearchable? if
dup name ourArg @
noWilds @ if swap then (* swapping order messes up wildcards *)
smatch if
me @ "_prefs/fr/tmp/poss" 3 pick REF-add
me @ "_prefs/fr/tmp/poss" 3 pick REF-add
ourCounter @ 1 + ourCounter !
ourCounter @ 500 >= if
break
then
then
then
then
1 +
repeat
pop
;
: DoCheckGlobalCache ( -- )
(* check global cache for room names matching arg *)
begin depth while pop repeat (* clear the stack *)
prog "_cache" getpropstr if (* see if we have a cache *)
prog "_cache" REF-allrefs pop (* put room refs on stack *)
begin
depth while (* loop through, looking for name matches *)
dup ok? if
dup room? if
dup DoSearchable? if
dup name ourArg @
noWilds @ if swap then
smatch if
me @ "_prefs/fr/tmp/poss" rot REF-add
else
pop
then
else (* delete any that are no longer good *)
prog "_cache" rot REF-delete
then
else
prog "_cache" rot REF-delete
then
else
prog "_cache" rot REF-delete
then
repeat
then
;
: DoCheckUserCache ( -- )
(* check user's cache for room names matching arg *)
begin depth while pop repeat (* clear the stack *)
me @ "_prefs/fr/cache" getpropstr if (* see if we have a cache *)
me @ "_prefs/fr/cache" REF-allrefs pop (* put room refs on stack *)
begin
depth while (* loop through, looking for name matches *)
dup ok? if
dup room? if
dup DoSearchable? if
dup name ourArg @
noWilds @ if swap then
smatch if
me @ "_prefs/fr/tmp/poss" rot REF-add
else
pop
then
else (* delete any that are no longer good *)
me @ "_prefs/fr/cache" rot REF-delete
then
else
me @ "_prefs/fr/cache" rot REF-delete
then
else
me @ "_prefs/fr/cache" rot REF-delete
then
repeat
then
;
: DoSetMax ( -- ) (* set ourMax for this search *)
prog "_cfg/max_dist" getpropstr dup if
atoi (* check global max setting *)
else
pop DEFMAX atoi (* ... or default if no global setting exists... *)
then
ourMax !
(* ... then check user's max setting... *)
me @ "_prefs/fr/max_dist" getpropstr dup if
atoi
else
pop 500
then
ourMax @ over > if (* ... and use the lowest of these *)
ourMax !
else
pop
then
;
: DoMetaFind ( -- )
(* all the housekeeping that needs to precede a search *)
DoCheckPerm (* check: user is allowed to search? *)
me @ "_prefs/fr/tmp/" DoRemoveDir (* clear old temp data *)
ourArg @ if
ourArg @ "home" smatch if (* substitute dbref is dest is 'home' *)
me @ getlink ourDest !
then
then
DoSetMax (* go set the max distance variable *)
ourDest @ if
begin depth while pop repeat
">> Searching for a route to %name... "
ourDest @ name "%name" subst Tell
DoLaunchSearch
else
(* see if we can match room name from cache first *)
noCache @ not if
DoCheckGlobalCache
DoCheckUserCache
then
0 ourValue !
me @ "_prefs/fr/tmp/poss" getpropstr if
DoGetChoice
else (* if no match found in cache, search db *)
(* on large dbs, prompt for confirmation first *)
1 ourValue !
noCache @ if
">> Searching the database for the room..." Tell
DoSearchDBForRoom
else
DoGetTotalRooms 1000 > if
DoGetTotalRooms 2500 > if
">> Do you want to search the database for matches? (y/n)"
">> Searching the database will take a while." Tell Tell
DoReadYesNo
else
1
then
if
DoSearchDBForRoom
else
">> Done." Tell exit
then
else
">> Room not found in cache. Searching database... " Tell
DoSearchDBForRoom
then
then
me @ "_prefs/fr/tmp/poss" getpropstr if
DoGetChoice
else
">> No rooms matching '%name' were found."
ourArg @ "%name" subst Tell exit
then
then
">> Searching for a route... " Tell
DoLaunchSearch
then
(* if we found something... *)
me @ "_prefs/fr/tmp/route#/" nextprop if
DoUpdateCache (* update cache *)
DoFormatRoute (* prettify route list *)
"Current" DoShowRoute (* and show it to user *)
else
">> No route found." Tell (* otherwise, nuffin *)
then
;
: DoForceSearch ( -- )
(* set var to disable cache searching, then search as normal *)
1 noCache !
DoMetaFind
;
: DoNoLocksSearch ( -- )
(* set var to disable lock checking, then search as normal *)
prog "_cfg/no_nolocks" getprop
me @ "W" flag? not and if
">> 'No locks' searching is currently disabled." Tell
else
1 noLocks !
DoMetaFind
then
;
: DoSearchByDBref ( -- ) (* store room dbref; go search *)
(* this will skip cache, skip dbase search, and avoid ambiguity *)
ourDest !
1 noCache !
DoMetaFind
;
: DoRoomPrompt ( -- ) (* prompt user for room name; go search *)
DoCheckPerm (* check: user is allowed to search? *)
">> What room do you want to search for?" Tell
">> [Enter room name or #dbref, or .q to quit]" Tell
DoReadLine QCheck
ourArg ! DoMetaFind
;
: DoDisplayUsers ( -- )
(* display list of authorized and prohibited users *)
">> Current authorized users: "
prog "_cfg/auth" getpropstr if
prog "_cfg/auth" REF-list
else
" <none>"
then
strcat Tell
">> Current prohibited users: "
prog "_cfg/!auth" getpropstr if
prog "_cfg/!auth" REF-list
else
" <none>"
then
strcat Tell
;
: DoSetUsers ( -- ) (* add or remove users from auth list *)
me @ "W" flag? if (* only wizzes can set user lists *)
ourArg @ if (* check syntax *)
ourArg @ "=" instr if
ourArg @ dup "=" instr strcut strip dup if
ourValue !
else
">> Syntax: %cmd #users <player>="
command @ "%cmd" subst Tell pop exit
then
"yes" ourValue @ stringpfx
"no" ourValue @ stringpfx or not if
">> Syntax: %cmd #users <player>="
command @ "%cmd" subst Tell pop exit
then
strip dup if
dup strlen 1 - strcut pop strip dup if
ourParam !
else
">> Syntax: %cmd #users <player>="
command @ "%cmd" subst Tell pop exit
then
else
">> Syntax: %cmd #users <player>="
command @ "%cmd" subst Tell pop exit
then
ourParam @ .pmatch dup if (* find specified player *)
ourParam !
else
">> Player not found." Tell exit
then
(* and add/remove from authorized and !authorized lists *)
"yes" ourValue @ stringpfx if
prog "_cfg/auth" ourParam @ REF-add
prog "_cfg/!auth" ourParam @ REF-delete
">> Set. %name may use this program."
ourParam @ name "%name" subst Tell
else
prog "_cfg/auth" ourParam @ REF-delete
prog "_cfg/!auth" ourParam @ REF-add
">> Set. %name may not use this program."
ourParam @ name "%name" subst Tell
then
else
">> Syntax: %cmd #users <player>="
command @ "%cmd" subst Tell pop exit
then
else
DoDisplayUsers (* if no user specified, display current list *)
then
else
">> Permission denied." Tell
then
;
: DoConfigCacheSize ( -- ) (* set max entries in global cache *)
ourValue @ number? if
ourValue @ atoi dup 0 < not if
dup if
prog "_cfg/max_cache" rot intostr setprop
">> Global cache size set." Tell
else
prog "_cfg/max_cache" remove_prop pop
">> Global cache disabled." Tell
then
else
">> The 'cache size' value must be a non-negative number." Tell
then
else
"clear" ourValue @ stringpfx if
prog "_cache" remove_prop
">> Global cache cleared." Tell
else
">> The 'cache size' value must be a number." Tell
then
then
;
: DoConfigGlobals ( -- )
(* set whether env exits will included in route searches *)
"yes" ourValue @ stringpfx
"no" ourValue @ stringpfx or if
prog "_cfg/no_globals"
"yes" ourValue @ stringpfx if
remove_prop
">> Set. Global exits can be included in route searches."
else
"yes" setprop
">> Set. Global exits cannot be included in route searches."
then
Tell
else
">> The 'allow globals' value must be 'yes' or 'no'." Tell
then
;
: DoConfigManual ( -- )
(* set whether room owners must explicitly allow searches *)
"yes" ourValue @ stringpfx
"no" ourValue @ stringpfx or if
prog "_cfg/manual"
"yes" ourValue @ stringpfx if
remove_prop
">> Set. Room owners must explicitly allow route searches."
else
"yes" setprop
">> Set. Room owners don't have to explicitly allow route searches."
then
Tell
else
">> The 'manual settings' value must be 'yes' or 'no'." Tell
then
;
: DoConfigMax ( -- ) (* set maximum length of routes *)
ourValue @ number? if
ourValue @ atoi dup 0 < not if
dup if
dup 500 > if
prog "_cfg/max_dist" "500" setprop
">> Maximum route distance set to 500 (max allowed)." Tell
else
prog "_cfg/max_dist" rot intostr setprop
">> Maximum route distance set." Tell
then
else
prog "_cfg/max_dist" DEFMAX setprop pop
">> Maximum route distance set to default value %def."
DEFMAX "%def" subst Tell
then
else
">> The maximum distance value must be a non-negative number." Tell
then
else
">> The maximum distance value must be a number." Tell
then
;
: DoConfigNoLocks ( -- )
(* set whether users can skip lock-checking *)
"yes" ourValue @ stringpfx
"no" ourValue @ stringpfx or if
prog "_cfg/no_nolocks"
"yes" ourValue @ stringpfx if
remove_prop
">> Set. Users may ignore locks during route searches."
else
"yes" setprop
">> Set. Users can't ignore locks during route searches."
then
Tell
else
">> The 'allow nolocks' value must be 'yes' or 'no'." Tell
then
;
: DoConfigPublic ( -- )
(* set whether program is publicly available *)
"yes" ourValue @ stringpfx
"no" ourValue @ stringpfx or if
prog "_cfg/no_public"
"yes" ourValue @ stringpfx if
remove_prop
">> Set. This program is publicly available."
else
"yes" setprop
">> Set. Users must be authorized before using this program."
then
Tell
else
">> The 'public access' value must be 'yes' or 'no'." Tell
then
;
: DoConfigWildcards ( -- )
(* set whether wildcards and patters may be used in room names *)
"yes" ourValue @ stringpfx
"no" ourValue @ stringpfx or if
prog "_cfg/no_wildcards"
"yes" ourValue @ stringpfx if
remove_prop
">> Set. Wildcards and patterns can be used in room names."
else
"yes" setprop
">> Set. Wildcards and patterns cannot be used in room names."
then
Tell
else
">> The 'public access' value must be 'yes' or 'no'." Tell
then
;
: DoDisplayConfig ( -- ) (* display current system configuration *)
">> Current FindRoute configuration:" Tell " " Tell
" Allow #nolocks option ............................... %val"
prog "_cfg/no_nolocks" getprop if "no" else "yes" then
4 DoLPad "%val" subst Tell
" Allow wildcards & patterns in room names ............ %val"
prog "_cfg/no_wildcards" getprop if "no" else "yes" then
4 DoLPad "%val" subst Tell
" Include global exits in route searches .............. %val"
prog "_cfg/no_globals" getprop if "no" else "yes" then
4 DoLPad "%val" subst Tell
" Maximum cache size .................................. %val"
prog "_cfg/max_cache" getprop dup not if pop "128" then
4 DoLPad "%val" subst Tell
" Maximum route distance .............................. %val"
prog "_cfg/max_dist" getprop dup not if pop DEFMAX then
4 DoLPad "%val" subst Tell
" Require authorization ............................... %val"
prog "_cfg/no_public" getprop if "yes" else "no" then
4 DoLPad "%val" subst Tell
" Require room owners to explicitly allow searches .... %val"
prog "_cfg/manual" getprop if "yes" else "no" then
4 DoLPad "%val" subst Tell
;
: DoConfigure
me @ "W" flag? if
ourArg @ if
ourArg @ "=" instr if
ourArg @ dup "=" instr strcut strip dup if
ourValue !
else
">> Syntax: %cmd #config <parameter>="
command @ "%cmd" subst Tell pop exit
then
strip dup if
dup strlen 1 - strcut pop strip dup if
ourParam !
else
">> Syntax: %cmd #config <parameter>="
command @ "%cmd" subst Tell pop exit
then
else
">> Syntax: %cmd #config <parameter>="
command @ "%cmd" subst Tell pop exit
then
"maximum" ourParam @ stringpfx if DoConfigMax else
"globals" ourParam @ stringpfx if DoConfigGlobals else
"manual" ourParam @ stringpfx if DoConfigManual else
"cache" ourParam @ stringpfx if DoConfigCacheSize else
"nolocks" ourParam @ stringpfx if DoConfigNoLocks else
"wildcards" ourParam @ stringpfx if DoConfigWildcards else
"public" ourParam @ stringpfx if DoConfigPublic else
">> System parameter '%param' not found."
ourParam @ "%param" subst Tell
then then then then then then then
else
">> Syntax: %cmd #config <parameter>="
command @ "%cmd" subst Tell
then
else
DoDisplayConfig
then
else
">> Permission denied." Tell
then
;
: main
"me" match me !
me @ location ourStart !
prog "_cfg/no_wildcards" getprop if 1 noWilds ! then
dup if
dup "#*" smatch if
dup " " instr if
dup " " instr strcut
strip ourArg !
strip ourOpt !
else
strip ourOpt !
then
"#help" ourOpt @ stringpfx if DoHelp else
"#tips" ourOpt @ stringpfx if DoTips else
"#routes" ourOpt @ stringpfx if DoShowNamedRoute else
"#maximum" ourOpt @ stringpfx if DoSetUserMax else
"#list" ourOpt @ stringpfx if DoListSavedRoutes else
"#save" ourOpt @ stringpfx if DoSaveLastRoute else
"#edit" ourOpt @ stringpfx if DoEditRoute else
"#delete" ourOpt @ stringpfx if DoDeleteRoute else
"#cache" ourOpt @ stringpfx if DoCacheSettings else
"#configure" ourOpt @ stringpfx if DoConfigure else
"#force" ourOpt @ stringpfx if DoForceSearch else
"#nolocks" ourOpt @ stringpfx if DoNoLocksSearch else
"#globals" ourOpt @ stringpfx if DoSetUserGlobals else
"#users" ourOpt @ stringpfx if DoSetUsers else
"#exclude" ourOpt @ stringpfx if DoExcludeRoom else
"#include" ourOpt @ stringpfx if DoIncludeRoom else
ourOpt @ "#0" smatch if
#0 DoSearchByDbref
else
ourOpt @ "" "#" subst atoi dbref dup ok?
over #0 dbcmp not and if
dup room? if
dup DoSearchable? if
DoSearchByDbref
else
">> Option or room not found." Tell
then
else
">> Option or room not found." Tell
then
else
">> Option or room not found." Tell
then
then
then then then then then then then then
then then then then then then then then
else
dup ourArg !
me @ "_prefs/fr/routes/%name#/"
3 pick "%name" subst nextprop if
DoShowNamedRoute
else
DoMetaFind
then
then
else
me @ "_prefs/fr/routes/Current#/" nextprop if
DoShowLastRoute
else
DoRoomPrompt
then
then
me @ "_prefs/fr/tmp/" DoRemoveDir
;
.
c
q