@prog update-motd.muf
1 9999 d
1 i
: say me @ swap notify ;
: merge over 4 pick + -4 rotate begin over 4 pick and while over 4 pick
+ 4 + pick 3 pick 5 + pick 3 pick exec if rot 1 - -3 rotate else over 4
+ rotate 4 pick 4 pick + 4 + -1 * rotate swap 1 - swap then loop pop
pop pop ;
: sort over 2 < if pop exit then over 2 / rot over - over 3 + -1 *
rotate over over 3 + -1 * rotate swap sort dup 2 + pick over 4 + pick 3
pick + 4 + 3 pick 2 + roll sort dup 3 + rotate swap dup 3 + rotate
merge ;
: chk-any-motd-prop (propname -- interested?)
	"_motd" 5 strncmp not
;
: chk-prog-motd-prop (propname -- interested?)
	"_motd." 6 strncmp not
;
: clear-props (fn -- )
	begin
		(fn)
		0 swap me @ propfirst begin while
			(p1 ... pN N fn me prop)
			dup 4 pick exec if
				4 rotate 1 +
				dup 200 > if rot pop rot break then
				4 2 roll 4 pick
			then
			pop propnext
		loop
		(p1 ... pN N fn)
	over while
		swap begin dup 0 > while
			1 - me @ 4 rotate remove_prop
		loop pop
	loop
	pop pop
;
: record-0-obj
	"_motd.#" over owner int intostr strcat
	me @ over getpropstr
	dup not if
		3 pick owner int intostr "<" swap ">" strcat strcat
		me @ "_motd.list" getpropstr strcat
		me @ "_motd.list" rot addprop
	then
	atoi 1 + intostr me @ rot rot addprop
;
: handle-0-obj
	dup room? if
		dup name tolower "parent" instr not if
			record-0-obj
		then
	then
;
: get-motd-n me @ "_motd.n" getpropstr atoi ;
: set-motd-n intostr me @ "_motd.n" rot addprop ;
: append-motd
	me @ "_motd" get-motd-n dup 1 + set-motd-n intostr strcat rot addprop
;
: pad-to (s n -- s)
	swap begin over over strlen > while " " strcat loop swap pop
;
: add-as-of
	me @ "_motd3" getpropstr 55 pad-to "[All lists as of" strcat
	me @ "_motd3" rot addprop
	me @ "_motd4" getpropstr 55 pad-to
	systime ctime 4 strcut swap pop 6 strcut 6 strcut pop
	" EST, " rot "]" strcat strcat strcat strcat
	me @ "_motd4" rot addprop
;
: ten-or-more (player -- interested?)
	me @ "_motd.#" rot int intostr strcat getpropstr atoi 10 >=
;
: under-ten (player -- interested?)
	me @ "_motd.#" rot int intostr strcat getpropstr atoi 10 <
;
: pad-to-length (s pad len -- s)
	rot begin over over strlen > while 3 pick strcat loop rot rot pop pop
;
: max (i1 i2 -- i)
	over over < if swap then pop
;
: try-n-rows (pad width pnM ... pn1 M N -- sN ... s1 N 1  <or>  <args> 0)
99 "try-n-rows entry" pstack
	over 4 + -2 roll
	(pnM ... pn1 M N pad w)
	3 pick 1 -1 for pop "" -4 rotate loop 0 4 1
	(pnM ... pn1 M sN ... s1 N pad w ml c r)
	6 pick 7 + pick dup if 1 swap 1 for
		(pnM ... pn1 M sN ... s1 N pad w ml c r m)
99 "try-n-rows loop top" pstack
		over 7 + rotate
		(pnM ... pn1 M sN ... sr+1 sr-1 ... s1 N pad w ml c r m sr)
		7 pick 5 pick pad-to-length
		(pnM ... pn1 M sN ... sr+1 sr-1 ... s1 N pad w ml c r m sr)
		swap 8 pick + 7 + pick strcat
		(pnM ... pn1 M sN ... sr+1 sr-1 ... s1 N pad w ml c r sr)
		4 rotate over strlen max
		(pnM ... pn1 M sN ... sr+1 sr-1 ... s1 N pad w c r sr ml)
		dup 6 pick >= if
			pop pop pop pop
			0 -4 rotate 3 pick 1 -1 for pop 4 rotate pop loop
			4 pick 4 + 2 roll 0
99 "try-n-rows exit 1" pstack
			exit
		then
		(pnM ... pn1 M sN ... sr+1 sr-1 ... s1 N pad w c r sr ml)
		-4 rotate
		(pnM ... pn1 M sN ... sr+1 sr-1 ... s1 N pad w ml c r sr)
		over 6 + -1 * rotate
		(pnM ... pn1 M sN ... s1 N pad w ml c r)
		1 + 6 pick over < if
			pop pop 0 swap 3 + 1
			(pnM ... pn1 M sN ... s1 N pad w 0 ml 1)
		then
		(pnM ... pn1 M sN ... s1 N pad w ml c r)
	loop else pop then
	(pnM ... pn1 M sN ... s1 N pad w ml c r)
99 "try-n-rows after loop" pstack
	pop swap 3 + max swap pop
	(pnM ... pn1 M sN ... s1 N pad len)
	3 pick 1 -1 for pop
		3 pick 3 + rotate 3 pick 3 pick pad-to-length -4 rotate
	loop
	(pnM ... pn1 M sN ... s1 N pad len)
	pop pop dup 2 + pick over + 2 + over 1 + roll
	(sN ... s1 N pnM ... pn1 M)
	begin dup 0 > while 1 - swap pop loop pop
	(sN ... s1 N)
	1
99 "try-n-rows exit 2" pstack
;
: string->= stringcmp 0 >= ;
: append-player-list (fn pad width minrows -- )
	0 -5 rotate me @ "_motd.list" getpropstr
	begin dup while
		(pn1 ... pnN N fn pad width minr list)
		dup "><" instr dup if strcut else pop "" then swap
		"" "<" subst "" ">" subst atoi dbref
		(pn1 ... pnN N fn pad width minr rest player)
		dup 7 pick exec if name 7 rotate 1 + 7 2 roll else pop then
	loop
	pop 4 rotate pop
	(pn1 ... pnN N pad width minr)
	4 pick 4 + 3 roll ' string->= sort
	(pad width minr pn1 ... pnN N)
	dup 2 + rotate 1 - begin 1 + try-n-rows until
	(sN ... s1 N)
	begin dup 0 > while 1 - swap append-motd loop pop
;
: main
	' chk-any-motd-prop clear-props
	#0 contents begin dup while handle-0-obj next loop
	1 set-motd-n
"Cleanup time!  There's a lot of junk in #0 that really doesn't belong there." append-motd
"The following players are particular offenders, with 10 or more dbrefs there:" append-motd
	' ten-or-more " " 50 2 append-player-list
	begin get-motd-n 4 <= while "" append-motd loop
	add-as-of
"Others who should clean up, but have fewer than 10 dbrefs there:" append-motd
	' under-ten "." 71 1 append-player-list
"If you're listed, the \"0-stuff\" global is the thing for you!  Try it!  Dig" append-motd
"yourself a parent room (with a name with \"parent\" in it) and @tel your rooms!" append-motd
"           [If this is too cryptic, page mouse for help with it.]" append-motd
	' chk-prog-motd-prop clear-props
	"Done." say
;
.
c
q