@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:
<cmd>.......................Show locations for all findable players
<cmd> <player>..............Show location for <player>
<cmd> #private..............Hide from all players
<cmd> #private <player>.....Hide from <player>
<cmd> #private #here........Make room private; occupants are hidden
<cmd> #!private.............Don't hide from all players
<cmd> #!private <player>....Don't hide from <player>
<cmd> #!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 @ " <player>.................." strcat 34 strcut pop
"Show location for <player>" strcat .tell
command @ " #private.................." strcat 34 strcut pop
"Hide from all players" strcat .tell
command @ " #private <player>........." strcat 34 strcut pop
"Hide from <player>" 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 <player>........" strcat 34 strcut pop
"Don't hide from <player>" strcat .tell
command @ " #private #here............" strcat 34 strcut pop
"Make room public; occupants are not hidden" strcat .tell
command @ " #alt <name>..............." 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