@q
@program staffscreen.muf
1 9999 d
i
( staffscreen.muf v1.2 Jessy @ FurryMUCK 6/97, 2/99
Another staff screen utitilty.
INSTALLATION:
Create a global action with a name such as 'wizzes;wizards;staff'
and link it to this program.
USAGE:
<cmd> ............ Show staff members
<cmd> #on ........ Go on duty <staff only>
<cmd> #off ....... Go off duty <staff only>
<cmd> #specialty.. Set a specialty string <staff only>
<cmd> #add ....... Add a player to staff roster <wiz only>
<cmd> #remove .... Remove a player from staff roster <wiz only>
<cmd> #format .... Format display screen <staff only>
Staffscreen.muf may be freely ported. Please comment any changes.
)
(2345678901234567890123456789012345678901234567890123456789012345678901)
$def thisVersion "1.1"
$include $lib/reflist
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
$define Tell me @ swap notify $enddef
lvar scratch (* workspace var *)
lvar ourCounter (* misc. counter var *)
lvar ourArg (* inital arg string, unmodified *)
lvar ourCom (* string: 'official' name of command *)
: Pad ( s i -- s' ) (* pad string s to i characters *)
" "
rot swap strcat swap strcut pop
;
: DoHelp ( -- ) (* display help screen *)
" " Tell
prog name " (#" strcat prog intostr strcat ")" strcat Tell
" " Tell
"The " command @ strcat
" command is use to display staff members and their current "
"duty status. Staff members may also use it to go on and off duty, "
"and to set a 'specialty' string. Wizards may use it to add and re"
"move players from the staff roster." strcat strcat strcat strcat
Tell " " Tell
"Syntax: " command @ strcat " ............ Show staff members"
strcat Tell
" " command @ strcat " #on ........ Go on duty <staff only>"
strcat Tell
" " command @ strcat " #off ....... Go off duty <staff only>"
strcat Tell
" " command @ strcat " #specialty.. Set a specialty string "
"<staff only>" strcat strcat Tell
" " command @ strcat " #add ....... Add a player to staff "
"roster <wiz only>" strcat strcat Tell
" " command @ strcat " #remove .... Remove a player from "
"staff roster <wiz only>" strcat strcat Tell
" " command @ strcat " #format .... Format display screen "
"<staff only>" strcat strcat Tell " " Tell
"It is not necessary to type the "
"#argument string completely: you only need to type the first one "
"or several characters, enough to distinguish the option you want "
"from the others." strcat strcat strcat Tell
;
: ReadLine ( -- s )
(* read keyboard input; emit poses|says and continue, else return *)
begin (* begin input-scanning loop *)
read (* does input begin with 'say ' or " ? Emit if so *)
dup "\"" stringpfx if
1 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "say " stringpfx if
4 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
(* does input begin with 'pose ' or : ? Emit if so *)
dup ":" stringpfx if
1 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "pose " stringpfx if
5 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
(* continue for strings of all spaces; i.e., treat as null *)
dup strip not if
pop continue
then
break (* it's not a pose or say; break and exit *)
repeat
;
: QCheck ( -- i )(* wrap smatch for .q in an if, to avoid null string
match error if user enters a string of all spaces,
which ReadLine would strip to a null string *)
dup if
dup ".quit" swap stringpfx
over ".end" swap stringpfx or if
pop ">> Done." Tell pid kill
then
then
;
: AddListLine ( s s' -- ) (* add line s' to list s on library *)
over prog LMGR-GetCount 1 + 3 pick prog LMGR-PutElem pop
;
: EditLoop ( listname dbref {rng} mask currline cmdstring -- )
(* read input for list editor *)
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 LMGR-DeleteList
1 rot rot LMGR-PutRange
4 pick 4 pick LMGR-GetList
dup 3 + rotate over 3 + rotate
">> List saved." Tell
"" EditLoop 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 LMGR-DeleteList
1 rot rot LMGR-PutRange
">> List saved." Tell exit
then
;
: EditList ( d s -- ) (* edit list s on d *)
swap
">> Welcome to the list editor. You can get help by entering '.h' on"
Tell
">> a line by itself. '.end' will save and exit. '.abort' will abort"
Tell
">> any changes. To save changes and continue editing, use '.save'."
Tell
over over LMGR-GetList
"save" 1 ".i $" EditLoop
;
: ShowList ( d s -- ) (* display list s on object d *)
"#/" strcat swap LMGR-GetList
begin (* begin line-listing loop *)
dup while
dup 1 + rotate Tell
1 -
repeat (* end line-listing loop *)
pop
;
: DoFormat ( -- ) (* format screen's header and trailer *)
">> Edit material to be shown at top of staff screen:" Tell
trig "_staff/header" EditList
">> Edit material to be shown at bottem of staff screen:" Tell
trig "_staff/trailer" EditList
">> Done." Tell
;
: DoAdd ( -- ) (* prompt wiz user for a player to add to staff *)
me @ "W" flag? not if (* check permission *)
">> Permission denied." Tell exit
then
(* get player *)
">> Who do you want to add to the staff?" Tell
">> [Enter player name, or .q to quit]" Tell
ReadLine strip QCheck
(* if valid entry, add to staff *)
.pmatch dup if
dup intostr "#" swap strcat " " strcat
trig "_staff/members" over over getpropstr 4 pick instr if
pop pop pop
">> " swap name strcat " is already a staff member." strcat Tell
">> Done." Tell exit
else
(* if duplicate entry, notify and quit *)
over over getpropstr 4 rotate strcat setprop
">> " swap name strcat " added to staff." strcat Tell
">> Done." Tell
then
else (* if invalid entry, notify and quit *)
">> Player not found." Tell
then
;
: DoRemove ( -- )(* prompt wiz user for player to remove from staff *)
me @ "W" flag? not if (* check permission *)
">> Permission denied." Tell exit
then
(* get player *)
">> Who do you want to remove from the staff?" Tell
">> [Enter player name, or .q to quit]" Tell
ReadLine strip QCheck
(* if valid entry, remove from staff *)
.pmatch dup if
dup intostr "#" swap strcat " " strcat
trig "_staff/members" over over getpropstr 4 pick instr if
over over getpropstr 4 rotate "" swap subst setprop
dup "_prefs/staff/offduty" remove_prop
dup "_prefs/staff/spec" remove_prop
">> " swap name strcat " removed from staff." strcat Tell
">> Done." Tell exit
else (* if invalid entry, notify and quit *)
pop pop pop
">> " swap name strcat " is not a staff member." strcat Tell
">> Done." Tell
then
else
">> Player not found." Tell
then
;
: DoOnDuty ( -- ) (* user goes on duty *)
me @ "_prefs/staff/offduty" remove_prop
">> You go on duty." Tell
;
: DoOffDuty ( -- ) (* user goes off duty *)
me @ "_prefs/staff/offduty" "yes" setprop
">> You go off duty." Tell
;
: DoSpecialty ( -- ) (* prompt for and set user's specialty string *)
">> What is your specialty or staff tag line?" Tell
">> [Enter string, .r to remove current string, or .q to quit]" Tell
ReadLine strip QCheck
dup ".r" smatch if
me @ "_prefs/staff/spec" remove_prop pop
else
me @ "_prefs/staff/spec" rot setprop
then
">> Set." Tell
;
: DoStaff ( -- ) (* display staff screen *)
(* display header if present *)
trig "_staff/header" ShowList
(* get reflist of staff members *)
trig "_staff/members" getpropstr dup if
" " explode 1 -
begin (* begin staff-listing loop *)
dup while
swap strip 1 strcut swap pop atoi dbref
dup name 14 Pad
over awake? if
over "_prefs/staff/offduty" getpropstr if
"[off-duty] "
else
"[ on-duty] "
then
strcat
else
"[--------] " strcat
then
swap "_prefs/staff/spec" getpropstr strcat
76 strcut pop Tell (* show one line *)
1 -
repeat (* end staff-listing loop *)
pop
else
pop "<no entries>" Tell
then
(* display trailer if present *)
trig "_staff/trailer" ShowList
;
: main
"me" match me ! (* initialize *)
strip ourArg !
ourArg @ if
ourArg @ "#" stringpfx if
"#help" ourArg @ stringpfx if DoHelp else
"#on" ourArg @ stringpfx if DoOnDuty else
"#off" ourArg @ stringpfx if DoOffDuty else
"#specialty" ourArg @ stringpfx if DoSpecialty else
"#add" ourArg @ stringpfx if DoAdd else
"#remove" ourArg @ stringpfx if DoRemove else
"#format" ourArg @ stringpfx if DoFormat else
">> #Argument not understood." Tell
then then then then
then then then
exit
then
then
DoStaff
;
.
c
q