@program #115
1 10000 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

----
Loxorion's changes
----
Colorized the primary look.

)

( Include my libs )
$include $lib/loxorion

$define ourVersion "1.0" $enddef

( And parse any colors we find )
$define Tell me @ swap -1 parse_ansi notify $enddef

( Color definitions )
$def color.room { "^" me @ "_prefs/color/room" getprop dup not if pop "CYAN" then "^" }cat
$def color.exit { "^" me @ "_prefs/color/exit" getprop dup not if pop "GREEN" then "^" }cat
$def color.obj { "^" me @ "_prefs/color/obj" getprop dup not if pop "PURPLE" then "^" }cat
$def color.player { "^" me @ "_prefs/color/player" getprop dup not if pop "YELLOW" then "^" }cat
$def color.stat { "^" me @ "_prefs/color/stat" getprop dup not if pop "PURPLE" then "^" }cat
$def color.normal "^NORMAL^"

$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 )
  ourObj @ "D" flag? me @ "W" flag? not me @ "Q" flag? and and if "" 0 exit then
                              (* 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 { color.player rot unparseobj color.normal }cat
      else
        dup { color.player rot name color.normal }cat
      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
            { color.stat " [idle]" color.normal }cat
          else
            { color.stat " [awake]" color.normal }cat
          then
        else
          { color.stat " [asleep]" color.normal }cat
        then
        strcat
        swap pop
      else
        swap pop
      then
    else
      me @ over controls if
        { color.obj rot unparseobj color.normal }cat
      else
        { color.obj rot name color.normal }cat
      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 *)
  dup 0 = if popn exit then
  me @ "_prefs/look/flags" getpropstr "H" instr
  prog "_prefs/look/flags" getpropstr "H" instr or 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 { color.exit rot color.normal }cat strcat Tell
    else
      depth 2 = if
        { color.exit rot color.normal }cat " and " strcat swap { color.exit rot color.normal }cat strcat "Exits: " swap strcat Tell
      else
        "and " swap { color.exit rot color.normal }cat strcat
        begin
          depth 1 > while
          swap { color.exit rot color.normal }cat
          ", " 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 { color.exit rot color.normal }cat strcat Tell
    else
      depth 2 = if
        { color.exit rot color.normal }cat " and " swap { color.exit rot color.normal }cat strcat strcat
        "Commands: " swap strcat Tell
      else
        " and " { color.exit rot color.normal }cat swap strcat
        begin
          depth 1 > while
          swap
          { color.exit rot color.normal }cat ", " 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

  (* Changed by Lox, always show name and colorize *)
  ourobj @ case
   room?   when { color.room ourobj @ me @ ourObj @ controls if unparseobj else name then color.normal }cat end
   exit?   when { color.exit ourobj @ me @ ourObj @ controls if unparseobj else name then color.normal }cat end
   player? when { color.player ourobj @ me @ ourObj @ controls if unparseobj else name then color.normal }cat end
   thing?  when { color.obj ourobj @ me @ ourObj @ controls if unparseobj else name then color.normal }cat end
   default pop  { color.stat ourobj @ me @ ourObj @ controls if unparseobj else name then color.normal }cat end
  endcase 
  Tell
                                               (* 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 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