@q
@program lookfar.muf
1 99999 d
i 
( lookfar.muf   v1.0   Jessy @ FurryMUCK   8/99
  
  This utility gives remote-look capability to designated non-wizard
  players. It uses the standard format for the type of object looked
  at -- for example, rooms list 'Contents' and players list 'Carrying',
  -- but not all niceties of a full-blown look program are implemented.
  
  INSTALLATION:
  
  Set the program Wizard, and link a global action to it. Lookfar.muf
  requires lib-reflist and a .tell macro, both of which should be
  set up on any established MUCK.
  
  USAGE:
  
    <cmd> <player|#obj> ........... Look at <player|#obj>
    <cmd> #add <player> ........... Authorize player to use command
    <cmd> #delete <player> ........ Remove <player> from authorized list
  
  The #add and #delete options are wizard-only.
  
  Lookfar.muf may be freely ported. Please comment any changes.
)
  
$include $lib/reflist
  
lvar ourArg
lvar ourBoolean
  
: ParseThis  ( d s -- s )        (* returns d's prop s, parsed for MPI *)
 
   dup 3 pick swap getpropstr 0 parseprop
;
  
: DoHelp  (  --  )                                 (* show help screen *)
  
  " " .tell
  prog name " (#" strcat prog intostr strcat ")" strcat .tell " " .tell
  
  "A utility that lets designated player look at players and objects "
  "specified by #dbref remotely." strcat .tell " " .tell
  
  "Syntax:  " .tell  " " .tell
  
  "  " command @ strcat " <player|obj> ..............." strcat 
  35 strcut pop
  " Look at <player|obj>" strcat .tell
  "  " command @ strcat " #add <player> .............." strcat
  35 strcut pop
  " Authorize <player> to use this command." strcat .tell
  "  " command @ strcat " #delete <player> ..........." strcat
  35 strcut pop
  " Remove <player> from authorized list." strcat .tell " " .tell
  
  "The #add and #delete options are wizard-only." .tell
;
  
: DoAdd  (  --  )             (* add designated player to auth'd list *)
  
  me @ "W" flag? if
    ourArg @ " " instr if
      ourArg @ dup " " instr strcut swap pop strip ourArg !
    else
      "Syntax:  " command @ strcat " #add <player>" strcat .tell exit
    then
    ourArg @ .pmatch dup if
      ourArg !
    else
      "I can't find that player." .tell pop
    then
    prog "~auth" ourArg @ REF-add
    ourArg @ name " added to authorized list." strcat .tell
  else
    "Permission denied." .tell
  then
;
  
: DoDelete  (  --  )     (* remove designated player from auth'd list *)
     
   me @ "W" flag? if
    ourArg @ " " instr if
      ourArg @ dup " " instr strcut swap pop strip ourArg !
    else
      "Syntax:  " command @ strcat " #delete <player>" strcat .tell exit
    then
    ourArg @ .pmatch dup if
      ourArg !
    else
      "I can't find that player." .tell pop
    then
    prog "~auth" ourArg @ REF-delete
    ourArg @ name " removed from authorized list." strcat .tell
  else
    "Permission denied." .tell
  then 
;
  
: DoLookFar  (  --  )           (* look at an object, local or remote *)
     
  me @ "W" flag?                                  (* check permission *)
  prog "~auth" me @ REF-inlist? or not if
    "Permission denied." .tell pid kill
  then
 
  ourArg @ .pmatch dup if                              (* find object *)
    ourArg !
  else
    pop ourArg @ match dup if
      ourArg !
    else
      pop "I don't see that." .tell exit
    then
  then
  
  ourArg @ room? if                    (* preface with name for rooms *)
    me @ ourArg @ controls if
      ourArg @ unparseobj
    else
      ourArg @ name
    then
    .tell
  then
  
  ourArg @ "_/de" ParseThis        (* get desc; parse for mpi; notify *)
  dup if
    .tell
  else
    "You see nothing special." .tell
  then
  
  0 ourBoolean !
  ourArg @ contents dup if                           (* list contents *)
    begin
      dup while
      dup "D" flag?
      me @ 3 pick controls not and if
        next continue
      then
      dup program?
      me @ 3 pick controls not and if
        next continue
      then
      1 ourBoolean !
      next
    repeat
    pop
    ourBoolean @ not if exit then
    ourArg @ contents
    ourArg @ player? if
      "Carrying:" .tell
    else
      "Contents:" .tell
    then
    begin
      dup while
      dup "D" flag?
      me @ 3 pick controls not and if
        next continue
      then
      dup program?
      me @ 3 pick controls not and if
        next continue
      then
      dup me @ over controls if
        unparseobj
      else
        name
      then
      .tell
      next
    repeat
  else
    pop
  then
;
  
: main
  
  "me" match me !
  dup if
    strip ourArg !
    ourArg @ "#h" stringpfx if DoHelp   exit else
    ourArg @ "#a" stringpfx if DoAdd    exit else
    ourArg @ "#d" stringpfx if DoDelete exit else
    DoLookFar
    then then then
  else
    pop "here" ourArg !
    DoLookFar
  then
;
.
c
q