@q
@program cmd-finger
1 9999 d
i
( cmd-finger v1.3 Jessy @ FurryMUCK 9/96
cmd-finger is a player information utility, in the vein to 'pinfo'
or '+finger'.
Four fields are automatically supported: Home, Email, IC Profile, and
OOC Profile. Players may define additional fields. Wizards and the owner
of the program may set parameters controlling the maximum number of lines
for each field, the maximum number of player-defined fields, and MPI
parsing. Notifications can be turned on and off.
Installation:
Create a global action and link it two this program. cmd-finger
requires the list editor libraries lib-lmgr, lib-editor, and lib-strings.
Each should already be installed on any established MUCK. The program
requires Mucker level 3 if MPI parsing is enabled; otherwise it requires
Mucker level 2.
The help screen and some program output incorporates the command name
or the *first* alias in the command name, so the action should be
named with this in mind. If the primary name of the command is
'finfo', but you want to support '+finger' as well, name the command
'finfo;+finger' rather than '+finger;finfo'.
Use:
<action> <player> Show information for <player>
<action> #edit Edit an information field.
<action> #delete Delete an information field.
<action> #tell Receive notifications of <action> use.
<action> #!tell Turn off notifications.
<action> #format Set format for notifications.
<action> #parameters Display current program parameters.
<action> #configure Set program parameters. <wiz & owner only>
<action> #defaults Reset to default parameters. <wiz & owner only>
cmd-finger.muf may be freely ported. Please comment any changes.
)
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
$def LMGRgetcount lmgr-getcount
$def LMGRgetrange lmgr-getrange
$def LMGRputrange lmgr-putrange
$def LMGRdeleterange lmgr-deleterange
$define Tell me @ swap notify $enddef
lvar ourString (* input from keyboard *)
lvar ourPlayer (* player being checked *)
lvar counter (* loop-controlling variable *)
lvar scratch (* loop-controlling variable *)
: pad ( s i -- s ) (* pad a string to i characters *)
swap " "
strcat
swap strcut pop
;
: ParseThis ( d s -- s ) (* return d's prop s, parsed for MPI *)
dup 3 pick swap getpropstr 0 parseprop
;
: MainName ( s -- ) (* return name of trig, or first alias
if the name includes multiple alia *)
trig name dup ";" instr dup if
1 - strcut pop
else
pop
then
;
: SayPose ( -- ) (* scan keyboard input for poses and says. *)
(* emit poses and says, and continue *)
begin (* BEGIN INPUT-SCANNING LOOP *)
read (* does input begin with " or say ? ; say if so & continue *)
dup "\"" stringpfx
over "say " stringpfx or if
dup "say " stringpfx if
4 strcut
else
1 strcut
then swap pop
me @ name " says, \"" strcat swap strcat "\"" strcat dup
loc @ me @ rot notify_except Tell
continue
then
(* does input begin with : or pose ? ; pose if so & continue *)
dup ":" stringpfx
over "pose " stringpfx or if
dup "pose " stringpfx if
5 strcut
else
1 strcut
then swap pop
me @ name
over "'*" smatch not if
" " strcat
then
swap strcat dup
loc @ me @ rot notify_except Tell
continue
then
exit (* it's not a pose or say; exit *)
repeat (* END INPUT-SCANNING LOOP *)
;
(**************************************************************************
* Next three functions are borrowed from cmd-lsedit *
**************************************************************************)
: LMGRdeletelist
over over LMGRgetcount
1 4 rotate 4 rotate LMGRdeleterange
;
: LMGRgetlist
over over LMGRgetcount
rot rot 1 rot rot
LMGRgetrange
;
: lsedit-loop (* listname dbref {rng} mask currline cmdstr -- *)
EDITORloop
dup "save" stringcmp not if
pop pop pop pop
3 pick 3 + -1 * rotate
over 3 + -1 * rotate
dup 5 + pick over 5 + pick
over over LMGRdeletelist
1 rot rot LMGRputrange
4 pick 4 pick LMGRgetlist
dup 3 + rotate over 3 + rotate
"< List saved. >" .tell
"" lsedit-loop exit
then
dup "abort" stringcmp not if
"< list not saved. >" .tell
pop pop pop pop pop pop pop pop pop exit
then
dup "end" stringcmp not if
pop pop pop pop pop pop
dup 3 + rotate over 3 + rotate
over over LMGRdeletelist
1 rot rot LMGRputrange
"< list saved. >" .tell exit
then
;
(**************************************************************************)
: GetMax ( s -- i ) (* return maximum # of lines for field s *)
(* match field; return # lines *)
dup "home" smatch if
trig "_max_home" getpropstr dup if
atoi
else
2
then swap pop exit
then
dup "email" smatch if
trig "_max_email" getpropstr dup if
atoi
else
pop 1
then swap pop exit
then
dup "ic" smatch if
trig "_max_ic" getpropstr dup if
atoi
else
pop 10
then swap pop exit
then
dup "ooc" smatch if
trig "_max_ooc" getpropstr dup if
atoi
else
pop 10
then swap pop exit
then
dup "other" smatch if
trig "_max_other" getpropstr dup if
atoi
else
pop 4
then swap pop exit
then
;
: MakeField ( s -- i ) (* set props to handle user-defined field *)
(* return false if user .quits or has reached _max_ofields *)
pop
0 scratch ! (* check: alread has _max_ofields? *)
me @ "_prefs/finfo/ofields/" nextprop counter !
begin
counter @ while
scratch @ 1 + scratch !
me @ counter @ nextprop counter !
repeat
trig "_max_ofields" getpropstr dup if
atoi
else
pop 3
then
(* tell and abort if too many fields *)
scratch @ <= if
">> Creating a new field would put you over the maximum number "
"of allowed user-defined fields." strcat Tell
">> Entry aborted." Tell 0 exit
then
">> What is the title of this field?" Tell
">> [Enter name of field, or .q to quit.]" Tell
SayPose strip
(* check: wants to quit? *)
dup ".q" smatch if
">> Entry aborted." Tell 0 exit
then
(* include name of field in /ofields *)
dup "_prefs/finfo/ofields/" over strcat me @ swap 3 pick setprop
(* make list prop *)
"_prefs/finfo/" swap strcat
swap pop 1
;
: EditList ( s -- ) (* edit new or existing field *)
pop (* get name of field *)
begin
">> What field do you want to edit?" Tell
">> [Enter 'home', 'email', 'ic', 'ooc', 'other', or .q to quit.]"
Tell
SayPose strip
dup ".q" smatch if
">> Entry aborted." Tell exit
then
dup "home" swap stringpfx if "home" break else
dup "email" swap stringpfx if "email" break else
dup "ic" swap stringpfx if "ic" break else
dup "ooc" swap stringpfx if "ooc" break else
dup "other" swap stringpfx if "other" break else
">> Entry not understood." Tell continue
then then then then then
repeat
(* get max allowed lines *)
dup GetMax swap
(* set up list name *)
dup "other" smatch if
MakeField not if
exit
then
else
"_prefs/finfo/" swap strcat
then
dup ourString !
(* warn of max limits *)
"*********************** Maximum lines this field: "
3 pick intostr strcat
" ******************************" strcat 78 strcut pop Tell
"********************** Maximum line length: 78 chars"
" ******************************" strcat 78 strcut pop Tell
(* enter editor *)
"< Welcome to the list editor. You can get help by entering '.h' >"
Tell
"< '.end' will exit and save the list. '.abort' will abort any changes. >"
Tell
"< To save changes to the list, and continue editing, use '.save' >"
Tell
me @
over over LMGRgetlist
"save" 1 ".i $" lsedit-loop
(* check: more than max lines? Warn if so *)
"1" counter !
ourString @ "#/" strcat ourString !
begin
me @ ourString @ counter @ strcat getprop while
counter @ atoi 1 + intostr counter !
repeat
counter @ atoi 1 - < if
">> Warning: Entry is longer than maximum, and will not be "
"displayed completely." strcat Tell
then
(* check: more than max characters? Warn if so *)
0 scratch !
"1" counter !
begin
me @ ourString @ counter @ strcat getprop dup while
strlen 78 > if
1 scratch !
then
counter @ atoi 1 + intostr counter !
repeat
scratch @ if
">> Warning: Some lines are longer than 78 characters, "
"and will not be displayed completely." strcat Tell
">> Suggestion: Use '" MainName strcat " #edit' to edit " strcat
"the field, and enter '.format 1 "
counter @ "1" smatch not if
counter @ atoi 1 - intostr strcat
then
" = 78' to re-format the list." strcat strcat Tell
then
;
: ShowList ( i s -- ) (* show list s from lines 1 to i *)
"1" counter !
"#/" strcat
begin
dup counter @ strcat ourPlayer @ swap over over
getpropstr while
trig "_no_mpi" getpropstr if
getpropstr
else
ParseThis
then 78 strcut pop Tell
counter @ atoi 1 + dup 4 pick > if
"pop me!" break
then
intostr counter !
repeat
pop pop pop pop
;
: DoHelp ( s -- ) (* show help screen *)
pop
" " Tell
"cmd-finger (#" prog intostr strcat ")" strcat Tell
" " Tell
" " MainName strcat ourString !
ourString @
" <player> Show information for <player>." strcat Tell
ourString @
" #edit Edit an information field." strcat Tell
ourString @
" #delete Delete an information field." strcat Tell
ourString @
" #tell Receive notifications of " MainName strcat " use."
strcat strcat Tell
ourString @
" #!tell Turn off notifications." strcat Tell
ourString @
" #format Set format for notifications." strcat Tell
ourString @
" #parameters Display current program parameters." strcat Tell
me @ "W" flag?
me @ prog owner dbcmp or if
ourString @
" #configure Set program parameters." strcat Tell
ourString @
" #defaults Reset to default parameters." strcat Tell
then
" " Tell
"Settings are stored on your character in directory _prefs/finfo/." Tell
;
: DoParams ( s -- ) (* show current program parameters *)
pop " " Tell
"Current Program Parameters: " Tell
" " Tell
"Fields: " Tell
" Home (max: "
trig "_max_home" getpropstr dup not if
pop "2"
then
dup "1" smatch if
" line)" else
" lines)"
then strcat strcat Tell
" Email (max: "
trig "_max_email" getpropstr dup not if
pop "1"
then
dup "1" smatch if
" line)" else
" lines)"
then strcat strcat Tell
" IC Profile (max: "
trig "_max_ic" getpropstr dup not if
pop "10"
then
dup "1" smatch if
" line)" else
" lines)"
then strcat strcat Tell
" OOC Profile (max: "
trig "_max_ooc" getpropstr dup not if
pop "10"
then
dup "1" smatch if
" line)" else
" lines)"
then strcat strcat Tell
" " Tell
"User-Defined Fields:" Tell
" Maximum number of fields: "
trig "_max_ofields" getpropstr dup not if
pop "3"
then
strcat Tell
" Maximum lines per field: "
trig "_max_other" getpropstr dup not if
pop "4"
then strcat Tell
" " Tell
"MPI Parsing: "
trig "_no_mpi" getpropstr if
"no"
else
"yes"
then strcat Tell
;
: DoDefaults ( s -- ) (* remove parameter props, restoring to defaults *)
pop
trig "_max_home" remove_prop
trig "_max_email" remove_prop
trig "_max_ic" remove_prop
trig "_max_ooc" remove_prop
trig "_max_other" remove_prop
trig "_max_ofields" remove_prop
trig "_no_mpi" remove_prop
">> Default settings restored." Tell
;
: DoConfigure ( s -- ) (* read from keyboard to set program parameters *)
(* loops continue when user enters an invalid response *)
pop (* check permission *)
me @ "W" flag?
me @ prog owner dbcmp or not if
">> permission denied." Tell exit
then
begin
">> Maximum number of lines for Home field? (currently "
trig "_max_home" getpropstr dup not if
pop "2"
then
strcat ")" strcat Tell
">> [Enter number, or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell pop exit
then
dup number? not if
pop ">> That's not a number." Tell continue
then
trig "_max_home" rot setprop break
repeat
begin
">> Maximum number of lines for Email field? (currently "
trig "_max_email" getpropstr dup not if
pop "1"
then
strcat ")" strcat Tell
">> [Enter number, or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell pop exit
then
dup number? not if
pop ">> That's not a number." Tell continue
then
trig "_max_email" rot setprop break
repeat
begin
">> Maximum number of lines for IC Profile field? (currently "
trig "_max_ic" getpropstr dup not if
pop "10"
then
strcat ")" strcat Tell
">> [Enter number, or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell pop exit
then
dup number? not if
pop ">> That's not a number." Tell continue
then
trig "_max_ic" rot setprop break
repeat
begin
">> Maximum number of lines for OOC Profile field? (currently "
trig "_max_ooc" getpropstr dup not if
pop "10"
then
strcat ")" strcat Tell
">> [Enter number, or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell pop exit
then
dup number? not if
pop ">> That's not a number." Tell continue
then
trig "_max_ooc" rot setprop break
repeat
begin
">> Maximum number of other fields? (currently "
trig "_max_ofields" getpropstr dup not if
pop "3"
then
strcat ")" strcat Tell
">> [Enter number, or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell pop exit
then
dup number? not if
pop ">> That's not a number." Tell continue
then
trig "_max_ofields" rot setprop break
repeat
begin
">> Maximum number of lines for other fields? (currently "
trig "_max_other" getpropstr dup not if
pop "4"
then
strcat ")" strcat Tell
">> [Enter number, or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell pop exit
then
dup number? not if
pop ">> That's not a number." Tell continue
then
trig "_max_other" rot setprop break
repeat
begin
">> Should the program parse MPI? (current setting: "
trig "_no_mpi" getpropstr if
"no"
else
"yes"
then
strcat ")" strcat Tell
">> Enter 'yes', 'no', or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell pop exit
then
dup "yes" swap stringpfx
over "no" swap stringpfx or not if
pop ">> Entry not understood." Tell continue
then
"no" swap stringpfx if
trig "_no_mpi" "yes" setprop
else
trig "_no_mpi" remove_prop
then break
repeat
">> Done." Tell
;
: Tell-On ( s -- ) (* remove notify: player will receive notifications *)
pop
me @ "_prefs/finfo/notify" "yes" setprop
">> You will now be notified when "
MainName strcat
" is used on you." strcat Tell
;
: Tell-Off ( s -- )(* set notify: player will not receive notifications *)
pop
me @ "_prefs/finfo/notify" remove_prop
">> You will not be notified when "
MainName strcat
" is used on you." strcat Tell
;
: DoDelete ( s -- ) (* delete indicated list *)
pop
">> What field do you want to delete?" Tell
(* make list of valid fields; tell *)
">> [Fields: home email ic ooc"
me @ "_prefs/finfo/ofields/" nextprop dup if
scratch !
begin (* BEGIN FIELD-LISTING LOOP *)
scratch @ while
" " strcat
me @ scratch @ getpropstr strcat
me @ scratch @ nextprop scratch !
repeat (* END FIELD-LISTING LOOP *)
then
"]" strcat Tell
">> [Enter name of field, or .q to quit.]" Tell
Saypose strip
(* check: wants to quit? *)
dup ".q" smatch if
">> Done." Tell pop exit
then
(* store name of field *)
ourString !
(* remove field from ofields/ *)
me @ "_prefs/finfo/ofields/" ourString @ strcat remove_prop
(* remove list *)
"_prefs/finfo/" ourString @ strcat
dup "#" strcat me @ swap remove_prop
"/" strcat ourString !
"1" counter !
begin
me @ ourString @ counter @ strcat over over
getpropstr while
remove_prop
counter @ atoi 1 + intostr counter !
repeat
pop pop
">> Done." Tell
;
: DoFormat ( s -- ) (* define notification format *)
pop (* give instructions *)
">> The string '<name>' will be replaced by the triggering "
"player's name." strcat Tell
trig "_no_mpi" getpropstr if
">> O"
else
">> MPI and o"
then
"ther substitution strings may be included as well." strcat Tell
">> [Enter format, 'clear' to remove previous format, or .q to quit.]"
Tell
SayPose strip
(* check: wants to quit? *)
dup ".q" smatch if
">> Entry aborted." Tell exit
then
(* check: wants to clear? *)
dup "clear" smatch if
me @ "_prefs/finfo/tformat" remove_prop
">> Format cleared." Tell exit
then
(* set format *)
me @ "_prefs/finfo/tformat" rot setprop
">> Set." Tell
;
: Finfo ( s -- ) (* show info for selected player *)
(* match player; store in 'ourPlayer' *)
.pmatch dup not if
pop ourString @
1 strcut swap toupper swap strcat
" is not a player here." strcat Tell exit
else
ourPlayer !
then
(* notify checked player if desired *)
ourPlayer @ "_prefs/finfo/notify" getpropstr if
ourPlayer @ "_prefs/finfo/tformat" getpropstr if
ourPlayer @ "_prefs/finfo/tformat"
trig "_no_mpi" getpropstr if
getpropstr
else
ParseThis
then
me @ name "<name>" subst
me @ swap pronoun_sub
ourPlayer @ swap notify
else
"+++ " me @ name strcat
" " strcat MainName strcat "'d you. +++" strcat
ourPlayer @ swap notify
then
then
(* List basic data *)
ourPlayer @ name Tell
"----------------------------------------------------------------------------"
Tell
ourPlayer @ "species" ParseThis dup not if
pop "Species unknown"
then
23 Pad
ourPlayer @ "sex" ParseThis dup not if
pop ourPlayer @ "gender" getpropstr dup not if
pop "Gender unknown"
then
then
strcat 38 Pad
ourPlayer @ "_/do" getpropstr strcat 78 pad Tell
(* list fields *)
ourPlayer @ "_prefs/finfo/home#/1" getpropstr if
"~" Tell "Home: " Tell
"home" GetMax "_prefs/finfo/home" ShowList
then
ourPlayer @ "_prefs/finfo/email#/1" getpropstr if
"~" Tell "Email: " Tell
"email" GetMax "_prefs/finfo/email" ShowList
then
ourPlayer @ "_prefs/finfo/ic#/1" getpropstr if
"~" Tell "IC Profile: " Tell
"ic" GetMax "_prefs/finfo/ic" ShowList
then
ourPlayer @ "_prefs/finfo/ooc#/1" getpropstr if
"~" Tell "OOC Profile: " Tell
"ooc" GetMax "_prefs/finfo/ooc" ShowList
then
(* displacy user-defined fields *)
(* var ourString is enlisted as a loop-counter *)
ourPlayer @ "_prefs/finfo/ofields/" nextprop dup if
trig "_max_ofields" getpropstr dup not if
pop "3"
then
atoi ourString !
scratch !
begin
scratch @ while
ourString @ while
ourPlayer @ scratch @ getpropstr
"~" Tell dup ": " strcat Tell
"_prefs/finfo/" swap strcat
"other" GetMax swap ShowList
ourPlayer @ scratch @ nextprop scratch !
ourString @ 1 - ourString !
repeat
then
;
: main
"me" match me !
strip dup ourString !
dup if
dup "#*" smatch if
dup "#help" swap stringpfx if DoHelp exit else
dup "#edit" swap stringpfx if EditList exit else
dup "#delete" swap stringpfx if DoDelete exit else
dup "#tell" swap stringpfx if Tell-On exit else
dup "#!tell" swap stringpfx if Tell-Off exit else
dup "#format" swap stringpfx if DoFormat exit else
dup "#parameters" swap stringpfx if DoParams exit else
dup "#configure" swap stringpfx if DoConfigure exit else
dup "#defaults" swap stringpfx if DoDefaults exit else
dup "#" stringpfx if
"Sorry, this program doesn't know how to " swap 1 strcut
swap pop strcat "." strcat Tell exit else
then then then then then then then then then then
then
then
dup not if
DoHelp exit
then
Finfo
;
.
c
q