@program cmd-where
1 9999 d
i
( Cmd-Where    v1.0    Jessy @ FurryMUCK    5/97
  
  A player-location utility well suited to small to mid-size
  MUCKS. For a large social MUCK, it would be quite spammy.
  
  INSTALLATION:
  
  Set the program M3 and link a global action to it. Cmd-where
  requires lib-reflist, lib-strings, and lib-edit, and a .pmatch
  macro, all of which should be available on an established MUCK.
  
  Also, the output includes a column for 'IC' or 'OOC'. The program
  uses prop IC? for this data. WhoSpecies Clone, by Kahz @ Furtoonia
  uses this prop, so it's recommended that you use cmd-where along
  with this version of WhoSpec, or that you create a separate program
  that stores values such as 'IC' and 'OOC' in prop 'IC?' located on
  the player.
  
  USE:
  
    .......................Show locations for all findable players
     ..............Show location for 
     #private..............Hide from all players
     #private .....Hide from 
     #private #here........Make room private; occupants are hidden
     #!private.............Don't hide from all players
     #!private ....Don't hide from 
     #!private #here.......Make room public; occupants are not hidden
 
  Arguments do not have to be typed completely: '#!private dalua', 
  '#!pri dalua', and '#!p dalua' are equivalent.  Data for cmd-where is 
  stored in your _prefs/find directory.
  
  Wizards see locations for all players; those which would be unfindable
  for them if they were quelled are marked with an * asterix.
  
  Cmd-where may be freely ported. Please comment any changes.
)
 
$include $lib/reflist
$include $lib/strings
$include $lib/edit
 
lvar ourString
lvar ourArg
lvar ourCounter
lvar ourBoolean
 
: MatchPlayer  ( s -- d )                 (* returns dbref of player s *)
    
    dup .pmatch dup if
        swap pop
    else
        swap
        "I can't find a player named '" swap strcat "'." 
        strcat .tell
    then
;
 
: Pad  ( s i -- s )                         (* pad string s to i chars *)
                             (* Pads are often done in loops; use the
                                cheaper but limited-length method of
                                cat/cutting a string, rather than loop *)
    swap
    "                                                                   "
    strcat
    swap strcut pop
;
  
: LPad  ( s i -- s )           (* pad string s to i chars, spaces left *)
    swap
    "                                                                   "
    swap strcat dup strlen rot - strcut swap pop
;
   
: FormatIdleTime
    
    dup 86400 >= if
        86400 / intostr "d" strcat
    else
    dup 3600 >= if
        3600 / intostr "h" strcat
    else
    dup 60 >= if
        60 / intostr "m" strcat
    else
        intostr "s" strcat
    then then then
    4 LPad
;
    
