@prog con-announce
1 99999 d
1 i
( CON-Announce 2.00 -- announces logins/logouts to interested players.
Also known as cmd-watchfor ver. 2.00
If you "@set me=_prefs/con_announce?:yes", then when any player listed
by name in your "_prefs/con_announce_list" property logs in or out, you
will be notified. You will not be informed if the connecting player is
in the same room as you, unless the room is set DARK; it is assumed that
you already know that they are connecting/disconnecting.
When a person logs in, they have a half minute grace period in which they
can rename themselves, or log back off, before it is announced that they
have logged on. This is for privacy purposes. Wizards are told of player
logins immediately, however. This is for possible security reasons.
Properties:
_prefs/con_announce? If set "yes" on yourself, then you will be told
when people log in.
_prefs/con_announce_list Contains a list of space seperated case-
insensitive names. When one of these people
connects or disconnects, you will see a
message telling you so. Wizards may also
use dbrefs in the form #1234 in place of
names. If this property is not set, then
you will not be informed when anyone logs
in or out. Wizards, however, are informed
of ALL logins/logouts when this prop is not
set.
_prefs/con_announce_once Same as _prefs/con_announce_list, except that
as soon as it announces a player connecting/
disconnecting, it clears their name from the
property. DBrefs are not usable in this prop.
_prefs/con_announce_fmt Contains a format string for the announcement
message you see when another player connects/
disconnects. %n subs to the player's name;
%t to the current time; %v to the verb
"connected", "disconnected", or "reconnected".
%l subs to the players location for a wizard's
format string. The default format string is:
"Somewhere on the Muck, %n has %v."
)
$include $lib/strings
$include $lib/reflist
$include $lib/edit
$def grace_time 30 (seconds)
$def announce_prop "_prefs/con_announce?"
$def announce_fmt_prop "_prefs/con_announce_fmt"
$def announce_list_prop "_prefs/con_announce_list"
$def announce_once_prop "_prefs/con_announce_once"
$def announce_hide_prop "_prefs/@con_announce_hide"
$def logintime_prop "@/AnnLITime"
( $def if you want players to see all connects/
disconnects when no _prefs/con_announce_list is set.)
$undef MORTAL_SEE_ALL
lvar discon?
: yes-prop? (d s -- i)
getpropstr "yes" stringcmp not
;
: setproperty (d s s -- )
dup if
0 addprop
else
pop remove_prop
then
;
: find-action ( -- s)
discon? @ if "disconnected" exit then
me @ awake? 1 = if
"connected"
else
"reconnected"
then
;
: can_see_all? (dListowner -- seeall?)
dup announce_list_prop getpropstr
if pop 0 exit then
$ifdef MORTAL_SEE_ALL
pop 1
$else
"wizard" flag?
$endif
;
: remove_listitem (sList sItem -- sList)
" " swap strip strcat " " strcat
" " rot strip strcat " " strcat swap
over tolower swap tolower instr
dup if
(sList iPos)
strcut
(sPrelist sPostlist)
dup " " instr dup if
strcut swap pop
else pop
then
(sPrelist sPostlist)
strcat
else
pop
then
strip .sms
;
: in_strlist? (sName sList -- bool)
dup not if pop pop 0 exit then
(sName sList)
" " swap strcat " " strcat tolower
swap " " swap strcat " " strcat
(sList sName)
tolower instr
;
(returns 0 if not in list, 1 if in list)
: in_permlist? (dListowner sName -- inlist?)
swap announce_list_prop getpropstr
in_strlist?
;
: ref_in_permlist? (dListowner dWho -- inlist?)
over "wizard" flag? if
"#" swap int intostr
strcat in_permlist?
else pop pop 0
then
;
: name_or_ref_in_hidelist? (dListowner dWho -- inlist?)
dup "wizard" flag? if pop pop 0 exit then (nowhere to hide from wizards!)
swap announce_hide_prop getpropstr
(dWho sList)
over name over in_strlist?
(dWho sList bInlist?)
"#all" 3 pick in_strlist? or
(dWho sList bInlist?)
"#" 4 rotate int intostr strcat rot in_strlist? or
(bInlists?)
;
(returns 0 if not in list, 1 if in list)
: in_templist? (dListowner sName -- inlist?)
swap announce_once_prop getpropstr
in_strlist?
;
: refconv (s -- s) (name to refstr)
me @ "wizard" flag? not if me @ 1 addpennies then
dup .pmatch dup player?
if name swap then pop
;
: convref (s -- s) (refstr to name)
dup "#" 1 strncmp if exit then
dup "#all" stringcmp not if exit then
dup match dup player? if
name swap pop
else pop
then
;
: ref_or_name_in_strlist? (s sList -- bool)
"ss" checkargs
over "#" 1 strncmp not if
over over in_strlist?
rot convref rot in_strlist? or
else
over over in_strlist?
rot refconv rot in_strlist? or
then
"i" checkargs
;
: is-oncer? (d -- i)
dup announce_once_prop getpropstr
strip dup tolower " " swap over strcat strcat
me @ name tolower " " swap over strcat strcat
instr dup not if pop pop pop 0 exit then
1 - strcut me @ name strlen 1 + strcut swap pop strcat
.sms strip announce_once_prop swap setproperty 1
;
: get-time ( -- s)
"%X" systime timefmt
;
: do_format_subs (d -- s)
dup announce_fmt_prop getpropstr (get the announce format)
dup not if pop "Somewhere on the muck, %n has %v." then
"%n" "%N" subst me @ name "%n" subst
"%v" "%V" subst find-action "%v" subst
"%t" "%T" subst get-time "%t" subst
"%l" "%L" subst
over "wizard" flag? if (only wizards can see location.)
me @ location name "%l" subst
else
"somewhere" "%l" subst
then
swap pop
;
: announce (dowizzes? -- )
preempt
concount begin
dup while
dup condbref
dup ok? not if pop 1 - continue then
3 pick over "wizard" flag? if not then
if pop 1 - continue then (skip conn. if player !matches wiz cond.)
dup location me @ location dbcmp not (only ann. if !same room...)
me @ location "dark" flag? or if (...or room is set dark.)
dup announce_prop yes-prop? if (only announce to people listening)
me @ over name_or_ref_in_hidelist? not if
dup me @ name in_permlist?
over me @ ref_in_permlist? or
over can_see_all? or
over is-oncer? or if (if in list, announce)
do_format_subs
over swap connotify
else pop
then (if in announce list)
else pop
then
else pop
then (if listening)
else pop
then (if not in same location)
1 -
repeat
pop
background
;
: sort-stringwords (s -- s)
strip .sms " " explode
0 1 EDITsort
1 - swap convref
begin
over while swap 1 - swap rot
convref dup not if pop continue then
" " strcat swap strcat
repeat
swap pop strip
;
lvar shownheader
: list-awake-watched
0 shownheader !
me @ announce_list_prop getpropstr
.sms strip " " explode
"" begin
over while
swap 1 - swap rot
dup "#" 1 strncmp
(**** Consider letting non-wizards list by dbref ****)
me @ "wizard" flag? not or
if
me @ "wizard" flag? not if me @ 1 addpennies then
dup .pmatch
else
1 strcut swap pop atoi
dup if
dbref dup player? if
dup name swap
else
pop "Droogy" #-1
then
else
pop "Droogy" #-1
then
then
dup not if pop pop continue then
dup me @ name_or_ref_in_hidelist? if pop pop continue then
awake? not if pop continue then
" " strcat 18 strcut pop
shownheader @ not if
"Players online who you are watching for:" .tell
1 shownheader !
then
strcat dup strlen 60 > if .tell "" then
repeat
.tell pop
shownheader @ not if
"No one that you are watching for is online." .tell
else
"Done." .tell
then
;
lvar edlist
lvar listname
lvar userefs
: edit-list (sList sPlayers listname refs? -- sListout)
userefs ! listname !
swap strip .sms edlist !
strip .sms " " explode
begin
dup while 1 - swap
dup "!" 1 strncmp not if
(a request to remove name from list)
1 strcut swap pop
dup not if pop continue then
dup dup "#" 1 strncmp if "*" swap strcat then
match dup player? if
userefs @ if
"#" over int intostr strcat
else
dup name
then
rot pop swap pop
else pop
then
dup edlist @ ref_or_name_in_strlist? not if
(Name isn't in list anyways)
convref " wasn't in your " strcat
listname @ strcat " list."
strcat .tell
else
(name in list. Remove)
edlist @ over remove_listitem edlist !
edlist @ over convref remove_listitem edlist !
"Removing " swap convref strcat
" from your " strcat listname @ strcat
" list." strcat .tell
then
else
(a request to add name to list)
dup not if pop continue then
dup dup "#" 1 strncmp if "*" swap strcat then
match dup player? if
userefs @ if
"#" over int intostr strcat
else
dup name
then
rot pop swap
dup awake? if
name " is currently online."
strcat .tell
else pop
then
else pop
then
dup edlist @ ref_or_name_in_strlist? if
(Name is already in list)
convref " is already in your "
strcat listname @ strcat "list."
strcat .tell
else
(add name to list)
edlist @ " " strcat over strcat
.sms strip edlist !
"Adding " swap convref strcat
" to your " strcat listname @ strcat
" list." strcat .tell
then
then
repeat pop
edlist @
.sms strip sort-stringwords
;
: do-help-list (sx...s1 x -- )
begin
dup while 1 -
dup 2 + rotate
trigger @ name ";" .split pop
" " strcat swap strcat .tell
repeat pop
;
: do-help
"-- warns you when given players log in or out."
1 do-help-list
"---------------------------------------------------------------------------"
.tell
"#on Turns on login/logoff watching."
"#off Turns off login/logoff watching."
"#help Gives this help screen."
"#list Lists all players being watched for."
" Lists all watched players currently online."
"<player> Adds the given player to your watch list."
"!<player> Removes the given player from your watch list."
" Lists the players temporarily being watched for."
"#temp <plyr> Adds the given player to the temporary watch list."
"#temp !<plyr> Removes the given player from the temp. watch list."
"#hidefrom <plyr> Prevents <plyr> from being told of your logins."
"#hidefrom !<plyr> Lets <plyr> be told of your logins again."
"#hidefrom #all Lets no one be informed of your logins/logouts."
"#hidefrom !#all Lets people see your logins/logouts again."
"#hidefrom Lists who you are hiding from."
15 do-help-list
"For more detailed information on this program, type '@view $con/announce'"
.tell
;
: main
command @ "Queued Event." stringcmp not if
"disconnect" stringcmp not discon? !
1 announce (announce to wizzes immediately)
discon? @ if
me @ logintime_prop getpropval systime swap -
me @ logintime_prop remove_prop
grace_time < if exit then (If disconn. within grace time, ignore)
else
me @ logintime_prop "" systime addprop
fork not if
me @ announce_list_prop getpropstr if
preempt list-awake-watched
then
exit
then
grace_time sleep
me @ awake? not if exit then (if not logged on, ignore)
me @ logintime_prop getpropval
dup not if pop exit then (apparently disconnected during grace time)
systime swap - grace_time < if exit then (reconn in grace. ignore)
then
0 announce (announce to all others)
else (run from action) (Run away! Aiiiiiigh!)
strip dup "#" 1 strncmp not if
" " .split swap
dup "#list" stringcmp not if
pop pop me @ announce_list_prop getpropstr
.sms strip sort-stringwords
dup not if pop "*no one*" then
"Currently watching for: " swap strcat
.tell exit
then
dup "#help" stringcmp not if
pop pop do-help exit
then
dup "#off" stringcmp not if
pop me @ announce_prop remove_prop
"Watch turned off." .tell exit
then
dup "#on" stringcmp not if
pop me @ announce_prop "yes" 0 addprop
"Watch turned on." .tell exit
then
dup "#hidefrom" stringcmp not
over "#hide" stringcmp not or if
pop dup if
me @ announce_hide_prop getpropstr
swap "hidefrom" 1 edit-list
me @ announce_hide_prop rot setproperty
exit
else
pop me @ announce_hide_prop getpropstr
.sms strip sort-stringwords
dup not if pop "*no one*" then
"#all" over in_strlist? if pop "*everyone*" then
"Hiding from: " swap strcat
.tell exit
then
then
dup "#temp" stringcmp not if
pop dup if
me @ announce_once_prop getpropstr
swap "temporary watchfor" 0 edit-list
me @ announce_once_prop rot setproperty
exit
else
pop me @ announce_once_prop getpropstr
.sms strip sort-stringwords
dup not if pop "*no one*" then
"Temporarily watching for: " swap strcat
.tell exit
then
then
then
dup if
me @ announce_list_prop getpropstr
swap "permanent watchfor" 0 edit-list
me @ announce_list_prop rot setproperty
else
pop list-awake-watched
exit
then
then
;
(Remember, the Weasel Patrol is on the job!)
.
c
q
@register con-announce=con/announce
@register #prop #0:_connect con-announce=announce
@register #prop #0:_disconnect con-announce=announce
@set con-announce=L
@set con-announce=W
@set con-announce=_docs:@list $con/announce=1-42
(@action watchfor;wf=me=tmp/exit1)
(@link $tmp/exit1=con-announce)
(@desc $tmp/exit1=@$con/announce #help)