@q
@program jlook.muf
1 99999 d
i
( jlook.muf v1.2 Jessy @ FurryMUCK 11/99
A cmd-look with looktrap support, false objects, MUSH emultation
for +view, %r, %t, and %b, and extensive user-preference options.
INSTALLATION:
Set the program M3 and link a global action to it.
@act look;loo;lo;l;lookat;@bdescribe;@bdesc;+view=#0
@link look=jlook.muf
If you are using fb6 or later, or a modified server that has an
autolook_cmd system parameter, you should @tune the parameter to
something *different* than 'look', and append that string to
the command name:
@act look;loo;lo;l;lookat;@bdescribe;@bdesc;+view;rlook=#0
@tune autolook_cmd=rlook
This will allow jlook to determine whether a player is looking at
a room in repsonse to an explicit user command or as a result of
moving to a different room. This allows a cleaner syntax.
CONFIGURATION:
Default user preferences are inherited from the flags automatically
set in jlook.muf's _prefs/look/flags property. After the program
has been installed and used at least once, you can manaually edit
this property to change default user preferences. See preference
below.
USE:
look ................................ Show your location
look <obj|detail|item> .............. Show <obj|detail|item>
look #detail <obj>/<detail>=<desc> .. Create detail on <obj>
look #item <obj>/<item>=<desc> ...... Create item on <obj>
look #mask <detail|item> ............ Mask <detail|item>
look #!mask <obj>/<detail|item> ..... Unmask <detail|item>
look #unmask <obj>/<detail|item> .... Unmask <detail|item>
look #!detail <obj>/<detail> ........ Remove <detail> from <obj>
look #!item <obj>/<item> ............ Remove <item> from <obj>
+view ............................... List all unmasked details
+view <obj> ......................... List all details on <obj>
+view <obj>=<detail ................. Show <detail> on <obj>
look #prefs <option>=<value> ........ Set pref <option> to <value>
'Details' are lookable features of an item. When masked, they do not
appear in a Details list. 'Items' are false objects. When masked,
they do not appear in a Contents or Carrying list. Details and items
may be looked at whether masked or unmasked.
Valid preference settings include:
connections = <yes|no> ... Yes = show connection info w/ player names
details = <yes|no> ....... Yes = show detail list with descs
exits = <yes|no> ......... Yes = show exit list with descs
horizontal = <yes|no> .... Yes = format contents lists horizonatlly
static = <yes|no> ........ Yes = don't use dynamic descs
quell = <yes|no> ......... Yes = Do not show room descs in travel
To set defaults, set the _prefs/look/flags property on the program
object to a string that includes the first letter of each preference
you want set 'yes' by default. For example, to enable Connections,
Details, and Exits by default, do...
@set jlook=_prefs/look/flags:CDE
Detail data is stored in an object's _details/ propdir. False object
data is stored in an object's _items/ propdir.
jlook.muf may be freely ported. Please comment any changes.
jessydupres@yahoo.com
)
$define ourVersion "1.0" $enddef
$define Tell me @ swap notify $enddef
$define
DoClearStack begin depth while pop repeat
$enddef
$define (* add a type check for puppets *)
puppet?
dup "Z" flag?
swap thing? and if
1
else
0
then
$enddef
lvar lib
lvar ourArg
lvar ourObj
lvar ourOpt
lvar ourBool
(2345678901234567890123456789012345678901234567890123456789012345678901)
: DoInitProgram ( -- ) (* set default program config props *)
prog "_prefs/look/flags" "CDSE" setprop
prog "_version" ourVersion setprop
;
: DoInitPlayer ( -- ) (* set default player config prop *)
me @ "_prefs/look/flags"
prog "_prefs/look/flags"
getpropstr setprop
me @ "_prefs/look/version"
ourVersion setprop
;
: DoInsertControls ( s -- s' ) (* replace chars that would confuse
directory system or allow setting
wizprops with harmless strings *)
dup "/" instr if
"=$sl$=" "/" subst
then
dup ":" instr if
"=$co$=" ":" subst
then
dup "*" instr if
"=$a$=" "*" subst
then
dup "." instr if
"=$p$=" "." subst
then
dup "@" instr if
"=$at$=" "@" subst
then
dup "~" instr if
"=$t$=" "~" subst
then
;
: DoRemoveControls ( s -- s' ) (* remove control chars from s *)
dup "=$sl$=" instr if
"/" "=$sl$=" subst
then
dup "=$co$=" instr if
":" "=$co$=" subst
then
dup "=$a$=" instr if
"*" "=$a$=" subst
then
dup "=$p$=" instr if
"." "=$p$=" subst
then
dup "=$at$=" instr if
"@" "=$at$=" subst
then
dup "=$t$=" instr if
"~" "=$t$=" subst
then
;
: DoParseThis ( d s -- s ) (* returns d's prop s, parsed for MPI *)
dup 3 pick swap getpropstr 0 parseprop
;
: DoMainName ( s -- s' ) (* return name str s, stripped of aliases *)
dup ";" instr if
dup ";" instr 1 - strcut pop
then
;
: DoSortStrings-d ( s ... s' i -- s ... s' )
(* sort range of strings, descending *)
dup (* dup index: one copy is inner loop counter, other outer loop *)
begin (* begin outer loop: will step through range i times *)
dup while
over
begin (* begin inner loop: step through range, comparing pairs *)
dup 1 > while
dup 3 + pick over 3 + pick (* get pair *)
over over strcmp 0 < if (* compare *)
swap (* swap if needed *)
then
3 pick 3 + put (* replace pair *)
over 3 + put
1 - (* decrement inner loop counter *)
repeat (* end inner loop *)
pop
1 - (* decrement outer loop counter *)
repeat (* end outer loop *)
pop pop (* pop counters *)
;
: DoOurMatch ( s -- d ) (* return dbref for object named s *)
match
dup #-1 dbcmp if
me @ "I don't see that here." notify pid kill
then
dup #-2 dbcmp if
me @ "I don't know which on you mean!" pid kill
then
;
: DoGetContents ( -- str rng )
(* return contents of ourObj as str rng *)
ourObj @ contents
begin (* put contents on stack *)
dup while
dup me @ dbcmp if (* skip user *)
next continue
then
dup room? if (* skip rooms *)
next continue
then
dup "D" flag? (* skip others' dark objects *)
me @ 3 pick controls not and if
next continue
then
dup program? (* skip others' programs *)
me @ 3 pick controls not and if
next continue
then
dup player? if (* handle dark_sleepers sysparm *)
dup awake? not
"dark_sleepers" sysparm "yes" smatch and if
next continue
then
then
dup next
swap
dup player? if (* this way for players *)
me @ over controls if
dup unparseobj
else
dup name
then (* add connection info if pref'd *)
me @ "_prefs/look/flags" getpropstr "C" instr if
over awake? if
over descriptors
begin dup 1 > while rot pop 1 - repeat
not if -1 exit then
descrcon conidle
300 > if
" [idle]"
else
" [awake]"
then
else
" [asleep]"
then
strcat
swap pop
else
swap pop
then
else
me @ over controls if
unparseobj
else
name
then
then
swap
repeat
pop
(* add false objects to list *)
ourObj @ "_items/" nextprop
begin
dup while
ourObj @ over "_masked/" "_items/" subst
getpropstr not if
dup "" "_items/" subst DoMainName
dup "_masked/" "_items/" subst
ourObj @ swap getpropstr if
swap
else
pop
then
then
ourObj @ swap nextprop
repeat
pop
depth (* add count... now its a range *)
;
: DoContentsLabel ( -- s ) (* return 'Contents: ' or 'Carrying: ' *)
ourObj @ player? if
"Carrying: "
else
"Contents: "
then
;
: DoAddFlag ( s -- ) (* add flag s to user's _prefs/look/flags *)
me @ "_prefs/look/flags" getpropstr over instr not if
me @ "_prefs/look/flags" over over getpropstr
4 rotate toupper strcat setprop
else
pop
then
me @ ">> Set." notify
;
: DoDelFlag ( s -- ) (* delete flag s from user's _prefs/look/flags *)
me @ "_prefs/look/flags" over over getpropstr
"" 5 rotate subst setprop
me @ ">> Set." Tell
;
: DoVerticalContents ( str rng -- ) (* show contents vertically *)
DoContentsLabel Tell
begin
dup while
depth rotate Tell
1 -
repeat
pop
;
: DoContents ( str rng -- ) (* show ourObj's contents list *)
(* this way for horizontal lists *)
me @ "_prefs/look/flags" getpropstr "H" instr if
0 ourBool !
dup 80 > if
DoVerticalContents
">> Whoa! Too many objects to show in Horizontal format." Tell
">> Your preference is still set to Horizontal format." Tell
exit
then
dup 1 = if
pop DoContentsLabel swap strcat Tell
else
dup 2 = if
pop swap " and " strcat swap strcat
DoContentsLabel swap strcat Tell
else
1 -
"and " rot strcat swap
begin
dup while
rot ", " strcat rot strcat
swap 1 -
repeat
pop
DoContentsLabel swap strcat Tell
then then
else (* this way for vertical lists *)
DoVerticalContents
then
;
: DoPrefHelp ( -- ) (* show help for user pref settings *)
me @
"Preferences control the formatting of what is shown when you look "
"at something. The syntax for setting preferences is:" strcat Tell
" " Tell
" look #prefs <option> = <yes|no>" Tell " " Tell
"Valid options are:" Tell " " Tell
" connections = <yes|no> ... Yes = show connection info w/ player names"
Tell
" details = <yes|no> ....... Yes = show detail lists with descs"
Tell
" exits = <yes|no> ......... Yes = show exit lists with descs"
Tell
" horizontal = <yes|no> .... Yes = format contents lists horizonatlly"
Tell
" static = <yes|no> ........ Yes = don't use variable descs"
Tell
" quell = <yes|no> ......... Yes = Do not show room descs in travel"
Tell " " Tell
"If you have preferences set to Quell room descs, you can still see the "
"description of a room by explicitly typing 'look here'. "
"Options and values do not have to be typed completely: the following "
"are equivalent commands:" strcat strcat strcat Tell " " Tell
" look #preferences connections = yes" Tell
" l #p c=y" Tell " " Tell
"Builders: set a room '_obv_exits:yes' to force exit lists." Tell
;
: DoDescHelp ( -- ) (* show help on dynamic descs *)
"Jlook supports 'dynamic descs' for rooms, using the following "
"rules: if you have seen a room five times or fewer, it shows the "
"full desc. If you have seen the room more than five times, and "
"have seen it at least once during the past week, and a brief desc "
"for the room is provided, it will only show the brief desc. If you "
"have seen the room more than 10 times, and at least once during the "
"past week, it will only show the room name. "
strcat strcat strcat strcat strcat strcat
"autolook_cmd" sysparm if
"Explicitly entering a 'look' or 'l' command will force "
"the full description. " strcat
else
"You can force look to show the full description by typing "
"'l' or 'look #full'. " strcat
then
strcat
"To enable dynamic descs, set the 'static' preference to 'no'. "
"Builders may set rooms _full_look:yes to force a full description."
strcat strcat Tell " " Tell
"autolook_cmd" sysparm if
" look ........................... Show full desc of your location"
else
" look #full ..................... Show full desc of your location"
then
Tell
" @bdesc ......................... Show brief desc of your location"
Tell
" @bdesc here = <brief desc> ..... Set a brief room desc"
Tell " " Tell
;
: DoLookatHelp ( -- ) (* show lookat help screen *)
"The '$command' command is used to look at objects or items carried "
"by another player." strcat command @ "$command" subst Tell " " Tell
"Syntax: $command <object>"
command @ "$command" subst Tell " " Tell
;
: DoHelp ( -- ) (* show help screen *)
me @ " " notify
prog name "(#" strcat prog intostr strcat ")" strcat Tell " " Tell
command @ "lookat" smatch if
DoLookatHelp exit
then
ourArg @ if
"prefs" ourArg @ stringpfx "#prefs" ourArg @ stringpfx
"preferences" ourArg @ stringpfx "#preferences" ourArg @ stringpfx
or or or if
DoPrefHelp exit
then
then
ourArg @ if
"descs" ourArg @ stringpfx "#descs" ourArg @ stringpfx or if
DoDescHelp exit
then
then
" look .................................. Show your location"
Tell
" look <obj|detail|item> ................ Show <obj|detail|item>"
Tell
" look #detail <obj>/<detail>=<desc> .... Create detail on <obj>"
Tell
"autolook_cmd" sysparm not if
" look #full ............................ Show full desc of room"
Tell
" l ..................................... Show full desc of room"
Tell
then
" look #item <obj>/<item>=<desc> ........ Create item on <obj>"
Tell
" look #mask <obj>/<detail|item> ........ Mask <detail|item>"
Tell
" look #!mask <obj>/<detail|item> ....... Unmask <detail|item>"
Tell
" look #!detail <obj>/<detail> .......... Remove <detail> from <obj>"
Tell
" look #!item <obj>/<item> .............. Remove <item> from <obj>"
Tell
trig name "+view" instr if
" +view ................................. List all unmasked details"
Tell
" +view <obj> ........................... List all details on <obj>"
Tell
" +view <obj>/<detail> .................. Show <detail> on <obj>"
Tell
then
" look #prefs <option>=<value> .......... Set pref <option> to <value>"
Tell " " Tell
"'Details' are lookable features of an object. 'Items' are false "
"objects. When masked, they do not appear in lists. Details and "
"Items may still be looked at when masked. See 'look #help prefs' "
"for help on user-preference configurations. See 'look #help descs' "
"for help on dynamic descs."
strcat strcat strcat strcat Tell
;
: DoSetPrefs ( -- ) (* set user's preferences *)
ourArg @ not if
DoPrefHelp exit
then
ourArg @ "=" instr if (* parse *)
ourArg @ dup "=" instr strcut strip
swap dup strlen 1 - strcut pop strip
ourArg !
else
"" ourArg @ strip ourArg !
then
"connections" ourArg @ stringpfx if (* turn con info off|on ... *)
"yes" over stringpfx if
"C" DoAddFlag pop
else
"no" swap stringpfx if
"C" DoDelFlag
else
">> The 'connections' option must be either 'yes' or 'no'" Tell
then
then
else
"exits" ourArg @ stringpfx if (* turn exit lists off|on ... *)
"yes" over stringpfx if
"E" DoAddFlag pop
else
"no" swap stringpfx if
"E" DoDelFlag
else
">> The 'exits' option must be either 'yes' or 'no'" Tell
then
then
else
"details" ourArg @ stringpfx if (* turn detail lists off|on ... *)
"yes" over stringpfx if
"D" DoAddFlag pop
else
"no" swap stringpfx if
"D" DoDelFlag
else
">> The 'details' option must be either 'yes' or 'no'" Tell
then
then
else (* turn horizonatl contents lists off|on ... *)
"horizontal" ourArg @ stringpfx if
"yes" over stringpfx if
"H" DoAddFlag pop
else
"no" swap stringpfx if
"H" DoDelFlag
else
">> The 'horizontal' option must be either 'yes' or 'no'" Tell
then
then
else
"quell" ourArg @ stringpfx if (* turn room desc quelling off|on ... *)
"yes" over stringpfx if
"Q" DoAddFlag pop
else
"no" swap stringpfx if
"Q" DoDelFlag
else
">> The 'quell' option must be either 'yes' or 'no'" Tell
then
then
else
"static" ourArg @ stringpfx if (* turn dynamic descs off|on ... *)
"yes" over stringpfx if
"S" DoAddFlag pop
else
"no" swap stringpfx if
"S" DoDelFlag
else
">> The 'static' option must be either 'yes' or 'no'" Tell
then
then
else
"Preference not found." Tell
then then then then then then
;
: DoShowBriefDesc ( -- ) (* show ourObj's short desc *)
ourObj @ not if
loc @ ourObj !
then
ourObj @ "_/bde" getpropstr if
ourObj @ "_/bde" DoParseThis
" " "%b" subst
"%" "%%" subst
" " "%t" subst
"%r" explode
begin
dup while
me @ rot pronoun_sub Tell
1 -
repeat
pop
else
ourObj @ room? not if
"You see nothing special." Tell
then
then
;
: DoSetBriefDesc ( -- ) (* set a brief description *)
ourArg ! ourArg @ if
"#help" ourArg @ stringpfx if DoDescHelp exit then
ourArg @ "=" instr if
ourArg @ dup "=" instr strcut
ourOpt !
strip dup strlen 1 - strcut pop strip ourArg !
ourArg @ not if
"Syntax: $command <room>=<brief description>"
command @ "$command" subst Tell exit
then
ourArg @ match
dup #-1 dbcmp if
"I don't see that here." Tell DoClearStack exit
then
dup #-2 dbcmp if
"I don't know which one you mean!" Tell DoClearStack exit
then
dup #-3 dbcmp if
"I don't see that here." Tell DoClearStack exit
then
ourArg !
me @ ourArg @ controls not if
"Permission denied." Tell DoClearStack exit
then
ourArg @ "_/bde" ourOpt @ setprop
"Brief description set." Tell
ourArg @ room? not if
"Note: brief descriptions on non-room objects have no effect."
Tell
then
else
"Syntax: $command <room>=<brief description>"
command @ "$command" subst Tell
then
else
DoShowBriefDesc
then
;
: DoSetMasked ( -- ) (* set a detail masked *)
ourArg @ "/" instr if (* parse *)
ourArg @ dup "/" instr strcut
strip swap strip
dup strlen 1 - strcut pop strip
DoOurMatch
me @ over controls not if (* check permission *)
"Permission denied." Tell exit
then
"_details/" rot strcat
over over getpropstr if
"_masked/" "_details/" subst
ourBool @ if
remove_prop
">> Detail unmasked." Tell
else
"1" setprop
">> Detail masked." Tell
then
else
"_items/" "_details/" subst
over over getpropstr if
"_masked/" "_items/" subst
ourBool @ if
remove_prop
">> Item unmasked." Tell
else
"1" setprop
">> Item masked." Tell
then
else
"I don't see that detail or item." Tell
then
then
else
">> Syntax: look #mask <object>/<detail>" Tell
then
;
: DoSetUnMasked ( -- ) (* unhide a detail *)
1 ourBool !
DoSetMasked
;
: DoSetDetail ( -- ) (* set a looktrap *)
ourArg @ "/" instr if
ourArg @ dup "=" instr strcut
strip swap
strip dup strlen 1 - strcut pop strip
dup "/" instr if
dup "/" instr strcut
strip swap
strip dup strlen 1 - strcut pop strip
DoOurMatch
me @ over controls not if
"Permission denied." Tell exit
then
dup exit? if
">> Sorry, you may not set details on an exit."
ourBool @ if "items" "details" subst then
Tell
then
dup program? if
">> Sorry, you may not set details on an program."
ourBool @ if "items" "details" subst then
Tell
then
ourBool @ if
"_items/"
else
"_details/"
then
rot DoInsertControls strcat rot setprop
">> Set." Tell
else
">> Syntax: look #detail <object>/<name>=<description>"
ourBool @ if "item" "detail" subst then
Tell
then
else
">> Syntax: look #detail <object>/<name>=<description>"
ourBool @ if "item" "detail" subst then
Tell
then
;
: DoSetItem ( -- ) (* set a false object *)
1 ourBool !
DoSetDetail
;
: DoDelDetail ( -- ) (* remove a looktrap *)
ourArg @ "/" instr if (* parse *)
ourArg @ dup "/" instr strcut
strip swap
strip dup strlen 1 - strcut pop strip
DoOurMatch (* match object *)
me @ over controls not if (* check permission *)
"Permission denied." Tell exit
then
ourBool @ if (* find detail|item *)
"_items/"
else
"_details/"
then (* remove... *)
rot DoInsertControls strcat over over getpropstr if
remove_prop
">> Set." Tell
else (* ... or notify couln't find *)
pop pop
">> I don't see what $thingamabob you want to remove."
ourBool @ if
"item"
else
"detail"
then
"$thingamabob" subst Tell
then
else
">> Syntax: look #!detail <object>/<name>=<description>"
ourBool @ if "item" "detail" subst then
Tell
then
;
: DoDelItem ( -- ) (* remove a false object *)
1 ourBool !
DoDelDetail
;
: DoExitList ( -- ) (* show list of obvious exits *)
me @ location "_obv_exits" getpropstr not if
me @ "_prefs/look/flags" (* check user's prefs *)
getpropstr "E" instr not if exit then
then
DoClearStack (* clear stack, just in case *)
ourObj @ exits
begin
dup while
dup "D" flag? if (* skip dark exits *)
next continue
then
dup getlink dup if (* skip unlinked exits *)
room? if
dup name DoMainName strip swap
then
else
pop
then
next
repeat
pop
depth if (* show results *)
depth 1 = if
"Exits: " swap strcat Tell
else
depth 2 = if
" and " strcat swap strcat "Exits: " swap strcat Tell
else
"and " swap strcat
begin
depth 1 > while
swap
", " strcat swap strcat
repeat
"Exits: " swap strcat Tell
then
then
then
;
: DoCommandList ( -- ) (* show list of commands in room *)
me @ location "_obv_exits" getpropstr not if
me @ "_prefs/look/flags" (* check user's prefs *)
getpropstr "E" instr not if exit then
then
DoClearStack (* clear the stack, just in case *)
ourObj @ exits
begin (* put command names on stack *)
dup while
dup "D" flag? if (* skip dark actions *)
next continue
then
dup getlink dup if (* skip unlinked actions *)
program? if
dup name DoMainName swap
then
else
pop
then
next
repeat
pop
depth if (* show results *)
depth 1 = if
"Commands: " swap strcat Tell
else
depth 2 = if
" and " swap strcat strcat
"Commands: " swap strcat Tell
else
"and " swap strcat
begin
depth 1 > while
swap
", " strcat swap strcat
repeat
"Commands: " swap strcat Tell
then
then
then
;
: DoDetailList ( -- ) (* show list of non-masked details *)
me @ "_prefs/look/flags" (* check user's prefs *)
getpropstr "D" instr not if exit then
ourObj @ not if
"Syntax: $command <object>"
command @ "$command" subst Tell exit
then
DoClearStack (* clear the stack, just in case *)
ourObj @ "_details/" nextprop
begin
dup while
ourObj @ over "_masked/" "_details/" subst getprop if
ourObj @ swap nextprop
continue
then
ourObj @ over nextprop
swap "" "_details/" subst DoRemoveControls DoMainName swap
repeat
pop
depth if (* show results *)
depth 1 = if
"Details: " swap strcat Tell
else
depth 2 = if
" and " swap strcat strcat
"Details: " swap strcat Tell
else
"and " swap strcat
begin
depth 1 > while
swap
", " strcat swap strcat
repeat
"Details: " swap strcat Tell
then
then
then
;
: DoShowDetailDesc ( d s -- ) (* show desc of details s on d *)
dup not if (* if we didn't find anything, notify with error & kill *)
pop pop
ourObj @ not if
me @ "I don't see that here." Tell pid kill
then
ourObj @ #-2 dbcmp if
me @ "I don't know which one you mean!" Tell pid kill
then
me @ "I don't see that here." Tell pid kill
then
(* show detail/item desc *)
DoParseThis
" " "%b" subst
"%" "%%" subst
" " "%t" subst
"%r" explode
begin
dup while
me @ rot pronoun_sub Tell
1 -
repeat
pop
;
: DoCheckDetailObj ( d -- s )
(* see if d holds detail|obj ourObj; return prop if so, or null str *)
dup (* check: is it a detail? *)
"_details/" nextprop
begin (* begin detail-checking loop *)
dup while
dup "" "_details/" subst
";" explode
begin (* begin detail-alias-checking loop *)
swap ourArg @ stringpfx if
begin (* begin extra-alias-popping loop *)
dup 1 = if
break
else
swap pop
then
1 -
repeat (* end extra-alias-popping loop *)
pop
1 break
then
1 -
dup while
repeat (* end detail-alias-checking loop *)
if break then
over swap nextprop
repeat (* end detail-checking loop *)
dup not if (* check: is it a false object? *)
pop dup
"_items/" nextprop
begin (* begin item-checking loop *)
dup while
dup "" "_items/" subst
";" explode
begin (* begin item-alias-checking loop *)
swap ourArg @ stringpfx if
begin (* begin extra-alias-popping loop *)
dup 1 = if
break
else
swap pop
then
1 -
repeat (* end extra-alias-popping loop *)
pop
1 break
then
1 -
dup while
repeat (* end item-alias-checking loop *)
if break then
over swap nextprop
repeat (* end item-checking loop *)
then
;
: DoDetailObj ( -- ) (* attempt to show object, detail, or item *)
ourArg @ not if (* check syntax *)
"Syntax: $command <object|item|detail>"
command @ "$command" subst Tell exit
then
ourArg @ "/" instr if (* parse args *)
ourArg @ dup "/" instr strcut strip
ourArg ! dup strlen 1 - strcut pop strip ourObj !
else
"here" ourObj !
then
ourObj @ "*'s" smatch if
ourObj @ dup strlen 2 - strcut pop
strip ourObj !
then
ourObj @ match (* match obj to look *)
dup #-1 dbcmp if
"I don't see that here." Tell pop exit
then
dup #-2 dbcmp if
"I don't know which one you mean!" Tell pop exit
then
dup #-3 dbcmp if
"I don't see that here." Tell pop exit
then
ourObj !
(* check: is it an object in ourObj? *)
ourArg @ DoInsertControls ourArg !
ourObj @ DoCheckDetailObj dup if
DoShowDetailDesc
else
pop ourObj @ contents
begin
dup while
dup name ourArg @ stringpfx if
dup "D" flag? if
"You can't see that clearly." Tell pop pop exit
else
"_/de" DoParseThis Tell
pop exit
then
then
next
repeat
pop
"I don't see that here." Tell
then
;
: DoLookat ( -- ) (* attempt to show object, detail, or item *)
ourArg @ not if (* check syntax *)
"Syntax: $command <object>"
command @ "$command" subst Tell exit
then
ourArg @ " " instr if (* parse args *)
ourArg @ dup " " instr strcut strip
ourArg ! strip ourObj !
else
ourArg @ ourObj !
then
ourObj @ "*'s" smatch if
ourObj @ dup strlen 2 - strcut pop
strip ourObj !
then
ourObj @ match (* match obj to look *)
dup #-1 dbcmp if
"I don't see that here." Tell pop exit
then
dup #-2 dbcmp if
"I don't know which one you mean!" Tell pop exit
then
dup #-3 dbcmp if
"I don't see that here." Tell pop exit
then
ourObj !
(* check: is it an object in ourObj? *)
ourArg @ DoInsertControls ourArg !
ourObj @ DoCheckDetailObj dup if
DoShowDetailDesc
else
pop ourObj @ contents
begin
dup while
dup name ourArg @ stringpfx if
dup "D" flag? if
"You can't see that clearly." Tell pop pop exit
else
"_/de" DoParseThis Tell
pop exit
then
then
next
repeat
pop
"Syntax: $command <object>"
command @ "$command" subst Tell
"Object not found." Tell exit
then
;
: DoShowViewList ( strrng -- ) (* show +view results *)
dup if
ourObj @ loc @ dbcmp if
">> Viewable details for this location:"
else
">> Viewable details for $name:"
ourObj @ if
ourObj @ name
else
"this location"
then
"$name" subst
then
Tell
me @ " " notify
begin
dup while
swap Tell
1 -
repeat
pop
else
ourObj @ if
">> There are no obvious details on $name."
ourObj @ name "$name" subst Tell
else
">> There are no obvious details here." Tell
then
then
;
: DoGetViewLines ( d -- [s1 s2 ... sx )
(* put a view entry string on stack for each detail on d *)
dup "_details/" nextprop
begin
dup while
over over "_masked/" "_details/" subst getpropstr not if
dup "" "_details/" subst DoRemoveControls DoMainName
" :: " swap strcat
3 pick dup loc @ dbcmp if
pop " Here"
else
name DoMainName " " swap strcat
then
swap strcat
rot rot
then
over swap nextprop
repeat
pop pop
;
: DoView ( -- ) (* view or get list of details, MUSH syntax *)
DoClearStack
1 ourBool !
ourArg @ not if
loc @ contents ourObj !
begin
ourObj @ while
ourObj @ DoGetViewLines
ourObj @ next ourObj !
repeat
depth DoSortStrings-d
loc @ DoGetViewLines
depth DoShowViewList
else
ourArg @ "/" instr if
0 ourBool !
ourArg @ dup "/" instr strcut strip DoInsertControls ourArg !
strip dup strlen 1 - strcut pop strip
DoOurMatch ourObj !
ourObj @ "_details/" nextprop
begin (* begin detail-checking loop *)
dup while
dup "" "_details/" subst
";" explode
begin (* begin detail-alias-checking loop *)
swap ourArg @ stringpfx if
begin (* begin extra-alias-popping loop *)
dup 1 = if
break
else
swap pop
then
1 -
repeat (* end extra-alias-popping loop *)
pop
1 break
then
1 -
dup while
repeat (* end detail-alias-checking loop *)
if break then
ourObj @ swap nextprop
repeat (* end detail-checking loop *)
ourObj @ swap DoShowDetailDesc
else
ourArg @ strip
DoOurMatch ourObj !
ourObj @ DoGetViewLines
depth DoShowViewList
then
then
;
: DoShowFullDesc ( -- ) (* show ourObj's complete desc *)
ourObj @ "_/de" getpropstr if
ourObj @ "_/de" DoParseThis
" " "%b" subst
"%" "%%" subst
" " "%t" subst
"%r" explode
begin
dup while
me @ rot pronoun_sub Tell
1 -
repeat
pop
else
ourObj @ room? not if
"You see nothing special." Tell
then
then
;
: DoLook ( -- ) (* do a look *)
ourArg @ match ourObj ! (* find obj/detail to look at *)
ourObj @ #-1 dbcmp if (* if we can't find as object, try details *)
DoDetailObj exit
then
ourObj @ #-2 dbcmp if
DoDetailObj exit
then
ourObj @ room? if (* for rooms, show room name *)
me @ ourObj @ controls if
me @ ourObj @ unparseobj Tell
else
me @ ourObj @ name Tell
then
then
(* show desc if needed *)
ourObj @ room? if
me @ "_prefs/look/flags" getpropstr "Q" instr not
ourBool @ or if (* ourBool is true if user supplied arg *)
"autolook_cmd" sysparm if
"autolook_cmd" sysparm command @ smatch not
else
command @ "look" smatch not
then
me @ "_prefs/look/fulllook" getpropstr or
me @ "_prefs/look/flags" getpropstr "S" instr or
me @ location "_full_look" getpropstr or and if
DoShowFullDesc
else
me @ "_prefs/look/roomscount/" ourObj @ intostr strcat
getprop dup if
dup 5 <= if
pop DoShowFullDesc
else
10 <= if
ourObj @ "_/bde" getpropstr if
DoShowBriefDesc
else
DoShowFullDesc
then
then
then
else
pop DoShowFullDesc
then
then
then
else
DoShowFullDesc
then
me @ "_prefs/look/roomstimes/" nextprop
begin
dup while
me @ over getprop systime 604800 - < if
me @ over "roomscount" "roomstimes" subst remove_prop
me @ over nextprop
me @ rot remove_prop
else
me @ swap nextprop
then
repeat
pop
me @ "_prefs/look/roomscount/" nextprop
begin
dup while
dup "" "_prefs/look/roomscount/" subst atoi dbref ok? not if
me @ over "roomstimes" "roomscount" subst remove_prop
me @ over nextprop
me @ rot remove_prop
continue
then
dup "" "_prefs/look/roomscount/" subst atoi dbref room? not if
me @ over "roomstimes" "roomscount" subst remove_prop
me @ over nextprop
me @ rot remove_prop
continue
then
me @ swap nextprop
repeat
pop
ourObj @ room? if
me @ "_prefs/look/roomstimes/"
ourObj @ intostr strcat systime setprop
me @ "_prefs/look/roomscount/"
ourObj @ intostr strcat over over
getprop 1 + setprop
then
(* show exit list if needed *)
ourObj @ room? if
DoExitList
DoCommandList
then
(* show detail list if needed *)
me @ "_prefs/look/flags" getpropstr "D" instr
ourObj @ program? not ourObj @ exit? not and and if
DoDetailList
then
ourObj @ room? (* show contents *)
ourObj @ "D" flag?
me @ ourObj @ controls not and and not if
DoGetContents
dup if
DoContents
else
pop
then
then
me @ "_prefs/look/fulllook" remove_prop
;
: DoFullLook ( -- ) (* force a full look *)
ourArg @ not if "here" ourArg ! then
me @ "_prefs/look/fulllook" "yes" setprop
DoLook
;
: main
"me" match me !
prog "_version" getprop not if
DoInitProgram
then
me @ "_prefs/look/version" getprop not if
DoInitPlayer
then
command @ "{@briefdesc|@bdesc|@brief}" smatch if
DoSetBriefDesc exit
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
"#prefs" ourOpt @ stringpfx if DoSetPrefs else
"#full" ourOpt @ stringpfx if DoFullLook else
"#brief" ourOpt @ stringpfx if DoShowBriefDesc else
"#preferences" ourOpt @ stringpfx if DoSetPrefs else
"#details" ourOpt @ stringpfx if DoSetDetail else
"#!details" ourOpt @ stringpfx if DoDelDetail else
"#items" ourOpt @ stringpfx if DoSetItem else
"#!items" ourOpt @ stringpfx if DoDelItem else
"#mask" ourOpt @ stringpfx if DoSetMasked else
"#unmask" ourOpt @ stringpfx if DoSetUnMasked else
"#!mask" ourOpt @ stringpfx if DoSetUnMasked else
ourOpt @ ourArg ! DoLook
then then then then then then then then then then then then
else
ourArg !
command @ "lookat" smatch if
DoLookat exit
then
command @ "+view" smatch if
DoView
else
command @ "lookat" smatch if
DoDetailObj
else
1 ourBool !
DoLook
then
then
then
else
command @ "+view" smatch if
DoView
else
pop "here" ourArg !
command @ "lookat" smatch if
DoDetailList
else
DoLook
then
then
then
;
.
c
q