@prog multipage.muf 1 9999 d 1 i ( Multi-pager v4.11. Original page program written by Sjade. Many major modifications made by me, Radagast. How to use the program is your problem. Read the docs. How the program works is my problem. Commenting is for pansies. Still to-do: ignore-haven Radagast can be contacted at radagast@holo.rodents.montreal.qc.ca. ) : proploc dup "_proploc" getpropstr atoi dbref dup #0 dbcmp not if swap pop else pop then ; : AP rot proploc -3 rotate addprop ; : GP swap proploc swap getpropstr ; : RP swap proploc swap remove_prop ; : PE? swap proploc swap prop-exists? ; : PName over "_pager" GP dup not if pop "pager" then "[pager]" subst ; : TM me @ swap PName notify ; : TNM loc @ me @ rot PName notify_except ; : Cut ( s i -- s' ) strcut swap pop ; : Unpack "$@" "%c" subst "//" "%b" subst "%" "%a" subst ; : Pack "%a" "%" subst "%b" "//" subst "%c" "$@" subst ; : Busy? ( d -- i ) dup "r" flag? over "c" flag? or swap "b" flag? and ; : Smashed? ( d -- i ) dup "_pager-smashed" GP dup if atoi systime swap - 30 < if pop 1 exit else "_pager-smashed" RP 0 then else pop pop 0 then ; : Dead? over Smashed? if "smokes slightly." 1 else 0 then ; : Snd Dead? if exit then over "_page" GP dup not if pop "beeps." then ; : OSnd Dead? if exit then over "_opage" GP dup not if pop Snd then ; : NoSnd over "_nopage" GP dup not if pop "beeps twice, indicating no messages." then ; : ONoSnd over "_onopage" GP dup not if pop NoSnd then ; : Speak over "_speak" GP dup not if pop "into %p [pager]." then ; : Activator me @ "_page-activator" GP dup not if pop "%" then ; : SetActivator dup not if pop "What character should activate the [pager] commands?" TM read then 1 strcut pop dup " " strcmp not if pop "A space is not a valid activator." TM exit then me @ "_page-activator" rot dup if AP else pop RP then "Page Command Activator is now: %a" Activator "%a" subst TM ; : Space? dup not if exit then me @ "_page-nospace" GP dup not if pop prog "_kill-space" GP dup not if pop "-=:;,.' " then then over 1 strcut pop instr not if " " swap strcat then ; : Ignored? prog "_" rot intostr strcat "." strcat me @ intostr strcat prop-exists? ; : nosucc? me @ "_page-nosucc" PE? ; : PSet "Property set." TM ; : PRem "Property removed." TM ; : Bury depth -1 * rotate ; : EnvQuiet? ( d -- i ) begin dup #0 dbcmp not while dup "_quiet" prop-exists? if pop 1 exit then location repeat pop 0 ; : conuser-map ( s -- s ) dup "(connect: Connection refused" 28 strncmp not if pop "???" else dup "(" 1 strncmp not eif pop "(err)" then ; : SetFormat dup tolower dup "say" instr 1 = if pop 4 Cut me @ "_page-format-say" rot dup if AP PSet else pop RP PRem then exit then dup "pose" instr 1 = if pop 5 Cut me @ "_page-format-pose" rot dup if AP PSet else pop RP PRem then exit then dup "invite" instr 1 = if pop 7 Cut me @ "_page-format-invite" rot dup if AP PSet else pop RP PRem then exit then dup "forcesay" instr 1 = if pop 9 Cut me @ "_page-format-force-say" rot dup if AP PSet else pop RP PRem then exit then dup "forcepose" instr 1 = if pop 10 Cut me @ "_page-format-force-pose" rot dup if AP PSet else pop RP PRem then exit then dup "forceinvite" instr 1 = if pop 12 Cut me @ "_page-format-force-invite" rot dup if AP PSet else pop RP PRem then exit then "Format command not recognized." TM ; : MakeCmd Activator swap strcat ; : Subs ( msg template -- s ) dup "%n" instr not if "%n " swap strcat then me @ name "%n" subst loc @ "private" prop-exists? me @ "private" prop-exists? or if "a private location" else loc @ name then "%l" subst swap "%m" subst ; : MakePage ( d s i -- d s s ) if 1 Cut Space? over "_page-format-force-pose" GP dup not if pop me @ "_page-format-pose" GP then else over "_page-format-force-say" GP dup not if pop me @ "_page-format-say" GP then then ; : MakeInvite ( d s -- d s s ) over "_page-format-force-invite" GP dup not if pop me @ "_page-format-invite" GP dup not if pop "%n invites you to \"%l\"." then then ; : MakePageNow ( d -- d s ) me @ "*pagemsg" GP dup if ":;" over 1 strcut pop instr dup if MakePage dup not if pop "%n pages from %l: %n%m" then else MakePage dup not if pop "%n pages from %l: \"%m\"" then then else MakeInvite then Subs ; : MakePageMail ( d -- d s ) me @ "*pagemsg" GP dup if ":;" over 1 strcut pop instr dup if MakePage dup not if pop "%n%m" then else MakePage dup not if pop "%n pages: \"%m\"" then then else MakeInvite then me @ name "Guest" instr 1 = 4 pick wizard? and if dup " " instr strcut swap "(" strcat me @ .dbrefcon 1 - mpop dup conuser conuser-map "@" strcat swap conhost strcat ") " strcat strcat swap strcat then Subs Pack "$@" strcat systime intostr strcat "/" strcat "/" swap strcat ; : Ago ( i -- s ) systime swap - " " over 86400 / dup 0 > if dup intostr " day" strcat swap 1 = not if "s" strcat then ", " strcat strcat swap 86400 % swap else pop then over 3600 / dup 0 > if dup intostr " hour" strcat swap 1 = not if "s" strcat then ", " strcat strcat swap 3600 % swap else pop then over 60 / dup 0 > if dup intostr " minute" strcat swap 1 = not if "s" strcat then ", " strcat strcat swap 60 % swap else pop then swap dup intostr " second" strcat swap 1 = not if "s" strcat then " ago." strcat strcat ; : SayTime ( s -- ) me @ "_pagetime" GP dup "off" stringcmp not if pop pop else "since" stringcmp not if atoi Ago " Time> " swap strcat TM else atoi ctime " Time> " swap strcat TM then then ; : Used? me @ "*page-used" GP "." rot strcat "." strcat instr ; : Use-it me @ "*page-used" over over GP "." 5 rotate strcat "." strcat strcat AP ; : #Pages me @ "@pmsg" getpropstr dup if "//" explode else pop 0 then ; : Say#Pages "You have %# page(s) stored." over intostr "%#" subst TM ; : Lose-it pop dup 1 + rotate pop -1 * "lost-pagee" swap rotate ; : Concat begin dup 0 > while swap " " strcat rot strcat swap 1 - repeat pop ; : Check_Aliases ( s -- s ) "[end]" swap " " explode pop begin dup "[end]" instr not while me @ "*used-alias" GP "|%a|" 3 pick "%a" subst instr if Bury else me @ "_page-alias-" 3 pick strcat GP dup if me @ "*used-alias" over over GP "|%a|" 6 rotate "%a" subst strcat AP .sstrip " " explode pop else pop Bury then then repeat pop depth 1 - Concat me @ "*used-alias" RP ; : GetNames over "[end]" instr if swap pop dup if dup strlen 2 - strcut pop dup "!%" rinstr dup if 1 - strcut 2 Cut " and " swap strcat strcat else pop then ", " "!%" subst else pop 0 exit then 1 exit then over "lost-pagee" strcmp not if swap pop else swap .pmatch+ name "!%" strcat strcat then GetNames ; : SayWho ( #17920 "_WhoPage-" 3 pick intostr strcat prop-exists? if dup "Page from " me @ name strcat me @ dup "private" prop-exists? not swap location "private" prop-exists? not and if " in " strcat me @ location name strcat then "." strcat notify then ) nop ; : Beep? ( d -- d i ) me @ "*pagenow" PE? not if dup awake? not over "u" flag? or if dup dup "_page-sleep" GP dup not if pop "Note: %n is not online." then pronoun_sub TM 0 exit then dup "h" flag? if dup dup "_page-haven" GP dup not if pop "Note: %n is set HAVEN, so %p pager will not beep." then pronoun_sub TM 0 exit then dup Busy? if dup dup "_page-busy" GP dup not if pop "Note: %n is currently set BUSY. Please page again later." then pronoun_sub TM 0 exit then dup .dbrefcon 1 - mpop conidle ( d i ) dup 600 > if over dup "_page-idle" GP dup not if pop "Note: %n has been idling for #time# minutes. Don't expect an immediate response." then pronoun_sub swap 60 / intostr "#time#" subst TM else pop then dup "d" flag? if 0 exit then dup "_neverbeep" PE? over location EnvQuiet? or if dup "Your [pager] " Dead? not if "vibrates slightly." then strcat PName notify SayWho 0 exit then dup "_nobeep" PE? if dup "@pmsg" prop-exists? if 0 exit then then then dup "_pagesave" GP tolower dup "never" stringcmp not swap "offline" stringcmp not 3 pick awake? and or me @ "*pagenow" PE? or me @ "*pagemail" PE? not and if 0 exit then 1 ; : SavePage ( d -- ) "@pmsg" over over getpropstr 3 pick MakePageMail swap pop strcat addprop ; : SayPage ( d -- ) MakePageNow notify ; : Send_loop ( ... player player i -- ) dup 1 < if "Error in page." exit then ( for debugging only ) 1 swap 1 for dup 1 + pick .pmatch+ dup ok? not if pop dup 1 + rotate "I can't find the pagee, \"%m\"." swap "%m" subst TM -1 * "lost-pagee" swap rotate else ( i d ) dup intostr Used? if Lose-it else ( i d ) dup Ignored? if dup "_ignore-" me @ name strcat GP dup if TM else pop dup "_ignore-page" GP dup if TM else pop dup name " is ignoring you. Your page was not received." strcat TM then then Lose-it else ( i d ) dup intostr Use-it Beep? if dup "Your [pager]" Snd Space? strcat PName notify dup name "'s [pager]" strcat OSnd Space? strcat over location 3 pick rot PName notify_except SayWho then dup "_pagesave" GP tolower dup "never" stringcmp not swap "offline" stringcmp not 3 pick awake? and or me @ "*pagenow" PE? or me @ "*pagemail" PE? not and if SayPage else SavePage then pop then then then repeat ; : Send_pages .sstrip dup not if pop me @ "*last_page" GP then Check_Aliases " " explode Send_loop ; : send_page dup "=" instr not if "Page> Error: All pages need an \"=\" in them. ( page =[] )" TM me @ "_page-neverinvite" PE? not if "Page> Do you want to send an invitation to all these people? (y/N)" TM read "y" instring 1 = if me @ "page " rot strcat "=" strcat force exit then then "Page> Cancelled." TM exit then dup "=" instr 1 - strcut 1 Cut .sstrip me @ "*pagemsg" rot AP Send_Pages me @ "*page-used" RP "[end]" Bury "" GetNames if me @ "*last_page" 3 pick " " " and " subst " " ", " subst AP me @ "_page_noecho" PE? not if me @ "*pagemsg" GP dup if ";:" over 1 strcut pop instr if 1 Cut me @ name " " strcat swap strcat then "You page, \"%%m\" to %%p." swap "%%m" subst else pop "Your invitation has been sent to %%p." then swap "%%p" subst else "Your page has been received by %%p." swap "%%p" subst then TM nosucc? not me @ location EnvQuiet? not and if me @ dup name " speaks" strcat over "*pagemsg" GP strlen dup 100 > if 200 > if " at length " else " " then else pop " briefly " then strcat Speak strcat pronoun_sub TNM then me @ "h" flag? if "Note: You are set HAVEN, so your [pager] will not beep." TM then me @ Busy? if "Note: You are set BUSY, so your [pager] will not beep." TM then then me @ "*pagemsg" RP ; : get_pages_loop dup 0 = if pop exit then dup intostr dup strlen 1 = if "0" swap strcat then ") " strcat rot dup "$@" instr 1 - strcut 2 Cut -3 rotate Unpack strcat TM SayTime trigger @ name "page" instr if me @ "_page-pause" getpropstr dup if atoi else pop 7 then dup not if pop 9999 then over swap % not if " " TM "Press for more." TM " " TM read pop then then 1 - get_pages_loop ; : get_pages dup not if pop trigger @ name "page" instr if me @ "Your [pager]" NoSnd Space? strcat PName notify nosucc? not if loc @ me @ dup name "'s [pager]" strcat ONoSnd Space? strcat PName notify_except then then exit then 1 Cut dup strlen 1 - strcut pop dup "//" instr not if "Messages follow:" TM " " TM "01) " swap dup "$@" instr 1 - strcut 2 Cut -3 rotate Unpack strcat TM SayTime else "//" explode get_pages_loop then ; : Ignore-Who prog propfirst begin while dup "_" me @ intostr strcat "." strcat instr 1 = if dup dup "." instr strcut atoi dbref name " is ignored." strcat TM pop then pop propnext repeat "End of list." TM ; : Ignore .sstrip dup not if pop Ignore-Who exit then dup "=" instr dup if 1 - strcut 1 Cut else pop "" then swap dup .pmatch+ dup ok? if swap pop prog "_" me @ intostr strcat "." strcat 3 pick intostr strcat "y" addprop over if me @ "_ignore-" 3 pick name strcat 4 rotate AP else swap pop then "All pages from " swap name strcat " will be ignored." strcat TM else pop "Player, " swap strcat ", not found." strcat TM then ; : NoIgnore .sstrip .pmatch+ dup ok? if me @ intostr "." strcat over intostr strcat prog "_" rot strcat over over prop-exists? if remove_prop name " removed from Ignore list." strcat TM else pop pop name " was not ignored." strcat TM exit then else pop "Player to delete not found." TM then ; : Say_Alias ( names alias -- ) "\"" swap strcat "\" aliased as \"" strcat swap strcat "\"." strcat TM ; : Alias-Who me @ proploc propfirst begin while dup "_page-alias-" instr 1 = if over over getpropstr over 12 Cut Say_Alias then pop propnext repeat "End of list." TM ; : Kill-Alias ( s -- ) me @ "_page-alias-" 3 pick strcat over over PE? if remove_prop "Alias \"%a\" removed." swap "%a" subst TM else pop pop "\"%a\" was not an alias." swap "%a" subst TM then ; : Alias .sstrip dup not if pop Alias-Who exit then dup "=" instr dup not if pop me @ "_page-alias-" 3 pick strcat GP Say_Alias exit then 1 - strcut 1 Cut dup not if pop Kill-Alias exit then me @ "_page-alias-" 4 pick .sstrip strcat 3 pick .sstrip AP Say_Alias ; : NoAlias .sstrip Kill-Alias ; : SayHelp "Please type \"help page\" for help." TM ; : main me @ Smashed? if "Your [pager] sparks, beeps off-key a few times, and then remains silent." TM exit then .sstrip dup not if pop me @ "_page-default" GP dup not if pop prog "_page-default" GP then then dup "help" stringcmp not over "h" stringcmp not or over "?" stringcmp not or if pop SayHelp exit then dup "%%%" instr 1 = if pop "" SetActivator exit then dup "!@#$%^&*()" instr 1 = if pop Activator "save" strcat then dup "?" strcmp not over "help" strcmp not or if pop Activator "help" strcat then dup tolower dup Activator "get" strcat instr 1 = if pop pop "" "" then dup not over Activator "save" strcat stringcmp not or if pop me @ "@pmsg" getpropstr swap Activator "save" strcat stringcmp if me @ "@pmsg" remove_prop then get_pages exit then dup Activator instr 1 = if dup "activator" instr 2 = if pop 11 Cut SetActivator exit then dup "alias" instr 2 = if pop 7 Cut Alias exit then dup "check" instr 2 = if pop pop #pages Say#Pages mpop exit then dup "default" instr 2 = if pop 9 Cut me @ "_Page-Default" rot AP PSet exit then dup "format" instr 2 = if pop 8 Cut SetFormat exit then dup "help" instr 2 = if pop pop SayHelp exit then dup "ignore" instr 2 = if pop 8 Cut Ignore exit then dup "mail" instr 2 = if pop 5 Cut me @ "*pagemail" "y" AP main me @ "*pagemail" RP exit then dup "noalias" instr 2 = if pop 9 Cut NoAlias exit then dup "noignore" instr 2 = if pop 10 Cut NoIgnore exit then dup "nospace" instr 2 = if pop 9 Cut me @ "_Page-NoSpace" rot AP PSet exit then dup "now" instr 2 = if pop 4 Cut me @ "*pagenow" "y" AP main me @ "*pagenow" RP exit then dup "qcheck" instr 2 = if pop pop #pages dup if Say#Pages then mpop exit then dup "reinvite" instr 2 = if pop me @ "*last_page" GP main exit then dup "store" instr 2 = if pop 7 Cut me @ "_PageSave" rot AP PSet exit then dup "time" instr 2 = if pop 6 Cut me @ "_PageTime" rot AP PSet exit then "Page %a-command not recognized. Ignored." Activator "%a" subst TM then pop send_page ; . c q