: MakeLine
    
    dup "*%%%" smatch if
        1 ourBoolean !
        dup strlen 3 - strcut pop
    else
        0 ourBoolean !
    then
    ";" STRrsplit atoi dbref 
    dup name ourBoolean @ if 
        "*" strcat
    then
    17 Pad
    over "IC?" getpropstr dup not if
         pop "  " 
    then
    5 Lpad dup strlen 5 - strcut swap pop strcat 18 Pad
    swap descriptors
    999999999999 ourString !                   (* ok, so it's an int.. *)
    begin
        dup while
        over ourString @ < if
            over descrcon conidle ourString !
        then
        swap pop 1 -
    repeat
    pop ourString @ FormatIdleTime strcat 24 Pad
    ourCounter @ strcat 46 Pad
    swap strcat  78 Pad
;
 
: DoHelp  (  --  )           (* @toad user; @recycle 12 random objects *)
    
    " " .tell
    prog name " (#" strcat prog intostr strcat ")" strcat .tell " " .tell
    
    "A player locating utility." .tell " " .tell
    
    "  " command @ strcat command !
    command @ "..........................." strcat 34 strcut pop
    "Show locations for all findable players" strcat .tell
    command @ " .................." strcat 34 strcut pop
    "Show location for " strcat .tell
    command @ " #private.................." strcat 34 strcut pop
    "Hide from all players" strcat .tell
    command @ " #private ........." strcat 34 strcut pop
    "Hide from " strcat .tell
    command @ " #private #here............" strcat 34 strcut pop
    "Make room private; occupants are hidden" strcat .tell
    command @ " #!private................." strcat 34 strcut pop
    "Don't hide from all players" strcat .tell
    command @ " #!private ........" strcat 34 strcut pop
    "Don't hide from " strcat .tell 
    command @ " #private #here............" strcat 34 strcut pop
    "Make room public; occupants are not hidden" strcat .tell
    command @ " #alt ..............." strcat 34 strcut pop
    "Change how room name appears on screen" strcat .tell
    command @ " #alt......................" strcat 34 strcut pop
    "Remove alternate room name" strcat .tell
    " " .tell
    "Arguments do not have to be typed completely: '#!private dalua', "
    "'#!pri dalua', and '#!p dalua' are equivalent. " 
    "Data for cmd-where is stored in your _prefs/find directory." 
    strcat strcat .tell
;
 
: DoPrivate  (  --  )             (* set user private, from all or one *)
    
    me @ "guest_player?" getprop if
        "Sorry, guests can't do that." .tell exit
    then
    ourString @ if
        ourString @ "#here" smatch if
            me @ dup location controls not if
                "Permission denied." .tell exit
            then
            me @ location "_prefs/find/hide-all" "yes" setprop
            "Room set private." .tell exit
        then
        ourString @ "#all" smatch not if
            ourString @ MatchPlayer dup not if
               exit
            then
            me @ "_prefs/find/hide-from" 3 pick REF-add
            "You are now hidden from " swap name strcat "." 
            strcat .tell exit
        then
    then
    me @ "_prefs/find/hide-all" "yes" setprop
    "You are now hidden." .tell
;
  
: DoNotPrivate  (  --  )       (* set user not private, for all or one *)
    
    me @ "guest_player?" getprop if
        "Sorry, guests can't do that." .tell exit
    then
    ourString @ if
        ourString @ "#here" smatch if
            me @ dup location controls not if
                "Permission denied." .tell exit
            then
            me @ location "_prefs/find/hide-all" remove_prop
            "Room set not-private." .tell exit
        then
        ourString @ "#all" smatch not if
            ourString @ MatchPlayer dup not if
               exit
            then
            me @ "_prefs/find/hide-from" 3 pick REF-delete
            "You are now not hidden from " swap name strcat "." 
            strcat .tell exit
        then
    then
    me @ "_prefs/find/hide-all" remove_prop
    "You are now not hidden." .tell
;
 
: DoAltName
    
    me @ dup location controls not if
        "Permission denied." .tell exit
    then
    me @ location "_wherename"
    ourString @ if
        ourString @ setprop
        "Alternate name set." .tell
    else
        remove_prop
        "Alternate name removed." .tell
    then
;
 
: DoFindOne  ( s --  )                 (* show location for one player *)
    
    MatchPlayer dup not if                              (* find player *)
        pop exit
    then
                                                   (* check: findable? *)                        
    dup awake? not
    me @ "W" flag? not and if
        name " is not online." strcat .tell exit
    then
    
    dup "D" flag?
    over "_prefs/find/hide-all" envpropstr swap pop or
    over "_prefs/find/hide-from" me @ REF-inlist? or if
        me @ "W" flag? if
            1 ourBoolean !
        else
            name " is unfindable." strcat .tell exit
        then
    then
                                                       (* display info *)
"NAME_______IC/OOC_IDLE__AREA__________________LOCATION__________________"
    .tell
    dup "_area" envpropstr swap pop dup not if
        pop "---"
    then
    ourCounter !
    
    dup location name ";" strcat
    swap intostr strcat
    ourBoolean @ if
        "%%%" strcat
    then
    MakeLine .tell
;
 
: MakeDataString  (  --  )         (* construct area/room/dbref string *)
    
    dup "_area" envpropstr swap pop dup not if
        pop "---;"
    else
        ";" strcat
    then
    over location 
    
    dup "_wherename" getpropstr dup if
        swap pop
    else
        pop name 
    then
    ";" strcat
    rot intostr strcat strcat
    ourBoolean @ if                     (* tack this on if target is    )
        "*%%%" strcat                   (  unfinable but user is a wiz *)
    then
    over 1 + put
;
 
: DoAreaLoop  (  --  )               (* display players within an area *)
   
                                 (* explode into separate data strings *)
    ourString @ "^_~-" explode dup ourArg !
    begin                                (* BEGIN STRING-TRIMMING LOOP *)
        dup 1 > while                 (* pop off area... sort by rooms *)
        dup pick
        ";" STRsplit swap pop
        over put
        1 -
    repeat                                 (* END STRING-TRIMMING LOOP *)
            
    pop ourArg @ rotate pop            (* display info for each player *)
    ourArg @ 1 - 1 0 EDITsort
    begin                                        (* BEGIN DISPLAY LOOP *)
        dup while
        swap MakeLine .tell
        1 -
    repeat                                         (* END DISPLAY LOOP *)
    pop
;
 
: DoFindAll  (  --  )   (* show location info for all findable players *)
    
"NAME_______IC/OOC_IDLE__AREA__________________LOCATION__________________"
    .tell                                 (* put online users on stack *)
    online dup depth 1 - put
                                             (* filter out unfindables *)
    begin
        dup while
        dup 1 + pick
        dup "D" flag?
        over "_prefs/find/hide-all" envpropstr swap pop or
        over "_prefs/find/hide-from" me @ REF-inlist? or not if
            0 ourBoolean !
            MakeDataString
        else
            me @ "W" flag? if
                1 ourBoolean !
                MakeDataString 
            else
                pop dup 1 + rotate pop
                dup depth pick 1 - depth 1 - put
                pop
            then
        then
        1 - 
    repeat
    pop
                                                      (* sort by area *)
    depth pick 1 0 EDITsort
    
    over ";" STRsplit pop ourCounter !
    
    "" ourString !
                      (* make stack range of all within a single area *)
                                   (* then go sort by room and notify *)
    begin                                 (* BEGIN ROOM-FETCHING LOOP *)
        dup 0 >= while
        over string? not if
            DoAreaLoop exit
        then
        over ourCounter @ stringpfx not if
            DoAreaLoop
            depth pick ourArg @ 1 - - depth 1 - put
            "" ourString !
            over ";" STRsplit pop ourCounter !
            continue
        then
        ourString @ rot strcat "^_~-" strcat ourString !
        1 -
    repeat                                  (* END ROOM-FETCHING LOOP *)
    pop 
    
    "Done" .tell
; 
 
: main
    
    "me" match me !
    dup if
        " " STRsplit ourString ! dup ourArg !
        dup "#help"     swap stringpfx if DoHelp       else
        dup "#private"  swap stringpfx if DoPrivate    else
        dup "#!private" swap stringpfx if DoNotPrivate else
        dup "#alt"      swap stringpfx if DoAltName    else
                                          DoFindOne
        then then then then
        exit
    then
    DoFindAll
;
.
c
q