/sub off
@program cmd-page
1 9999 d
1 i
( MUFpage Copyright 4/15/91 by Garth Minette )
( foxen@netcom.com )
( )
: oproploc ( dbref -- dbref' )
dup "_proploc" getpropstr
dup if
dup "#" 1 strncmp not if
1 strcut swap pop
then
atoi dbref
dup ok? if
dup owner 3 pick
dbcmp if swap then
else swap
then pop
else pop
then
;
: myproploc ( -- dbref)
me @ oproploc
;
$define tell me @ swap notify $enddef
: split
swap over over swap
instr dup not if
pop swap pop ""
else
1 - strcut rot
strlen strcut
swap pop
then
;
: fillspace
swap strlen -
" " ( 40 spaces )
dup strcat ( 80 spaces now )
swap strcut pop
;
$define strip-leadspaces striplead $enddef
$define strip-trailspaces striptail $enddef
$define stripspaces strip $enddef
( mail encryption stuff )
: transpose (char -- char')
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz 1234567890_"
over instr dup if
swap pop 1 -
"wG8D kBQzWm4gbRXHOqaZiJPtUTN2pu6M0VjFlK3sdS9oYe5A_7IE1cnLvfyCrhx"
swap strcut 1 strcut pop swap pop
else
pop
then
;
: encrypt-charloop (nullstr string -- string')
dup not if pop exit then
1 strcut swap transpose
rot swap strcat swap
encrypt-charloop
;
: encrypt-loop (nullstr string -- string')
dup not if pop exit then
100 strcut "" rot
encrypt-charloop
rot swap strcat
swap encrypt-loop
;
: encrypt (string -- string')
"" swap encrypt-loop
;
( better encryption. But slower. )
: asc (stringchar -- int)
dup if
"
1234567890-=!@#$%&*()_+qwertyuiop[]QWERTYUIOP{}asdfghjkl;'ASDFGHJKL:zxcvbnm,./ZXCVBNM<>?\"`~\\|^"
swap instr 1 - exit
then pop 0
;
: chr (int -- strchar)
"
1234567890-=!@#$%&*()_+qwertyuiop[]QWERTYUIOP{}asdfghjkl;'ASDFGHJKL:zxcvbnm,./ZXCVBNM<>?\"`~\\|^"
swap strcut 1 strcut pop swap pop
;
: cypher (key chars -- chars')
1 strcut asc swap asc
over 89 > over 89 > or if chr swap chr strcat swap pop exit then
dup 10 / 10 *
4 pick 10 + rot 10 % - 10 %
rot dup 10 / 10 *
5 rotate 10 + rot 10 % - 10 %
4 rotate + chr -3 rotate + chr strcat
;
: crypt2-loop (key strcrypt strnorm -- strcrypt)
dup not if pop swap pop exit then
2 strcut 4 pick rot cypher
rot swap strcat swap
crypt2-loop
;
: crypt2-loop2 (key strcrypt strnorm -- strcrypt)
dup strlen 200 < if crypt2-loop exit then
200 strcut swap 4 pick 4 rotate rot crypt2-loop
swap crypt2-loop2
;
: crypt2 (key string -- string')
swap 9 % 100 + "" rot crypt2-loop2
;
(
Gazer's Sort routines
Shell Sort
Takes [ x1 x2 x3 ... xn n -- x1' x2' x3' ... xn' n ]
)
: CmpStrCaseInsensAsc stringcmp 0 > ;
: SortJLoop ( <strings*n> n cmp inc i j -- <strings*n> n cmp inc i )
dup 0 <= if pop exit then ( while j > 0 )
dup 5 + pick ( get A[j] )
over 5 pick + 6 + pick ( get A[j+inc] )
6 pick execute if ( do comparison )
dup 5 + pick ( swap: get A[j] )
over 5 pick + 6 + pick ( get A[j+inc] )
3 pick 6 + put ( put into A[j] )
over 5 pick + 5 + put ( put into A[j+inc] )
3 pick - ( j := j - inc )
else
pop exit then ( break out if we don't swap )
SortJLoop
;
: SortILoop ( <strings*n> n cmp inc i -- <strings*n> n cmp inc)
dup 5 pick > if pop exit then ( for i := inc + 1 to n )
over over swap - SortJLoop ( j := i - inc )
1 + SortILoop ( while j > 0 )
;
: SortIncLoop ( <strings*n> n cmp inc --- <strings*n> n )
dup 0 <= if pop pop exit then ( while inc > 0)
dup 1 + SortILoop ( for i := inc + 1 to n )
2 / SortIncLoop
;
: Sort ( <strings*n> n )
'CmpStrCaseInsensAsc
over 2 / SortIncLoop
;
( End Gazer's Sort routines )
: sort-stringwords-reassemble ({strrange} -- string)
dup 1 <= if pop exit then
1 - swap " " strcat rot strcat swap
sort-stringwords-reassemble
;
: sort-stringwords (str -- str')
stripspaces
dup " " instr if
" " explode sort
sort-stringwords-reassemble
stripspaces
then
;
: fake_format? (default string -- string' TRUE )
( or -- default FALSE )
"%n" me @ name subst
dup "%n" instr not if
"%n " swap strcat
then
dup "%n whispers, \"%m\"" stringcmp not
over "%n whispers \"%m\"" stringcmp not or
over "%n shouts, \"%m\"" stringcmp not or
over "%n shouts \"%m\"" stringcmp not or
over "%n %m" stringcmp not or if
pop 0
else
swap pop 1
then
;
( *** routines to get and set properties *** )
: setpropstr (dbref propname value -- )
dup not if
pop remove_prop
else
0 addprop
then
;
: envprop envpropstr swap pop ;
: search-prop (propname -- str)
myproploc over getpropstr
dup not if
me @ location
rot envprop
then
swap pop
;
: getprop (playerdbref propname -- str)
over oproploc over getpropstr
dup not if
pop swap over envprop
dup not if
pop trigger @ swap getpropstr
else swap pop
then
else rot rot pop pop
then
;
( *** BEGIN PERSONAL PROPS *** )
: getignorestr (playerdbref -- ignorestr)
trigger @ getlink "ignore#"
rot int intostr
strcat getpropstr
;
: setignorestr (ignorestr playerdbref -- )
int intostr trigger @
getlink "ignore#" rot
strcat rot setpropstr
;
: getprioritystr (playerdbref -- prioritystr)
trigger @ getlink "priority#"
rot int intostr
strcat getpropstr
;
: setprioritystr (prioritystr playerdbref -- )
int intostr trigger @
getlink "priority#" rot
strcat rot setpropstr
;
: getlastpager (playerdbref -- string)
dup int swap oproploc "_page/lastpager" getpropstr
dup "*" 1 strncmp not if 1 strcut
swap pop crypt2 else swap pop then
;
: setlastpager (string playerdbref -- )
dup oproploc swap int rot crypt2
"*" swap strcat
"_page/lastpager" swap setpropstr
;
: getlastpagers (playerdbref -- string)
dup int swap oproploc "_page/lastpagers" getpropstr
dup "*" 1 strncmp not if 1 strcut
swap pop crypt2 else swap pop then
;
: setlastpagers (string playerdbref -- )
dup oproploc swap int rot crypt2
"*" swap strcat
"_page/lastpagers" swap setpropstr
;
: getlastpaged (playerdbref -- string)
dup int swap oproploc "_page/lastpaged" getpropstr
dup "*" 1 strncmp not if 1 strcut
swap pop crypt2 else swap pop then
;
: setlastpaged (string playerdbref -- )
dup oproploc swap int rot crypt2
"*" swap strcat
"_page/lastpaged" swap setpropstr
;
: getlastpagedgroup (playerdbref -- string)
dup int swap oproploc "_page/lastpagedgroup" getpropstr
dup "*" 1 strncmp not if 1 strcut
swap pop crypt2 else swap pop then
;
: setlastpagedgroup (string playerdbref -- )
dup oproploc swap int rot crypt2
"*" swap strcat
"_page/lastpagedgroup" swap setpropstr
;
: set_page_standard (valstr -- )
myproploc "_page/standard?" rot setpropstr
;
: page_standard? (playerdbref -- bool)
oproploc "_page/standard?" getpropstr
dup "yes" stringcmp not if pop 2 exit then
"prepend" stringcmp not if 1 exit then
0
;
: set_page_echo (valstr -- )
myproploc "_page/echo?" rot setpropstr
;
: page_echo? ( -- bool)
myproploc "_page/echo?" getpropstr
"no" stringcmp not not
;
: set_page_inform (valstr -- )
myproploc "_page/inform?" rot setpropstr
;
: page_inform? (playerdbref -- bool)
oproploc "_page/inform?" getpropstr
"yes" stringcmp not
;
: get-curr-format ( -- formatname )
myproploc "_page/curr_format" getpropstr
dup not if pop "page" then
;
: set-curr-format ( formatname -- )
myproploc "_page/curr_format" rot setpropstr
;
: set-format-prop ( playerdbref formatname format -- )
rot oproploc rot "_page/formats/" swap strcat rot setpropstr
;
: get-format-prop ( playerdbref formatname -- format )
"_page/formats/" swap strcat over swap getprop
dup not if pop "_page/formats/page" getprop else swap pop then
dup not if pop "You page, \"%m\" to %n." then
;
: set-oformat-prop ( playerdbref formatname format -- )
rot oproploc rot "_page/formats/o" swap strcat rot setpropstr
;
: get-oformat-prop ( playerdbref formatname -- format )
"_page/formats/o" swap strcat over swap getprop
dup not if pop "_page/formats/opage" getprop else swap pop then
"%n pages, \"%m\" to %t." swap dup if fake_format? then pop
;
: get_opose ( -- oposeformat)
myproploc "_page/formats/opose" over swap getprop
dup not if pop "_page/formats/opage" getprop else swap pop then
"In a page-pose to %t, %n %m" swap dup if fake_format? then pop
;
: set-standard (stdformat playerdbref -- )
oproploc "_page/stdf" rot setpropstr
;
: get-standard (playerdbref -- stdformat)
oproploc "_page/stdf" getpropstr
dup not if pop "%n pages: %m" "_page/stdf" trigger @ swap getpropstr dup if swap then pop then
"<loc>" "%l" subst
;
: set-prepend (prepformat playerdbref -- )
oproploc "_page/prepf" rot setpropstr
;
: get-prepend (playerdbref -- prepformat)
oproploc "_page/prepf" getpropstr
dup not if pop "%n pages: " "_page/prepf" trigger @ swap getpropstr dup if swap then pop then
"<loc>" "%l" subst
;
: get-forward (playerdbref -- string)
oproploc "_page/forward" getpropstr
;
: set-forward (string -- )
myproploc "_page/forward" rot setpropstr
;
: mail-count (playerdbref -- count)
oproploc "_page/mail" "#" strcat getpropstr atoi
;
: mail-get (playerdbref -- message)
dup dup mail-count swap oproploc
"_page/mail" "#/" strcat 3 pick intostr strcat
over over getpropstr dup not if
pop dup "#/" rinstr 1 - strcut
2 strcut swap pop strcat
over over getpropstr
then
-5 rotate remove_prop
1 - intostr swap oproploc
"_page/mail" "#" strcat rot setpropstr
;
: mail-add (playerdbref message -- )
over mail-count 1 + intostr
3 pick oproploc "_page/mail" "#" strcat 3 pick setpropstr
rot oproploc "_page/mail" "#/" strcat rot strcat rot setpropstr
;
: mail-erase-loop (proploc count -- proploc count)
dup not if exit then
over mail-get dup " " split pop
1 strcut swap pop atoi dbref
me @ dbcmp not if
rot rot 1 - mail-erase-loop
else
pop exit
then
over 4 rotate mail-add
;
: mail-erase (playerdbref -- erased?)
dup mail-count mail-erase-loop swap pop
;
: get-lastversion ( -- versionstr)
myproploc "_page/lastversion" getpropstr
;
: set-lastversion (versionstr -- )
myproploc "_page/lastversion" rot setpropstr
;
: get-multimax (playerdbref -- int)
oproploc "_page/multimax" getpropstr
atoi dup not if pop 8888 then
;
: set-multimax (int playerdbref -- )
oproploc "_page/multimax"
rot intostr setpropstr
;
: get-sleepmsg (dbref -- string)
oproploc "_page/sleepmsg" getpropstr
;
: set-sleepmsg (string dbref -- )
oproploc "_page/sleepmsg" rot setpropstr
;
: get-havenmsg (dbref -- string)
oproploc "_page/havenmsg" getpropstr
;
: set-havenmsg (string dbref -- )
oproploc "_page/havenmsg" rot setpropstr
;
: get-ignoremsg (dbref -- string)
oproploc "_page/ignoremsg" getpropstr
;
: set-ignoremsg (string dbref -- )
oproploc "_page/ignoremsg" rot setpropstr
;
( change proploc )
: move-prop (dbref newdbref str -- )
3 pick over getpropstr
4 rotate 3 pick remove_prop
setpropstr
;
: move-mail (dbref newdbref count -- )
dup not if pop pop pop exit then
3 pick 3 pick "_page/mail" "#/" strcat
4 pick intostr strcat
3 pick over getpropstr not if
pop "_page/mail"
4 pick intostr strcat
then
move-prop
1 - move-mail
;
: move-aliases (dbref newdbref aliases -- )
dup not if pop pop pop exit then
" " split swap
4 pick 4 pick "Alias"
"-" strcat 4 rotate strcat
move-prop move-aliases
;
: do-proplock-set (str -- )
stripspaces match dup not if
"page #proploc: I don't know what object you mean!"
tell pop exit
then dup #-2 dbcmp if
"page #proploc: I don't know _which_ object you mean!"
tell pop exit
then dup owner me @ dbcmp not if
"page #proploc: You don't own that object!"
tell pop exit
then myproploc swap
dup int intostr me @ "_proploc" rot setpropstr
over over "_page/lastpager" move-prop
over over "_page/lastpagers" move-prop
over over "_page/lastpaged" move-prop
over over "_page/lastpagedgroup" move-prop
over over "_page/standard?" move-prop
over over "_page/echo?" move-prop
over over "_page/inform?" move-prop
over over "_page/curr_format" move-prop
over over "_page/formats/page" move-prop
over over "_page/formats/opage" move-prop
over over "_page/lastversion" move-prop
over over "_page/prepf" move-prop
over over "_page/stdf" move-prop
over over "_page/forward" move-prop
over over "_page/sleepmsg" move-prop
over over "_page/havenmsg" move-prop
over over "_page/ignoremsg" move-prop
over "_page/mail" "#" strcat getpropstr atoi
3 pick 3 pick rot move-mail
over over "_page/mail" "#" strcat move-prop
over "Alias" "es" strcat getpropstr
3 pick 3 pick rot move-aliases
over over "Alias" "es" strcat move-prop
"Properties now stored on \""
swap name strcat "\"" strcat tell
;
( *** END PERSONAL PROPS *** )
: get-g-aliases ( -- aliasesstr)
trigger @ getlink "GlobalAliases" getpropstr
;
: set-g-aliases (aliasesstr -- )
sort-stringwords
trigger @ getlink "GlobalAliases" rot setpropstr
;
: set-p-aliases (aliasesstr -- )
sort-stringwords
myproploc "Aliases" rot setpropstr
;
: get-p-aliases ( -- aliasesstr)
myproploc "Aliases" getpropstr dup if exit then
pop trigger @ getlink me @ int intostr
"Aliases" strcat getpropstr
dup set-p-aliases
trigger @ getlink me @ int intostr
"Aliases" strcat remove_prop
;
: set-personal-alias (aliasname aliasstr -- )
swap tolower dup strlen
10 > if 10 strcut pop then
swap get-p-aliases
" " swap over strcat strcat
over if
dup 4 pick " " swap over strcat strcat
instr not if
" " strcat 3 pick strcat
then
"Personal alias set." tell
else
3 pick " " swap over strcat strcat
split " " swap strcat strcat stripspaces
"Personal alias cleared." tell
then
stripspaces set-p-aliases
"Alias-" rot strcat
myproploc swap rot setpropstr
;
: get-personal-alias (aliasname playerdbref -- aliasstr)
over over oproploc "Alias-" rot strcat getpropstr
dup if rot rot pop pop exit then
pop over over int intostr "Alias" swap strcat
"-" strcat swap strcat
trigger @ getlink swap over over getpropstr
dup not if pop pop pop pop pop "" exit then
rot rot remove_prop
swap pop over swap set-personal-alias
;
: get-global-alias (aliasname -- aliasstr)
trigger @ getlink "AliasGlobal-"
rot strcat getpropstr
;
: set-global-alias (aliasname aliasstr -- )
over get-global-alias
me @ "w" flag? not and
me @ trigger @ getlink owner dbcmp not and
"GlobalOwn-" 4 pick strcat
trigger @ getlink swap getpropstr
me @ int intostr stringcmp and if
"Permission denied." tell
pop pop exit
then
(aliasname aliasstr)
dup not if
"GlobalOwn-" 3 pick strcat
trigger @ getlink swap remove_prop
then
(aliasname aliasstr)
swap tolower dup strlen
10 > if 10 strcut pop then
swap get-g-aliases
" " swap over strcat strcat
over if
( Line #888 in pre-cpp source )
dup 4 pick " " swap over strcat strcat
instr not if " " strcat 3 pick strcat then
"Global alias set." tell
else
3 pick " " swap over strcat strcat
split " " swap strcat strcat stripspaces
"Global alias cleared." tell
then
stripspaces set-g-aliases
"GlobalOwn-" 3 pick strcat
trigger @ getlink swap
me @ int intostr setpropstr
"AliasGlobal-" rot strcat
trigger @ getlink swap rot setpropstr
;
: get-alias (aliasname playerdbref -- aliasstr)
over swap get-personal-alias
dup not if
pop get-global-alias
else swap pop
then
;
( *** END PROPS ON PROG *** )
: getday ( -- int)
systime dup 86400 % 86400 + time 60 * + 60 * + - 86400 % - 86400 /
;
: setday ( int -- )
#0 "day" "" 4 pick addprop
trigger @ getlink "day" rot "" swap addprop
;
: gettime ( -- int )
time 60 * + 60 * +
;
: get-timestr ( -- timestr)
time rot pop ":"
rot dup intostr
swap 10 < if "0" swap strcat then
strcat over 11 > if
"pm" strcat swap 12 - swap
else
"am" strcat
then
swap dup not if pop 12 then
intostr swap strcat
;
( *** end of routines for getting and setting properties *** )
( alias listing stuff )
: list-p-aliases-loop (playerdbref aliasesstr -- )
dup not if pop pop exit then
" " split swap dup 4 pick get-personal-alias
" -- " swap strcat over 10 fillspace swap strcat
strcat tell
list-p-aliases-loop
;
: list-personal-aliases ( - )
" Personal Aliases List" tell
"Alias Name -- Alias Expansion" tell
"---------- --------------------------------------------------" tell
me @ get-p-aliases sort-stringwords list-p-aliases-loop
;
: list-g-aliases-loop (aliasesstr -- )
dup not if pop exit then
" " split swap dup get-global-alias
" -- " swap strcat over 10 fillspace swap strcat
strcat tell
list-g-aliases-loop
;
: list-global-aliases ( - )
" Global Aliases List" tell
"Alias Name -- Alias Expansion" tell
"---------- --------------------------------------------------" tell
get-g-aliases sort-stringwords list-g-aliases-loop
;
: list-matching-aliases-loop (matchstr aliasesstr -- )
dup not if pop exit then
" " split swap dup me @ get-alias
" -- " swap strcat over 10 fillspace swap strcat strcat
dup " " swap over strcat strcat tolower
4 pick " " swap over strcat strcat
instr not if pop else tell then
list-matching-aliases-loop
;
: list-matching-aliases (namestr -- )
"Aliases containing the name \"" over strcat "\"" strcat tell
"Alias Name -- Alias Expansion" tell
"---------- --------------------------------------------------" tell
tolower get-g-aliases " " strcat get-p-aliases strcat
sort-stringwords list-matching-aliases-loop
;
( misc simple routines )
: single-space (s -- s') (strips all multiple spaces down to a single space)
dup " " instr not if exit then
" " " " subst single-space
;
: comma-format (string -- formattedstring)
stripspaces single-space
", " " " subst
dup ", " rinstr dup if
1 - strcut 2 strcut
swap pop " and "
swap strcat strcat
else pop
then
;
: popn (dbrefrange -- )
dup if 1 - popn then pop
;
: stringmatch? (str cmpstr #charsmin-- bool)
rot " " split pop rot rot
swap over strcut swap
4 rotate 4 rotate strcut rot rot
stringcmp if pop pop 0 exit then
swap over strlen strcut pop
stringcmp not
;
( simple player matching )
: player-match? (playername -- [dbref] succ?)
me @ pennies 0 < if
"You've run out of pennies to page with!"
tell pop -1 exit
then
.pmatch dup if 1 else pop 0 then
;
: partial-match-loop (dbrefrange playername dbref -- dbref)
3 pick not if swap pop swap pop exit then
3 pick 3 + rotate
dup name
(dbrefrange playername matched dbref name)
4 pick strlen strcut pop
4 pick stringcmp not if
over over dbcmp
3 pick not or if swap pop
else pop pop #-2
then
else pop
then
rot 1 - rot rot
partial-match-loop
;
( Does anyone really read these comments in the code? )
: partial-match ( playername -- [dbref] succ? )
online dup 2 + rotate #-1 partial-match-loop
dup int 0 > if 1 else pop 0 then
;
: cull-loop (strings count nullstr -- string')
over not if swap pop exit then
over 6 > if rot pop swap 1 - swap cull-loop exit then
rot dup if " " strcat strcat else pop then
swap 1 - swap cull-loop
;
: cullto5words (string -- string')
single-space stripspaces
" " explode "" cull-loop
;
: match-lastpagers (partname playerdbref -- [dbref] success?)
over strlen 3 < if pop pop 0 exit then
getlastpagers stripspaces
" " swap strcat dup tolower
" " 4 rotate strcat tolower instr
dup not if pop pop 0 exit then
strcut swap pop " " split pop
player-match?
;
: update-lastpagers (fullname playerdbref -- )
dup getlastpagers stripspaces
" " swap over strcat strcat
" " 4 rotate over strcat strcat
over tolower over tolower instr not if
1 strcut swap pop strcat
cullto5words swap setlastpagers
else
pop pop pop
then
;
( Probably not. *gryn* )
( FEEP! )
: feep-loop (count mynum -- )
swap 1 + swap
read dup number? not if
"Quitting the page #feep game! Bye!"
tell pop pop pop exit
then
atoi over over = if
"You guessed it in " 4 pick intostr strcat
" guesses! Game over." strcat tell
pop pop pop exit
then
over over > if pop "Higher." tell feep-loop exit then
over over < if pop "Lower." tell feep-loop exit then
;
: do-feep ( -- )
"Welcome to page #feep! I'm thinking of a number between 1 and 1024. "
"Try to guess it! To play, just enter numbers, and I'll tell you higher "
"or lower. To quit at any time, type any non number like 'quit' or 'end'."
" Enjoy!" strcat strcat strcat tell 0 random 1024 % 1 + feep-loop
;
( remember stuff )
: extract-player-loop (<range> str playername -- string)
3 pick not if pop swap pop exit then
4 rotate dup if
over over stringcmp not if pop
else
rot dup if " " strcat then
swap strcat swap
then
else pop
then
rot 1 - rot rot extract-player-loop
;
: extract-player (playername string -- string')
single-space " " explode dup 2 + rotate
"" swap extract-player-loop
;
: remember-pager (playerdbref -- )
me @ name over setlastpager
me @ name over update-lastpagers
me @ getlastpaged
over name swap extract-player
swap setlastpagedgroup
;
: remember-pagee (player[s] -- player[s])
dup not if (is a player specified?)
pop me @ (if not, use last player paged...)
getlastpaged
else
single-space (...otherwise, use the player given...)
then
;
( ignore stuff )
: ignored? (playerdbref -- ignored?)
getignorestr
me @ int intostr
" " strcat " #" swap
strcat instr
;
: ignoring? (playerdbref -- ignored?)
int intostr " " strcat
me @ getignorestr
" #" rot strcat instr
;
: ignore-dbref (dbref -- )
int intostr " " strcat
" #" swap strcat
me @ getignorestr
swap over over instr not
if strcat else pop then
me @ setignorestr
;
: unignore-dbref (dbref -- )
int intostr " " strcat
" #" swap strcat
me @ getignorestr
swap split strcat
me @ setignorestr
;
: check-ignored-dbref (dbref -- player?)
dup player? not if
unignore-dbref 0
else
pop 1
then
;
: list-ignored-loop (str ignorestr -- str)
dup not if pop sort-stringwords " " strcat exit then
" " split swap 1 strcut
swap pop atoi dbref
dup check-ignored-dbref if
name " " strcat
rot strcat swap
else pop
then
list-ignored-loop
;
: list-ignored ( -- string)
"" me @ getignorestr
stripspaces single-space
list-ignored-loop
comma-format
;
( priority stuff )
: priority? (playerdbref -- priority?)
getprioritystr
me @ int intostr
" " strcat " #" swap
strcat instr
;
: priority-dbref (dbref -- )
int intostr " " strcat
" #" swap strcat
me @ getprioritystr
swap over over instr not
if strcat else pop then
me @ setprioritystr
;
: unpriority-dbref (dbref -- )
int intostr " " strcat
" #" swap strcat
me @ getprioritystr
swap split strcat
me @ setprioritystr
;
: check-priority-dbref (dbref -- player?)
dup player? not if
unpriority-dbref 0
else
pop 1
then
;
: list-priority-loop (str prioritystr -- str)
dup not if pop sort-stringwords " " strcat exit then
" " split swap 1 strcut
swap pop atoi dbref
dup check-priority-dbref if
name " " strcat
rot strcat swap
else pop
then
list-priority-loop
;
: list-priority ( -- string)
"" me @ getprioritystr
stripspaces single-space
list-priority-loop
comma-format
;
( page stuff )
: havened? (playerdbref -- haven?)
"haven" flag?
;
: pagepose? (string -- bool)
dup strlen 1 > if
2 strcut pop
dup ":" 1 strncmp not if
1 strcut swap pop
" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz,':*"
swap instr
else pop 0
then
else pop 0
then
;
: page-me-inform (message -- )
page_echo? if (does sender not want to see the echo?)
tell (if not, show constructed string to sender)
else
pop (else, pop the string off the stack)
"Your message has been sent."
tell
then
;
: page-them-inform (message dbref format to -- )
3 pick name "you" swap subst -4 rotate
over page_standard? dup 1 = if
pop over get-prepend
over over strlen strcut pop
stringcmp if
over get-prepend
" " strcat swap strcat
then
else
2 = if
get_opose over stringcmp if
pop dup get-standard
else
pop dup get-standard
"%n %m" "%m" subst
then
then
then
3 pick " " split pop
1 strcut strlen 3 <
over not if swap pop " " swap then
".,?!:' " rot instr and
if "%n%m" "%n %m" subst then
me @ name "%n" subst (do name substitution for %n in format string)
me @ location
name "%l" subst (do location of sender sub for %l in format string)
4 rotate "%t" subst (subst in the to line for %t)
dup "%w" instr if
get-timestr
"%w" subst
then
"%%m" "%m" subst
"%%m" "%M" subst (keep %m from being pronoun_subbed)
me @ swap pronoun_sub (do pronoun subs for %o, %p, %r, %s in format str)
(using sender's pronoun subs)
rot "%m" subst (do message sub for %m in format string)
notify (show constructed string to receiver)
;
( mail stuff )
: mail-unparse-mesg (mesgstr -- player time mesg)
( "#dbref day@hh:mm:ss Cencryptedmesg" )
" " split swap
dup "#" 1 strncmp not if
1 strcut swap pop
atoi dbref name swap
"@" split swap
atoi getday swap -
dup not if
pop "Today at "
else dup 1 = if
pop "Yesterday at "
else
intostr " days ago at " strcat
then
then
swap " " split rot rot
":" split swap atoi
dup 11 > if 12 - "PM" else "AM" then
rot swap strcat swap
dup not if pop 12 then
intostr ":" strcat swap strcat strcat
swap
dup "C" 1 strncmp not if
1 strcut swap pop
encrypt
else
dup "D" 1 strncmp not if
1 strcut swap pop
me @ int swap crypt2
then
then
else
swap 3 strcut swap pop ") -- " split
swap ":" split swap atoi
dup 11 > if 12 - "PM" else "AM" then
rot swap strcat swap
dup not if pop 12 then
intostr ":" strcat swap strcat
"Unknown day at " swap strcat swap
then
;
: mail-read ( -- )
me @ mail-count 0 > if
me @ mail-get mail-read
mail-unparse-mesg
") -- " swap strcat strcat
" (" swap strcat strcat
tell
then
;
: mail-send (message player -- )
dup mail-count 40 < not if
name "'s page-mail box is full." strcat tell pop
else
dup "You sense that you have new page-mail from " me @ name strcat
". Use 'page #mail' to read." strcat notify
"#" me @ int intostr strcat " " strcat
getday intostr strcat "@" strcat
time intostr ":" strcat
swap dup intostr ":" strcat swap 10 < if "0" swap strcat then strcat
swap dup intostr swap 10 < if "0" swap strcat then strcat
strcat
(message player string)
" D" strcat over int 4 rotate crypt2
strcat mail-add
( "#dbref day@hh:mm:ss Cencryptedmesg" )
then
;
( player getting stuff )
: get-playerdbrefs (count nullstr playersstr -- dbref_range unrecstr)
dup not if pop sort-stringwords exit then
" " split swap
dup "(" 1 strncmp not if
" " strcat swap strcat
")" split swap pop stripspaces
get-playerdbrefs exit
then
dup "#" 1 strncmp not if
dup 1 strcut swap pop
dup number? if
atoi dbref dup ok? if
dup player? if
swap pop 4 rotate 1 +
-4 rotate -4 rotate
get-playerdbrefs exit
else pop
then
else pop
then
else pop
then
then
dup "*" 1 strncmp not if
1 strcut swap pop me @
get-alias " " strcat
swap strcat single-space
get-playerdbrefs exit
then
dup player-match? dup -1 = if
pop pop pop
stripspaces exit
then
0 > if
swap pop 4 rotate
1 + -4 rotate -4 rotate
else
dup me @ get-alias dup if
swap pop " " strcat
swap strcat single-space
else pop
dup partial-match
dup -1 = if
pop pop pop stripspaces exit
then if
swap pop 4 rotate 1 +
-4 rotate -4 rotate
else
"\"" swap strcat
"\" " strcat rot
swap strcat swap
then
then
then
get-playerdbrefs
;
: refs2names (dbrefrange count nullstr -- dbrefrange namestr)
over not if swap pop sort-stringwords exit then
3 pick 3 + rotate dup -5 rotate
name strcat " " strcat
swap 1 - swap refs2names
;
: remove-sleepers (dbrefrange count nullstr -- dbrefrange sleeperstr)
over not if swap pop sort-stringwords exit then
3 pick 3 + rotate dup awake? if
-4 rotate
else
dup get-sleepmsg dup if
"Sleeping message for "
rot name strcat ": " strcat
swap strcat me @ swap notify
else
pop name " " strcat strcat
then
rot 1 - rot rot
then
swap 1 - swap remove-sleepers
;
: remove-non-erasees (dbrefrange count nullstr -- dbrefrange non-erasestr)
over not if swap pop sort-stringwords exit then
3 pick 3 + rotate dup mail-erase if
-4 rotate
else
name " " strcat strcat
rot 1 - rot rot
then
swap 1 - swap remove-non-erasees
;
: remove-nopagers (dbrefrange count nullstr -- dbrefrange nopagestr)
over not if swap pop sort-stringwords exit then
3 pick 3 + rotate dup havened? not over priority? or if
-4 rotate
else
dup page_inform? if
dup "You sense that " me @ name strcat
" tried to page you, but you are set havened."
strcat notify
then
dup get-havenmsg dup if
"Haven message for "
rot name strcat ": " strcat
swap strcat me @ swap notify
else
pop name " " strcat strcat
then
rot 1 - rot rot
then
swap 1 - swap remove-nopagers
;
: remove-ignoring (dbrefrange count nullstr -- dbrefrange ignoringstr)
over not if swap pop sort-stringwords exit then
3 pick 3 + rotate dup ignored? not if
-4 rotate
else
dup page_inform? if
dup me @ name
" tried to page you, but you are ignoring them."
strcat notify
then
dup get-ignoremsg dup if
"Ignore message for "
rot name strcat ": " strcat
swap strcat me @ swap notify
else
pop name " " strcat strcat
then
rot 1 - rot rot
then
swap 1 - swap remove-ignoring
;
: remove-maxers (dbrefrange count count nullstr -- dbrefrange ignoringstr)
over not if swap pop swap pop sort-stringwords exit then
4 pick 4 + rotate dup get-multimax 5 pick < not over priority? or if
-5 rotate
else
dup page_inform? if
dup me @ name
" tried to include you in too large of a multi-page."
strcat notify
then
name " " strcat strcat
4 rotate 1 - -4 rotate
then
swap 1 - swap remove-maxers
;
: remove-nonwiz (dbrefrange count nullstr -- dbrefrange sleeperstr)
over not if swap pop sort-stringwords exit then
3 pick 3 + rotate dup "wizard" flag? if
-4 rotate
else
name " " strcat strcat
rot 1 - rot rot
then
swap 1 - swap remove-nonwiz
;
: list-ignored-pagees (dbrefrange count nullstr -- dbrefrange ignoringstr)
over not if swap pop sort-stringwords exit then
3 pick 3 + rotate dup ignoring? not if
-4 rotate
else
dup -5 rotate
name " " strcat strcat
then
swap 1 - swap list-ignored-pagees
;
: do-getplayers (players -- dbrefrange)
stripspaces single-space
remember-pagee
0 "" rot get-playerdbrefs
dup if
comma-format dup " " instr
"I don't recognize the player"
swap if "s" strcat then
" named " strcat swap strcat
tell
else pop
then
;
: do-sleepers (dbrefrange -- dbrefrange')
dup "" remove-sleepers
dup if
comma-format dup " " instr
if " are " else " is " then
"currently asleep." strcat
strcat tell
"You can leave page-mail with 'page #mail <plyrs>=<msg>'"
tell
else pop
then
;
: do-erasees (dbrefrange -- dbrefrange')
dup "" remove-non-erasees
dup if
comma-format
" didn't have any messages from you."
strcat tell
else pop
then
;
: do-nopagers (dbrefrange -- dbrefrange')
dup "" remove-nopagers
dup if
comma-format dup " " instr
if " are " else " is " then
"currently not accepting pages."
strcat strcat tell
else pop
then
;
: do-ignoring (dbrefrange -- dbrefrange')
dup "" remove-ignoring
dup if
comma-format dup " " instr
if " are " else " is " then
"currently ignoring you."
strcat strcat tell
else pop
then
;
: do-nonwiz (dbrefrange -- dbrefrange')
dup "" remove-nonwiz
dup if
comma-format dup " " instr if
" are not wizards."
else
" is not a wizard."
then
strcat tell
else pop
then
;
: do-maxers ( dbrefrange -- dbrefrange' )
dup dup "" remove-maxers
dup if
comma-format dup " " instr
if " don't " else " doesn't " then
"want to be included in multi-pages to that many people."
strcat strcat tell
else pop
then
;
: do-list-ignored-pagees (dbrefrange -- dbrefrange')
dup "" list-ignored-pagees
dup if
comma-format dup " " instr
if " are " else " is " then
"currently ignored by you."
strcat strcat tell
else pop
then
;
: get-valid-pagees (players -- dbrefrange players')
do-getplayers
do-sleepers
me @ name "Guest" stringcmp not if do-nonwiz then
do-nopagers
do-ignoring
do-maxers
do-list-ignored-pagees
dup "" refs2names
;
( each stuff )
: page-toeach (dbrefrange to message -- )
3 pick not if pop pop pop exit then
3 pick 3 + rotate over swap
(refrange to mesg mesg dbref)
dup remember-pager
get-curr-format
me @ swap get-oformat-prop
(refrange to mesg mesg dbref format)
5 pick page-them-inform
rot 1 - rot rot page-toeach
;
: summon-toeach (dbrefrange -- )
dup not if pop exit then
dup 1 + rotate
dup remember-pager
"You sense that " me @ name strcat
" is looking for you in " strcat
me @ location name strcat
over me @ location owner dbcmp if
me @ location intostr
"(#" swap strcat ")" strcat strcat
then
"." strcat notify
1 - summon-toeach
;
: mail-toeach (dbrefrange message -- )
over not if pop pop exit then
over 2 + rotate
over swap mail-send
swap 1 - swap mail-toeach
;
: mail-do-forwards (dbrefrange message -- )
over not if pop pop exit then
swap 1 - swap
over 3 + rotate
dup get-forward dup if
do-getplayers dup if
dup "" remove-ignoring pop
dup 2 + rotate name
"(Orig. to " swap strcat
") " strcat
over 3 + pick strcat
else pop 1 3 pick
then
else pop 1 3 pick
then
mail-toeach
mail-do-forwards
;
: check-each (dbrefrange -- )
dup not if pop exit then
dup 1 + rotate
dup name " has " strcat
over mail-count
dup not if
pop "no messages" strcat
else
dup 1 = if
pop "1 message" strcat
else
intostr strcat
" messages" strcat
then
then
" waiting." strcat
over mail-count if
" Oldest is dated " strcat swap
oproploc dup "_page/mail" "#/1" strcat getpropstr
dup not if
swap "_page/mail"
"1" strcat getpropstr
then
swap pop mail-unparse-mesg
pop swap pop strcat "." strcat
else swap pop
then
tell
1 - check-each
;
: ignore-each (dbrefrange -- )
dup not if pop exit then
swap ignore-dbref
1 - ignore-each
;
: unignore-each (dbrefrange -- )
dup not if pop exit then
swap unignore-dbref
1 - unignore-each
;
: priority-each (dbrefrange -- )
dup not if pop exit then
swap priority-dbref
1 - priority-each
;
: unpriority-each (dbrefrange -- )
dup not if pop exit then
swap unpriority-dbref
1 - unpriority-each
;
( multi stuff )
: multi-page (message player -- )
get-valid-pagees
dup if
(message dbrefrange playerstr)
dup me @ setlastpaged comma-format
(message dbrefrange playerstr)
over 3 + rotate
(dbrefrange playerstr message)
dup me @ get-curr-format
(derefrange plyrstr mesg mesg formatname)
get-format-prop
(derefrange plyrstr mesg mesg format)
over " " split pop
1 strcut strlen 3 <
over not if swap pop " " swap then
".,?!:' " rot instr and
if "%i%m" "%i %m" subst then
(derefrange plyrstr mesg mesg format)
4 pick "%n" subst
(derefrange plyrstr mesg mesg format)
dup "%w" instr if
get-timestr
"%w" subst
then
me @ name "%i" subst
(derefrange plyrstr mesg mesg format)
swap "%m" subst
(derefrange plyrstr mesg format)
page-me-inform page-toeach
me @ havened? if
"You are currently set haven."
tell
then
else pop pop pop
then
;
: multi-summon (player -- )
get-valid-pagees
dup if
dup me @ setlastpaged comma-format
"You sent your summons to "
swap strcat "." strcat
page-me-inform summon-toeach
me @ havened? if
"You are currently set haven."
tell
then
else pop pop
then
;
: multi-ping (player -- )
get-valid-pagees
dup if
dup me @ setlastpaged
comma-format
"You can page to "
swap strcat "." strcat
page-me-inform popn
me @ havened? if
"You are currently set haven."
tell
then
else pop pop
then
;
: multi-mail (mesg names -- )
do-getplayers
do-ignoring
dup "" refs2names
( mesg {dbref_range} names )
dup if
dup me @ setlastpaged
over 3 + rotate dup pagepose? if
1 strcut swap pop
dup " " split pop
1 strcut strlen 3 <
over not if swap pop " " swap then
".?!,': " rot instr and
not if " " swap strcat then
me @ name swap strcat
then
swap comma-format
"You page-mail \"" 3 pick strcat
"\" to " strcat over strcat "." strcat tell
dup " " instr if
"(to " swap strcat ")" strcat strcat
else pop
then
mail-do-forwards
me @ havened? if
"You are currently set haven."
tell
then
then
;
: multi-check
do-getplayers
dup if
check-each
then
;
: multi-erase (player -- )
do-getplayers
do-erasees
dup "" refs2names
dup if
comma-format
"You erased your last message to "
swap strcat "." strcat
page-me-inform popn
else pop pop
then
;
: multi-ignore (players -- )
do-getplayers
dup "" refs2names
comma-format
"Adding " swap strcat
" to your ignore list."
strcat tell ignore-each
;
: multi-unignore (players -- )
do-getplayers
dup "" refs2names
comma-format
"Removing " swap strcat
" from your ignore list."
strcat tell unignore-each
;
: multi-priority (players -- )
do-getplayers
dup "" refs2names
comma-format
"Adding " swap strcat
" to your priority list."
strcat tell priority-each
;
: multi-unpriority (players -- )
do-getplayers
dup "" refs2names
comma-format
"Removing " swap strcat
" from your priority list."
strcat tell unpriority-each
;
( _______
{__|__ \
___|__}_/
)
( help stuff )
: show-help-list
dup not if pop exit then
dup 1 + rotate tell
1 - show-help-list
;
: show-changes
"MUFpage v2.40 by Foxen" " Changes" strcat
"---------------------------------------------------------------------------"
"v2.40 7/13/92 Modded to use propdirs and assume FB server."
"v2.35 3/31/92 Made page-posing more intelligent with regards to spacing."
"v2.34 2/ 5/92 Make lastpaged/r/group encrypted. Improved encryptions."
" Added partial name matching for last five pagers."
"v2.32 1/22/92 Added #lookup <player> to list aliases w/ them in them."
"v2.31 10/31/91 Summoning now gives room# if pagee owns room pager is in."
"v2.30 10/12/91 Added #priority for letting players page you despite haven."
"v2.29 10/11/91 Added #sleepmsg, #haven and #ignore messages."
"v2.26 10/10/91 Fixed #multimax probs, and made #mail remember last paged."
"v2.25 9/ 6/91 Fixed #proploc page-mail copying problem. Added #multimax."
"-- Type 'page #help' to see more info on each command. \"feeps 4-ever!\" --"
13 show-help-list
;
( old changes:
"v2.23 8/21/91 Added #erase for erasing messages mistakenly #mailed."
"v2.22 6/20/91 Added #inform. Various bugfixes and security fixes."
"v2.20 6/17/91 Made #proploc work with p-aliases. Added 'page &<alias>'"
" Fixed aliases to work with dbrefs and ignore stuff in parens"
"v2.18 6/14/91 Made it sort all multiple name outputs alphabetically."
"v2.17 6/12/91 Added sorting to alias listing."
"v2.16 6/11/91 Made small formatting fixes. Moved p-aliases to player"
"v2.15 5/27/91 Made paging of multiple ignored players list on one line."
"v2.14 5/21/91 Added %w oformat sub for time. Made all functions that"
" take player arguments work with page-again feature. Added"
" #time to tell the current time. Helpful with %w's"
"v2.11 5/20/91 Added #proploc and made #ignore work on page-mail."
"v2.09 5/16/91 Added #check to see if a player has page-mail waiting."
"v2.08 5/16/91 Made page-mail use encryption, and disallowed multi-page"
" usage by the Guest character. Added update notification."
"v2.05 5/ 9/91 Added %t substitution for #oformats to list all paged to."
"v2.04 5/ 9/91 Added #forward, and day stamping in page-mail."
"v2.02 5/ 1/91 Added #credits and fixed a problem with paging when broke."
"v2.00 4/27/91 Removed #pose, #opose, #page, #opage and replaced them with"
" #format, #oformat and 'page !<format> <plyrs>=<msg>'."
20 )
: show-credits
"MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat " Credits" strcat
"-------------------------------------------------------------------------"
"The following people, through questions, comments, or suggestions gave me"
"the ideas for the following features: (in alphabetical order)"
" Ashtoreth: disallowing Guest multi-paging, #inform"
" auzzie: #ignore, formats, #haven, #ping, #help, #credits"
" Bruce: #mail"
" Chris: informing when you are haven, or page an ignored player"
" ChupChup: #echo, #standard, using /lib/cpp"
" darkfox: various coding ideas, %w subs, and being a kooshball target"
" Erych: encryption of page-mail"
" fur: Made all player arg commands work with page-again"
" Gazer: The shell sort routines. (he wrote the code)"
" Jack_Salem: #erasing of mistakenly sent page-mail"
" Karrejanshi: showing room numbers in summons when pagee owns room."
" Lunatic: single line messages for multiple people."
" Lynn_Onyx: page #mail security loophole fix. #priority"
" Miller: #check"
" Platypus_Bob: #prepending formats, #standard formats"
" Siegfried: disallowing Guest use of #commands. dbrefs in aliases."
" Snooze: debugging help with paging without pennies"
" tk: global and personal multi-person aliases"
" Tugrik: multiple selectable formats"
"And this leaves only multi-player paging, #version, #changes, #hints,"
"#index and page-posing as completely my own ideas that no-one else"
"suggested I add into it. Oh yes... and #feep."
26 show-help-list
;
: show-index
"MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat " Index" strcat
"----------------------------------------------------------------"
"Aliases 2,A Multimax 2 "
"Changes 1 Oformats 3,A,B"
"Echo 3 Page format A,B "
"Erase 1 Pose format A,B "
"Formatted 3 Paging 1 "
"Formats 3,A Pinging 2 "
"Forwarding 3 Posing 1,B "
"Global aliases 2,A Prepend 3,B "
"Haven 2 Proploc 3,B "
"Help 1,2,3 Repaging 1 "
"Hints 1,A,B Replying 1 "
"Ignoring 2 Sleepmsg 2 "
"Inform 3 Standard 3 "
"Mailing 1 Summoning 1 "
"Mail-checking 3 Version 1 "
"Multi-paging 1 Who 1 "
"-- 1 = page #help 2 = page #help2 3 = page #help3 --"
"-- A = page #hints B = page #hints2 --"
20 show-help-list
;
: show-help
"MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat " Page1" strcat
"--------------------------------------------------------------------------"
"To give your location to another player: 'page <player>'"
"To send a message to another player: 'page <player> = <message>'"
"To send a pose style page to a player: 'page <player> = :<pose>'"
"To page multiple people: 'page <plyr> <plyr> [= <msg>]'"
"To send another mesg to the last players: 'page = <message>'"
"To send your loc to the last players paged: 'page'"
"To send a message in a different format: 'page !<fmt> <plyrs> = <msg>'"
"To reply to a page sent to you: 'page #r [= <message>]'"
"To reply to all the people in a multi-page: 'page #R [= <message>]'"
"To leave a page-mail message for someone: 'page #mail <players>=<mesg>'"
"To read all page-mail messages left for you: 'page #mail'"
"To erase a message you sent to a player: 'page #erase <players>'"
"To list who you last paged, who last"
" paged you, and who you are ignoring: 'page #who'"
"To display what version this program is: 'page #version'"
"To display the latest program changes: 'page #changes'"
"To show who all helped with this program: 'page #credits'"
"To display an index of commands: 'page #index'"
"To display the next help screen: 'page #help2'"
"-- Words in <gt; are parameters. Parameters in [] are optional. --"
19
3 +
show-help-list
;
: show-help2
"MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat " Page2" strcat
"------------------------------------------------------------------------"
"To test if you can page a player: 'page #ping <players>'"
"To refuse pages from specific players: 'page #ignore <players>'"
"To set the mesg all ignored players see: 'page #ignore [<plyrs>]=<mesg>'"
"To accept pages from a player again: 'page #!ignore <player>'"
"To let players page you despite haven: 'page #priority <players>'"
"To remove players from your priority list: 'page #!priority <players>'"
"To page a group of people in an alias: 'page *<aliasname> = <message>'"
"To set a personal page alias: 'page #alias <alias>=<players>'"
"To clear a personal page alias: 'page #alias <alias>='"
"To list who is in an alias: 'page #alias <alias>'"
"To list all your personal aliases: 'page #alias'"
"To set an alias to the players last paged: 'page &<aliasname>'"
"To make an alias that everyone can use: 'page #global <alias>=<players>'"
"To clear a global page alias: 'page #global <alias>='"
"To list all the global aliases: 'page #global'"
"To list all aliases with a player in them: 'page #lookup <playername>'"
"To see the time (useful with %w subs): 'page #time'"
"To set the max# of plyrs in a page to you: 'page #multimax <max#players>'"
"To see your multimax setting: 'page #multimax'"
"To set the your 'Sleeping' message: 'page #sleepmsg <message>'"
"To clear the your 'Sleeping' message: 'page #sleepmsg #clear'"
"To display the third and last help screen: 'page #help3'"
24 show-help-list
;
: show-help3
"MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat " Page3" strcat
"--------------------------------------------------------------------------"
"To haven yourself so you are unpagable: 'page #haven'"
"To set your 'havened' message: 'page #haven <message>'"
"To clear your 'havened' message: 'page #haven #clear'"
"To unhaven yourself so you can be paged: 'page #!haven'"
"To turn on echoing of your message: 'page #echo'"
"To turn off echoing of your message: 'page #!echo'"
"To be informed when a page to you fails: 'page #inform'"
"To be turn off failed-page informing: 'page #!inform'"
"To see another player's formatted pages: 'page #formatted'"
"To prepend a format string to other's pages: 'page #prepend'"
"To set your prepended format string: 'page #prepend <formatstr>'"
"To force other's pages to a standard format: 'page #standard'"
"To set the standard format you receive in: 'page #standard <formatstr>'"
"To set a format that you see when paging: 'page #format <fmtname>=<fmt>'"
"To set a format that others receive: 'page #oformat <fmtname>=<fmt>'"
17
"To forward page-mail to another player: 'page #forward <players>'"
"To stop forwarding page-mail: 'page #forward #'"
"To see who page-mail to you is forwarded to: 'page #forward'"
"To see if page-mail is waiting for a player: 'page #check [players]'"
5 rotate 4 +
"To use an object for storing page props on: 'page #proploc <object>'"
swap 1 +
show-help-list
;
: show-hints
"MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat " Hints1" strcat
"--------------------------------------------------------------------------"
"All page commands can be used abbreviated to unique identifiers."
" For example: 'page #gl' is the same as 'page #global'"
"If you page to a name it doesn't recognize, it will check to see if it is"
" a personal alias. If it isn't, it checks to see if it is a global alias."
" For example: If there is a global alias 'tyg' defined as 'Tygryss', then"
" 'page tyg=test' will page 'test' to Tygryss."
"In format strings, %n will be replaced by the name of the player(s) receiv-"
" ing the page. %m will be replaced by the message. %i will be replaced"
" by your name. %w gets replaced by the time. These messages are what are"
" shown to you when you page to someone."
"In oformat strings, %n will be replaced by your name, %m by the message,"
" and %l by your location. %t will be replaced with the names of all the"
" people in a multi-page. %w will be replaced with the current time."
" These messages are what is shown to the player you are paging."
"If you have a #prepend or #standard format with a %w, it shows you the time"
" when a player paged you."
"Use 'page #hints2' to show the next hints screen."
19 show-help-list
;
: show-hints2
"MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat " Hints2" strcat
"--------------------------------------------------------------------------"
"There are two standard formats with page: the 'page' format, and the 'pose'"
" format. There are matching #oformats to go with them as well."
"If you really dislike having your pages that begin with colon's parsed as"
" page-poses, then you can 'page #oformat pose=%n pages: :%m'"
" or alternately, you can simply use 'page ! <players>=<mesg>'"
"One good way to have all the pages to you beeped and hilighted is to do:"
" 'page #prepend ##page>' and then set up the this trigger in tinyfugue:"
" '/def -p15 -fg -t\"##page> *\" = /beep 3%;/echo %e[7m%-1%e[0m'"
" If you want bold hilites instead, use '%e[1m' instead of '%e[7m'"
" This only works if you have version 1.5.0 or later of tinyfugue and a"
" vt100 terminal type."
"TinyTalk users, to make your pages always beep, use 'page #standard'"
" Then all pages to you will be in standard page format."
"You can specify another object to store the properties used by the page"
" program on. To do this, type 'page #proploc <object>' where <object>
" is either the name (if its in the room) or dbref of the object to use."
" #proploc will automatically copy all the page props to the new object."
19
show-help-list
;
: show-who-info ( -- )
"You last paged to "
me @ getlastpaged comma-format
dup not if pop "no one" then
strcat "." strcat tell
"The last six people to page you were "
me @ getlastpagers comma-format
dup not if pop "no one" then
strcat " (who paged last)." strcat tell
me @ getlastpagedgroup comma-format
dup if
"The last group page also included "
swap strcat "." strcat tell
else pop
then
"You are receiving pages in "
me @ page_standard?
dup 1 = if pop "prepended"
else
2 = if "forced standard"
else "regular formatted"
then
then
strcat " form." strcat tell
me @ get-multimax dup 888 < if
"You accept pages including up to "
over intostr strcat swap 1 >
if " people." else " player." then strcat tell
else pop
then
"You are ignoring "
list-ignored dup not
if pop "no one" then
strcat "." strcat tell
"You are giving priority to "
list-priority dup not
if pop "no one" then
strcat "." strcat tell
me @ "haven" flag? if
"You are currently set haven, so no one can page you."
tell
then
;
: page-main
stripspaces
dup "&" 1 strncmp not if
1 strcut swap pop
"=" strcat me @
getlastpaged strcat
"#alias " swap strcat
then
dup "#R" 2 strncmp not if
2 strcut swap pop
me @ getlastpagedgroup
" " strcat swap strcat
"#r" swap strcat
then
dup "#r" 2 strncmp not if
2 strcut swap pop
me @ getlastpager
" " strcat swap strcat
then
dup "#" 1 strncmp not if (if it begins with #, then it is a command)
dup "#who" 2 stringmatch? if
pop show-who-info exit
then
dup "#version" 2 stringmatch? if
pop "MUFpage v2.40 by Foxen" " " strcat "Updated 7/13/92" strcat
tell exit
then
dup "#changes" 2 stringmatch? if
pop show-changes exit
then
dup "#credits" 3 stringmatch? if
pop show-credits exit
then
dup "#index" 3 stringmatch? if
pop show-index exit
then
dup "#help" 2 stringmatch? if
pop show-help exit
then
dup "#help2" stringcmp not
over "#hel2" stringcmp not or
over "#he2" stringcmp not or
over "#h2" stringcmp not or if
pop show-help2 exit
then
dup "#help3" stringcmp not
over "#hel3" stringcmp not or
over "#he3" stringcmp not or
over "#h3" stringcmp not or if
pop show-help3 exit
then
dup "#hints" 3 stringmatch? if
pop show-hints exit
then
dup "#hints2" stringcmp not
over "#hint2" stringcmp not or
over "#hin2" stringcmp not or
over "#hi2" stringcmp not or if
pop show-hints2 exit
then
me @ name "Guest" stringcmp not if
pop "Permission denied." tell exit
then
dup "#feep" 5 stringmatch? if
do-feep pop exit
then
dup "#!haven" 3 stringmatch? if
pop me @ "!haven" set
"Haven bit reset."
tell exit
then
dup "#echo" 2 stringmatch? if
pop "" set_page_echo
"Pages now echoed." tell exit
then
dup "#!echo" 3 stringmatch? if
pop "no" set_page_echo
"Pages now not echoed." tell exit
then
dup "#inform" 3 stringmatch? if
pop "yes" set_page_inform
"You will now be informed of ignored page attempts."
tell exit
then
dup "#!inform" 4 stringmatch? if
pop "" set_page_inform
"You will no longer be informed of ignored page attempts."
tell exit
then
dup " " instr if
" " split swap
dup "#mail" 2 stringmatch? if
pop stripspaces dup "=" instr if
"=" split stripspaces swap
multi-mail exit
else
"page: #mail format: 'page #mail <players>=<message>'"
tell pop exit
then
then
dup "#check" 3 stringmatch? if
pop multi-check exit
then
dup "#haven" 3 stringmatch? if
pop stripspaces dup
"#clear" stringcmp not if pop "" then
me @ set-havenmsg
me @ "haven" set
"Haven message and haven bit are now set." tell exit
then
dup "#sleepmsg" 3 stringmatch? if
pop stripspaces dup
"#clear" stringcmp not if pop "" then
me @ set-sleepmsg
"Sleep message is set." tell exit
then
dup "#ignore" 2 stringmatch? if
pop stripspaces dup "=" instr if
"=" split stripspaces
swap stripspaces swap
me @ set-ignoremsg
"Ignore message is set." tell
dup not if pop exit then
then
single-space multi-ignore exit
then
dup "#!ignore" 3 stringmatch? if
pop stripspaces single-space
multi-unignore exit
then
dup "#priority" 2 stringmatch? if
pop stripspaces single-space
multi-priority exit
then
dup "#!priority" 3 stringmatch? if
pop stripspaces single-space
multi-unpriority exit
then
dup "#format" 2 stringmatch? if
pop dup "=" instr if
"=" split stripspaces swap
stripspaces single-space
"_" " " subst
me @ swap rot
set-format-prop
"Format set." tell
else
stripspaces dup
me @ swap get-format-prop
swap "' set to \"" strcat
swap strcat "\"" strcat
"Format '" swap strcat tell
then exit
then
dup "#oformat" 3 stringmatch? if
pop dup "=" instr if
"=" split stripspaces swap
stripspaces single-space
"_" " " subst
me @ swap rot
set-oformat-prop
"Oformat set." tell
else
stripspaces dup
me @ swap get-oformat-prop
swap "' set to \"" strcat
swap strcat "\"" strcat
"Oformat '" swap strcat tell
then exit
then
dup "#alias" 2 stringmatch? if
pop dup "=" instr if
"=" split single-space
stripspaces swap
stripspaces single-space
dup not if
"page: #alias: Alias name cannot be null"
tell pop pop exit
then
"_" " " subst swap
set-personal-alias
else
stripspaces dup me @
get-alias "Alias \"" rot
strcat "\" expands to \""
strcat swap strcat "\""
strcat tell
then exit
then
dup "#global" 2 stringmatch? if
pop "=" split stripspaces single-space
swap stripspaces single-space
dup not if
"page: #global: Alias name cannot be null"
tell pop pop exit
then
"_" " " subst swap
set-global-alias exit
then
dup "#lookup" 3 stringmatch? if
pop single-space stripspaces
list-matching-aliases
"Done." tell exit
then
dup "#forward" 4 stringmatch? if
pop single-space
dup "#" strcmp not if
pop "" "Page-mail forwarding cleared."
else
"Page-mail forwarding set."
then tell set-forward exit
then
dup "#erase" 4 stringmatch? if
pop stripspaces single-space
multi-erase exit
then
dup "#multimax" 3 stringmatch? if
pop stripspaces atoi
me @ set-multimax
"Multi-max set." tell exit
then
dup "#standard" 3 stringmatch? if
pop me @ set-standard
"yes" set_page_standard
"Page standard format set."
tell exit
then
dup "#prepended" 3 stringmatch? if
pop me @ set-prepend
"prepend" set_page_standard
"Page prepend format set."
tell exit
then
dup "#ping" 3 stringmatch? if
pop stripspaces
multi-ping exit
then
dup "#proploc" 4 stringmatch? if
pop do-proplock-set exit
then
else
dup "#mail" 2 stringmatch? if
pop mail-read "Done." tell exit
then
dup "#check" 3 stringmatch? if
pop me @ name multi-check exit
then
dup "#haven" 3 stringmatch? if
pop me @ "haven" set
"Haven bit set." tell
"Your haven message is \""
me @ get-havenmsg strcat
"\"" strcat tell exit
then
dup "#sleepmsg" 3 stringmatch? if
pop "Your sleep message is \""
me @ get-sleepmsg strcat
"\"" strcat tell exit
then
dup "#ignore" 2 stringmatch? if
"You are currently ignoring "
list-ignored dup not
if pop "no one" then
strcat "." strcat
tell pop "Your ignore message is \""
me @ get-ignoremsg strcat "\"" strcat
me @ swap notify exit
then
dup "#!ignore" 3 stringmatch? if
"" me @ setignorestr
"You are now ignoring no one."
tell pop exit
then
dup "#priority" 2 stringmatch? if
"You are currently prioritizing "
list-priority dup not
if pop "no one" then
strcat "." strcat
tell pop exit
then
dup "#!priority" 3 stringmatch? if
"" me @ setprioritystr
"You are now prioritizing no one."
tell pop exit
then
dup "#time" 2 stringmatch? if
pop "The time is: "
get-timestr strcat
tell exit
then
dup "#alias" 2 stringmatch? if
list-personal-aliases
"Done." tell exit
then
dup "#global" 2 stringmatch? if
list-global-aliases
"Done." tell exit
then
dup "#lookup" 3 stringmatch? if
"Syntax: page #lookup <name>"
tell exit
then
dup "#formatted" 3 stringmatch? if
pop "" set_page_standard
"Pages now received in formatted form."
tell exit
then
dup "#multimax" 3 stringmatch? if
pop me @ get-multimax
"You currently accept pages including up to "
over intostr strcat swap 1 >
if " people." else " player." then strcat
tell exit
then
dup "#oformat" 3 stringmatch? if
"Bad #oformat syntax. Type 'page #help3' for more help."
tell pop exit
then
dup "#forward" 4 stringmatch? if
pop me @ get-forward comma-format
dup if
"You currently forward page-mail to "
swap strcat "." strcat
else
pop "You aren't currently forwarding page-mail."
then tell exit
then
dup "#standard" 3 stringmatch? if
pop "yes" set_page_standard
"Pages now received in the standard form '"
me @ get-standard strcat "'" strcat
tell exit
then
dup "#prepended" 3 stringmatch? if
pop "prepend" set_page_standard
"Pages now received prepended with '"
me @ get-prepend strcat "'" strcat
tell exit
then
dup "#setup" 3 stringmatch? if
trigger @ "_page/formats/page"
"You page, \"%m\" to %n." setpropstr
trigger @ "_page/formats/opage"
"%n pages, \"%m\" to %t." setpropstr
trigger @ "_page/formats/pose"
"You page-pose, \"%i %m\" to %n" setpropstr
trigger @ "_page/formats/opose"
"In a page-pose to %t, %n %m" setpropstr
"Setup done." tell pop exit
then
dup "#proploc" 4 stringmatch? if
pop "Syntax: page #proploc <object>" tell exit
then
then
"page: Syntax error: " swap strcat tell
"Type \"page #help\" for help." tell exit
then
dup "=" instr not if
stripspaces single-space
me @ name "Guest" stringcmp not if
dup " " instr if
" " split pop
"Guests are not allowed to use multi-page." tell
then
then
multi-summon (do a summons page)
else
"=" split
stripspaces
dup pagepose? if
1 strcut swap pop
"pose" set-curr-format
else
"page" set-curr-format
then
swap stripspaces single-space
dup "!" 1 strncmp not if
" " split swap
1 strcut swap pop
dup not if pop "page" then
set-curr-format
then
me @ name "Guest" stringcmp not if
dup " " instr if
" " split pop
"Guests are not allowed to use multi-page." tell
then
then
multi-page (do a message page)
then
;
: main
getday setday
page-main
me @ mail-count 0 > if
"You have " me @ mail-count intostr strcat
" page-mail messages waiting. Use 'page #mail' to read."
strcat tell
then
get-lastversion "MUFpage v2.40 by Foxen" strcmp if
"Page has been upgraded. Type 'page #changes' to see the latest mods." tell
get-lastversion dup if
"You last used " swap strcat tell
else pop
then
"MUFpage v2.40 by Foxen" set-lastversion
then
;
.
c
q
@set cmd-page=w
@action page;pag;pa;p=#0=tmp/exit1
@link $tmp/exit1=cmd-page
page #setup
/sub on