@q
@program findwho.muf
1 9999 d
i
( findwho.muf v1.0 Jessy @ FurryMUCK 2/01
A who/WHO utility that allows filtering by species or other prop.
INSTALLATION:
Port the program and link a global exit with a name such as 'who'
to it.
USE:
who ....................... List online players in current room
who #all .................. List all online players
who #find ................. Display info on #find option
who #find <species> ....... List online <species> players
who #find <prop>=<val> .... List online players with <prop> of <val>
who #info <string> ........ Set your entry for the Info column
who #info ................. Clear your entry for the Info column
who #prop <prop> .......... Allow filter searches for <prop> [Wiz]
who #!prop <prop> ......... Disallow filter searches for <prop> [Wiz]
Filtering or searching by the 'species' prop is always allowed. Other
props must be explicitly enabled by a wiz.
findwho.muf may be freely ported, copied, or modified. Please comment
any changes.
)
(2345678901234567890123456789012345678901234567890123456789012345678901)
lvar ourArg (* str: cmd arg *)
lvar ourBoo (* int: 0|1 *)
lvar ourCon (* int: connection number *)
lvar ourObj (* dbref: player|puppet *)
lvar ourOpt (* str: cmd #option *)
lvar ourStr (* str: workspace var *)
lvar ourVal (* str: workspaece var *)
$define Tell me @ swap notify $enddef
$define NukeStack begin depth while pop repeat $enddef
: DoHeader ( -- ) (* display column heads *)
"Player Sex Species Info" Tell
"-----------------------------------------------------------------------------"
Tell
;
: DoSortStrings-r ( s ... s' i -- s .... s' )
(* bubble sort range of strings, reverse order *)
dup
begin (* begin outer loop *)
dup while (* iterate as many times as items in range *)
over
begin (* begin inner loop *)
dup 1 > while (* iterate up through range *)
dup 3 + pick over 3 + pick
over over strcmp 0 > if (* compare; swap if necesarry *)
swap
then
3 pick 3 + put (* put sorted pair back in place *)
over 3 + put
1 - (* decrement inner loop *)
repeat (* end inner loop *)
pop (* pop inner loop counter *)
1 - (* decrement outer loop *)
repeat (* end outer loop *)
pop pop (* pop outer loop counter and range indicator *)
;
: DoSortStrings ( s ... s' i -- s .... s' )
(* bubble sort range of strings *)
dup
begin (* begin outer loop *)
dup while (* iterate as many times as items in range *)
over
begin (* begin inner loop *)
dup 1 > while (* iterate up through range *)
dup 3 + pick over 3 + pick
over over strcmp 0 < if (* compare; swap if necesarry *)
swap
then
3 pick 3 + put (* put sorted pair back in place *)
over 3 + put
1 - (* decrement inner loop *)
repeat (* end inner loop *)
pop (* pop inner loop counter *)
1 - (* decrement outer loop *)
repeat (* end outer loop *)
pop pop (* pop outer loop counter and range indicator *)
;
: DoPad ( s i -- s' ) (* pad string s to i characters *)
" "
rot swap strcat swap strcut pop
;
: remove_dir ( d s -- ) (* remove dir s from d; leave subdirs *)
dup "*/" smatch not if
"/" strcat
then
over over nextprop swap pop
begin
dup while
over over nextprop
3 pick rot "" setprop
repeat
pop pop
;
: 3-col ( {rng} i -- )
(* output the i top things on the stack in 3 columns; top item on
stack will be shown last *)
dup 3 % (* fill to multiple of 3 *)
dup 1 = if
pop 2 + " " " " rot
else
dup 2 = if
pop 1 + " " swap
else
pop
then
then
(* get next 3; format; show *)
begin (* begin get-next-three loop *)
dup 3 > while
dup 1 + rotate swap
dup 1 + rotate swap
dup 1 + rotate swap
4 rotate 24 DoPad
4 rotate 24 DoPad strcat
3 rotate 24 DoPad strcat
" " swap strcat me @ swap notify
3 -
repeat (* end get-next-three loop *)
pop
(* format and show last 3 *)
rot 24 DoPad rot 24 DoPad strcat swap strcat " " swap strcat
me @ swap notify
;
: DoMakeLine ( d -- s ) (* format data line for player|puppet d *)
dup name
over player? if
over descriptors dup not if
pop "[asleep]"
else
0 ourBoo !
begin
dup while
swap descrcon conidle 300 > if
1 ourBoo !
then
1 -
repeat
pop
ourBoo @ if "[idle]" else "" then
then
else
over owner name "[" swap strcat "]" strcat
then
strcat 22 DoPad
over "sex" getpropstr dup not if pop "---" then strcat
34 DoPad
over "species" getpropstr dup not if pop "---" then strcat
46 DoPad
swap "_prefs/findwho/info" getpropstr strcat
;
: DoHelp ( -- ) (* display help screen *)
prog name "(#" strcat prog intostr strcat ")" strcat Tell " " Tell
" %com ....................... List players & puppets in current room"
command @ "%com" subst Tell
" %com #all .................. List all online players"
command @ "%com" subst Tell
" %com #find ................. Display info on #find option"
command @ "%com" subst Tell
" %com #find <species> ....... List online <species> players"
command @ "%com" subst Tell
" %com #find <prop>=<val> .... List online players with <prop> of <val>"
command @ "%com" subst Tell
" %com #info ................. Clear your entry for the Info column"
command @ "%com" subst Tell
" %com #info <string> ........ Set your entry for the Info column"
command @ "%com" subst Tell
" %com #prop <prop> .......... Allow filter searches for <prop> (Wiz)"
command @ "%com" subst Tell
" %com #!prop <prop> ......... Disallow filter searches for <prop> (Wiz)"
command @ "%com" subst Tell
;
: DoSetInfo ( -- ) (* set or clear info entry *)
"#info" ourArg @ stringpfx if
me @ "_prefs/findwho/info" remove_prop
">> Info string cleared." Tell
else
me @ "_prefs/findwho/info" ourArg @ setprop
">> Info string set." Tell
then
;
: DoAllowProp ( -- ) (* add a prop to the 'allowed to search list *)
me @ "W" flag? not if (* check permission *)
"Permission denied." Tell exit
then
ourArg @ if
ourArg @ "@*" smatch (* check and warn for wiz props *)
ourArg @ "/@" instr or
prog "W" flag? not and if
">> recommended."
">> NOTE: Allowing players to check the "
"value of wiz-only props is *not*" strcat
">> for that property."
">> ERROR: This program must be set "
"Wizard in order to allow searches" strcat
Tell Tell Tell Tell
else (* set prop *)
prog "_props/" ourArg @ strcat "yes" setprop
">> Property set."
then
else (* show syntax if needed *)
">> Syntax: %cmd #prop <prop to allow searches for>"
command @ "%cmd" subst Tell
then
;
: DoNoAllowProp ( -- ) (* remove a prop from the 'allowed' list *)
me @ "W" flag? not if (* check permission *)
"Permission denied." Tell exit
then
ourArg @ if (* remove prop *)
prog "_props/" ourArg @ strcat remove_prop
">> Property removed." Tell
else (* show syntax if needed *)
">> Syntax: %cmd #!prop <prop to disallow searches for>"
command @ "%cmd" subst Tell
then
;
: DoShowFindInfo ( -- ) (* show syntax and config for #find option *)
" " Tell (* show syntax (* show syntax info *)
">> Syntax: %cmd #find <prop>=<value>"
command @ "%cmd" subst Tell
">> Example: %cmd #find species=mink"
command @ "%cmd" subst Tell
">> This example would list all "
"online players whose species is 'mink'."
strcat
command @ "%cmd" subst Tell
">> The value for <prop> defaults to 'species'." Tell
">> So, the above search could be abbreviated as '%cmd #find mink'"
command @ "%cmd" subst Tell
(* show current config *)
prog "_props/" nextprop if
">> Currently, you may search for the following props:" Tell
" " Tell
NukeStack
"species"
prog "_props/" nextprop
begin
dup while
dup "" "_props/" subst swap
prog swap nextprop
repeat
pop
depth DoSortStrings-r
depth 3-col
" " Tell
else
">> Currently, you may only search "
"for matches with the species prompt."
strcat Tell " " Tell
then
;
: DoWhoFind ( -- ) (* list online players matching <prop>=<val> *)
(* '<prop>=' defaults to 'species' *)
"#find" ourArg @ stringpfx not if (* parse arg string *)
ourArg @ "=" instr if
ourArg @ dup "=" instr strcut
strip ourVal !
strip dup strlen 1 - strcut pop strip ourStr !
else (* default to species prop *)
ourArg @ ourVal !
"species" ourStr !
then
ourStr @ "@*" smatch (* check for wiz-only props *)
ourStr @ "/@" instr or
prog "W" flag? not and if
">> Sorry, searches for the prop '%prop' are not allowed."
ourStr @ "%prop" subst Tell exit
then (* check: is it an allowed prop? *)
ourStr @ "species" smatch not if
prog "_props/" ourStr @ strcat getpropstr not if
">> Sorry, searches for the prop '%prop' are not allowed."
ourStr @ "%prop" subst Tell exit
then
then
NukeStack
online (* put online players on stack *)
begin
dup while (* loop through stack, looking for prop matches *)
swap dup ourStr @ getpropstr dup if
ourVal @ smatch if
depth -1 * rotate
else
pop
then
else
pop pop
then
1 -
repeat
pop
depth if (* if we got any results, show them *)
depth 1 = if (* quick 'n easy if only one match... *)
DoHeader
DoMakeLine Tell
else (* otherwise store and display *)
(* set a temp propdir holding results;
it's faster than softcoded sorting *)
"_tmp/%me/" me @ intostr "%me" subst ourStr !
prog ourStr @ remove_dir (* make sure it's empty *)
depth
begin (* loop through stack, recording data as props *)
dup while
swap DoMakeLine
prog ourStr @ rot strcat "1" setprop
1 -
repeat
pop
DoHeader (* start display with header *)
prog ourStr @ nextprop
begin (* loop through propdir, displaying *)
dup while
dup "" ourStr @ subst Tell
prog swap nextprop
repeat
pop
prog ourStr @ remove_dir (* remove temp dir *)
then
else (* ... unless, of course, we got no matches *)
">> Currently, no online players have a %prop value of '%val'."
ourStr @ "%prop" subst
ourVal @ "%val" subst Tell
then
else
DoShowFindInfo
then
;
: DoWhoAll ( -- ) (* show formatted list of online players *)
DoHeader (* show column headings *)
NukeStack (* clear stack *)
online (* put online players on stack *)
dup 1 = if (* show and exit if only one *)
pop DoMakeLine Tell
else (* otherwise format, store results as propdir, then display *)
"_tmp/%me/" me @ intostr "%me" subst ourStr !
prog ourStr @ remove_dir (* make sure data dir is empty *)
begin
dup while
me @ 3 pick controls not (* honor dark flag *)
3 pick "D" flag? and if
swap pop
else
swap DoMakeLine (* convert connections to formatted lines *)
(* store lines as props for fast sorting *)
prog ourStr @ rot strcat "1" setprop
then
1 -
repeat
pop
prog ourStr @ nextprop
begin (* display props as program output *)
dup while
dup "" ourStr @ subst Tell
prog swap nextprop
repeat
pop
prog ourStr @ remove_dir (* remove propdir *)
then
;
: DoWhoHere ( -- ) (* show all players&puppets in current room *)
0 ourBoo !
me @ location "D" flag? if (* check: is room dark? *)
me @ dup location controls if
1 ourBoo !
else
"It's too dark to see who's here." Tell exit
then
then
DoHeader
NukeStack
me @ location contents
(* set up a propdir to hold results *)
"_tmp/%me/" me @ intostr "%me" subst ourStr !
prog ourStr @ remove_dir (* make sure it's empty *)
begin (* loop through objs in room *)
dup while
dup "D" flag? if (* honor dark flag on objs *)
ourBoo @ not if
me @ over not if
next continue
then
then
then
dup player? if (* make display lines for player&pup objs present *)
dup DoMakeLine
prog ourStr @ rot strcat "1" setprop
else
dup thing? over "Z" flag? and if
dup DoMakeLine
prog ourStr @ rot strcat "1" setprop
then
then
next
repeat
pop
prog ourStr @ nextprop
begin (* loop through propdir, displaying *)
dup while
dup "" ourStr @ subst Tell
prog swap nextprop
repeat
pop
prog ourStr @ remove_dir (* remove temp dir *)
;
: main
"me" match me ! (* make sure I'm me *)
dup if
dup ourArg !
"#" stringpfx if
ourArg @ " " instr if
ourArg @ dup " " instr strcut
strip ourArg ! strip ourOpt !
else
ourArg @ ourOpt !
then
ourOpt @ if
"#help" ourOpt @ stringpfx if DoHelp else
"#all" ourOpt @ stringpfx if DoWhoAll else
"#find" ourOpt @ stringpfx if DoWhoFind else
"#info" ourOpt @ stringpfx if DoSetInfo else
"#prop" ourOpt @ stringpfx if DoAllowProp else
"#!prop" ourOpt @ stringpfx if DoNoAllowProp else
">> Command #option not understood." Tell
">> See %com #help for help."
command @ "%com" subst Tell
then then then then then then
else
DoWhoHere
then
then
else
DoWhoHere
then
;
.
c
q