@program bulletin.muf
1 9999 d
i
( bulletin.muf v1.0 Jessy @ Forgotten Paths 3/97
A log-on announcemnt program to supplement MOTD. Bulletins can
be either 'sticky' or 'slippery': sticky bulletins are shown
to all players on each log-on, and remain until cleared; slippery
bulletins are shown to each player one time, but can be recalled
by typing a command. Up to 10 slippery bulletins may be stored.
Installation:
Link a global action, preferably named '@bulletin;@bull', to
this program. Set the program Link_OK and put it in the global
connect queue:
@propset #0=dbref:_connect/bulletin:<prog #dbref>
Bulletin.muf requires Mucker level 3.
By default, staff-only commands are only available to wizards.
To add other designated staff, set a ~keyprop, such as ~staff
or @staff. Ex:
@set bulletin.muf=~keyprop:~staff
In this example, wizards and anyone set with a ~staff property
will be able to use staff bulletin commands.
Use:
The program will automatically display all sticky bulletins and
any unread slippery bulletins at log-on. The stickies and recent
slipperies can be redisplayed by typing the action name, without
arguments. To see all slipperies, regardless of time of entry, use
the #all argument. Wizards or designated staff members can #add new
slippery bulletins, or set new #sticky bulletins. The #clear argu-
ment clears all bulletins. The #undo argument clears only the most
recent entry. Bulletins can contain MPI, for selective notifications,
storing records of who's received bulletins, calling a longer list
or program at log-on, etc.
<cmd> Show stickies and any recent slipperies
<cmd> #all Show stickies and all slipperies
<cmd> #new = <msg> Set a new slippery bulletin <staff only>
<cmd> #sticky = <msg> Set a new sticky bulletin <staff only>
<cmd> #clear Clear all bulletins <staff only>
<cmd> #delete Go to prompt; delete a bulletin <staff only>
<cmd> #undo Clear the most recent bulletin <staff only>
<cmd> #help Display help screen
Bulletin.muf may be freely ported. Please comment any changes.
)
lvar ourCounter ! (* str: loop-control ourCounter *)
lvar ourBoolean ! (* int: decision control variable *)
lvar ourString ! (* str: stores arg string; may be modified *)
$define Tell me @ swap notify $enddef
$define scounter++ ourCounter @ atoi 1 + intostr ourCounter ! $enddef
: Pad ( s i -- s ) (* pad string s to i chars *)
swap
" "
strcat
swap strcut pop
;
: ParseThis ( d s -- s ) (* returns d's prop s, parsed for MPI *)
dup 3 pick swap getpropstr 0 parseprop
;
: QCheck ( -- i )(* wrap smatch for .q in an if, to avoid null string
match error if user enters a string of all spaces,
which SayPose would strip to a null string *)
dup if
dup ".quit" swap stringpfx if
pop ">> Done." Tell pid kill
then
then
;
: SayPose ( -- ) (* scan keyboard input for poses and says. *)
(* emit poses and says, and continue *)
begin (* BEGIN INPUT-SCANNING LOOP *)
(* does input begin with " or say ? -- say if so & continue *)
read
(* emit poses and says, and 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
" (in " strcat
caller name dup "*.muf" smatch if
dup strlen 4 - strcut pop
then
strcat ")" strcat 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
" (in " strcat
caller name dup "*.muf" smatch if
dup strlen 4 - strcut pop
then
strcat ")" strcat Tell
continue
then
exit (* it's not a pose or say; exit *)
repeat (* END INPUT-SCANNING LOOP *)
;
: CheckPerms ( -- i ) (* returns true if user is wiz or staff *)
(* either wiz bit or ~keyprop is OK *)
me @ "W" flag?
prog "~keyprop" getpropstr dup if
me @ swap getpropstr
then
or if
1
else
0
then
;
: TellLoop ( -- ) (* parses bulletins and displays *)
begin
ourCounter @ while
" " Tell
prog ourCounter @ ParseThis Tell
prog ourCounter @ nextprop ourCounter !
repeat
;
: ClearLoop ( -- ) (* clears a directory of bulletins *)
begin
ourCounter @ while
prog ourCounter @ over over
nextprop ourCounter ! remove_prop
repeat
;
: DoHelp ( -- ) (* displays help screen *)
" " Tell
"Bulletin.muf (#" prog intostr strcat ")" strcat Tell
" " Tell
"A log-on message program to supplement MOTD. Bulletins may be "
"either 'sticky' (permanent) or 'slippery' (shown once, recallable, "
"FIFO roll over)." strcat strcat Tell
" " Tell
command @ 22 Pad
"Show permanent and recent bulletins" strcat Tell
command @ " #all" strcat 22 Pad
"Show all bulletins" strcat Tell
CheckPerms if
command @ " #new = <msg> strcat 22 Pad
"Set a new slippery bulletin (staff only)" strcat Tell
command @ " #sticky = <msg> strcat 22 Pad
"Set a new sticky bulletin (staff only)" strcat Tell
command @ " #clear" strcat 22 Pad
"Clear all bulletins (staff only)" strcat Tell
command @ " #delete" strcat 22 Pad
"Go to prompt; delete a bulletin (staff only)" strcat Tell
command @ " #undo" strcat 22 Pad
"Clear the most recent bulletin (staff only)" strcat Tell
then
prog "L" flag? if
" " Tell
"For more information: @list #" prog intostr strcat " = 1-52"
strcat Tell
then
" " Tell
;
: DoNew ( s -- ) (* adds a slippery bulletin *)
(* check permission *)
CheckPerms not if ">> Permission denied." .tell exit then
1 (* find out how many slips we have now... *)
prog "_bul/slippery/" nextprop ourCounter !
begin (* BEGIN SLIP-COUNTING LOOP *)
ourCounter @ while
1 +
prog ourCounter @ nextprop ourCounter !
repeat (* END SLIP-COUNTING LOOP *)
(* if more than 10, clear the old ones;
should be only one to clear *)
dup 10 > if
10 -
prog "_bul/slippery/" nextprop ourCounter !
begin (* BEGIN PROP-CLEARING LOOP *)
dup while
prog ourCounter @ over over
nextprop ourCounter !
remove_prop
1 -
repeat (* END PROP-CLEARING LOOP *)
pop
else
pop
then
(* Bulletins are stored by systime:
make sure prop string is not in use, either from
another staff member @bull'ing at the same time,
or from an upload of several bull's at once. Sleep
for 1 sec if prop name is in use. Go to background
in case there are a lot, so user won't lock up *)
begin
prog "_bul/slippery/" systime intostr strcat getpropstr while
1 sleep
repeat
(* check usage *)
ourString @ "=" instr dup not if
pop
">> Syntax: " command @ strcat
" #new = <message> strcat Tell exit
else (* trim signal chars if correct; store actual bull *)
ourString @ swap strcut swap pop strip ourString !
then
(* set bull prop *)
prog "_bul/slippery/" systime intostr strcat ourString @ setprop
">> Bulletins updated." Tell
;
: DoSticky ( s -- ) (* sets sticky bulletin *)
(* check permission *)
CheckPerms not if ">> Permission denied." .tell exit then
(* make sure prop name is not in use *)
begin
prog "_bul/sticky/" systime intostr strcat getpropstr while
1 sleep
repeat
(* check usage *)
ourString @ "=" instr dup not if
pop
">> Syntax: " command @ strcat
" #sticky = <message> strcat Tell exit
else (* trim signal chars if correct; store actual bull *)
ourString @ swap strcut swap pop strip ourString !
then
(* set bull prop *)
prog "_bul/sticky/" systime intostr strcat ourString @ setprop
">> Bulletins updated." Tell
;
: DoClear ( -- ) (* clears all bulletins *)
(* check permission *)
CheckPerms not if ">> Permission denied." .tell exit then
prog "_bul/sticky/" nextprop ourCounter ! ClearLoop
prog "_bul/slippery/" nextprop ourCounter ! ClearLoop
">> Cleared." Tell
;
: DoDelete ( -- ) (* undo specified bulletin *)
(* check permission *)
CheckPerms not if ">> Permission denied." .tell exit then
" " Tell
"0" ourCounter !
prog "_bul/sticky/" nextprop ourString !
begin
ourString @ while
scounter++
ourCounter @ ")" strcat 4 pad
prog ourString @ getpropstr 60 strcut if
"..." strcat
then
strcat " (sticky)" strcat Tell ourString @
prog ourString @ nextprop ourString !
repeat
prog "_bul/slippery/" nextprop ourString !
begin
ourString @ while
scounter++
ourCounter @ ")" strcat 4 pad
prog ourString @ getpropstr 60 strcut if
"..." strcat
then
strcat " (slippery)" strcat Tell ourString @
prog ourString @ nextprop ourString !
repeat
ourCounter @ atoi not if
">> No entries to delete!" Tell exit
then
" " Tell
begin
">> Enter number of bulletin to delete, or .q to quit." Tell
SayPose strip QCheck
dup number? not if
">> That's not a number." Tell pop continue
then
dup atoi 0 <= if
">> I'm pretty sure we don't have an entry with that number."
Tell pop continue
then
dup atoi depth 3 - > if
">> Invalid entry." Tell pop continue
then
break
repeat
ourString !
depth rotate pop
"1" ourCounter !
begin
ourCounter @ ourString @ smatch not while
depth rotate pop
scounter++
repeat
depth rotate
prog swap remove_prop
begin
depth while pop
repeat
">> Deleted." Tell
;
: DoUnDo ( -- ) (* undo most recent bulletin *)
(* check permission *)
CheckPerms not if ">> Permission denied." .tell exit then
(* figure out which is most recent: sticky or slippery? *)
prog "_bul/sticky/" nextprop ourCounter !
begin
prog ourCounter @ nextprop dup while
ourCounter !
repeat
pop
ourCounter @ 12 strcut swap pop atoi
prog "_bul/slippery/" nextprop ourCounter !
begin
prog ourCounter @ nextprop dup while
ourCounter !
repeat
pop
ourCounter @ 14 strcut swap pop atoi
> if
"_bul/sticky/"
else
"_bul/slippery/"
then
(* take of last bul from appropriate dir *)
prog swap nextprop ourCounter !
begin
prog ourCounter @ nextprop dup while
ourCounter !
repeat
pop
prog ourCounter @ remove_prop
">> Last entry erased." Tell
;
: DoReview ( -- ) (* shows stickies and recent slipperies *)
prog "_bul/sticky/" nextprop dup if
ourCounter !
TellLoop
1 ourBoolean !
else
pop
then
prog "_bul/slippery/"
ourString @ if
(* if arg is #all, start from beginning... *)
ourString @ "#all*" smatch not if
(* ... otherwise show only recents *)
me @ "_prefs/bul/last" getpropstr strcat
then
then
nextprop dup if
ourCounter !
TellLoop
1 ourBoolean !
else
pop
then
;
: DoBulletin ( -- ) (* shows bulletins at logon and by user prompt *)
DoReview
me @ "_prefs/bul/prev" me @ "_prefs/bul/last" getpropstr
dup not if
pop systime intostr
then
setprop
me @ "_prefs/bul/last" systime intostr setprop
ourBoolean @ if
"(Type '@bulletin' to see this message again.)" Tell
then
;
: main
"me" match me !
strip dup ourString !
me @ "guest_player" getpropstr if
exit
then
dup if
dup "CONNECT" smatch if DoBulletin else
dup "#new*" smatch if DoNew else
dup "#add*" smatch if DoNew else
dup "#sticky*" smatch if DoSticky else
dup "#all" smatch if DoReview else
dup "#help" swap stringpfx if DoHelp else
dup "#undo" swap stringpfx if DoUnDo else
dup "#delete" swap stringpfx if DoDelete else
dup "#clear" swap stringpfx if DoClear else
">> Command not understood." Tell
then then then then then then then then then
else
DoReview
then
;
.
c
q