: say ( s -- ) me @ swap notify ; : clear_args ( s1 .. sN N -- ) begin dup while swap pop 1 - loop pop ; : itime ( -- s ) time rot pop intostr dup strlen 1 = if "0" swap strcat then ":" strcat swap intostr dup strlen 1 = if "0" swap strcat then strcat ; : box ( s -- s ) "|" strcat "|" swap strcat ; : ljust ( s -- s ) dup strlen "................" swap strcut swap pop strcat ; : rjust ( s -- s ) dup strlen "...................." swap strcut swap pop swap strcat ; : args ( s -- s1 .. sN N ) 1 begin over " " instr dup while rot swap 1 - strcut .sstrip rot 1 + loop pop ; : tr ( -- d ) trigger @ ; : prefixes ( -- s ) me @ ".itn_prefixes" getpropstr dup if exit then pop prog ".itn_prefixes" getpropstr dup if exit then pop "/-%" ; : firstname ( d -- s ) name dup ";" instr dup if 1 - strcut pop else pop then ; : errorlist ( -- ) dup 1 = if "Command not understood or undefined; try \"%t %phelp\"." exit then dup 2 = if "No command-line argument specified; try \"%t %phelp\"." exit then dup 3 = if "Invalid argument to specified command." exit then dup 4 = if "First use or prop error; linking to channel public." exit then dup 5 = if "Quiet status on; no message sent." exit then dup 6 = if "Invalid number of arguments; consult \"%t %phelp\"." exit then "Fatal error; please report the offending command to %o." ; : error ( i -- ) errorlist tr firstname "%t" subst prefixes 1 strcut pop "%p" subst prog owner name "%o" subst "(ITN) Error #%#: %e" swap "%e" subst swap intostr "%#" subst say ; : send ( s i s s -- ) online begin dup while over ".itn_listen" getpropstr dup 4 pick ".itn_quiet" getpropstr not and if tolower over 3 + pick "|" swap strcat "|" strcat tolower instr if over ".itn_%!yformat" 3 pick 7 + pick "%!y" subst getpropstr dup not if pop prog ".itn_%!yformat" 3 pick 7 + pick "%!y" subst getpropstr then over 3 + pick "%!c" subst over 5 + pick "%!t" subst me @ name "%!n" subst over 4 + pick "%!m" subst rot swap notify else swap pop then else pop swap pop then 1 - loop pop pop pop pop pop ; : list ( -- ) ".------------------------------------------." say "| Name Channel |" say "|------------------------------------------|" say me @ ".itn_channel" getpropstr .sstrip tolower online begin dup while over "U" flag? not if dup 2 + pick box 3 pick ".itn_listen" getpropstr tolower swap instr if over ".itn_channel" getpropstr tolower dup me @ ".itn_channel" getpropstr tolower stringcmp not swap "public" stringcmp not or if over ".itn_channel" getpropstr rjust else ".........." rjust then rot dup name swap ".itn_quiet" getpropstr if ljust ".(Q)" strcat else ljust "...." strcat then swap strcat "| " swap strcat " |" strcat me @ swap notify else swap pop then else swap pop then 1 - loop "`------------------------------------------'" say pop pop ; : help ( -- ) ".-------------------------------------------------------------." say "| Inter-user Talk Network for MUF v3.00 by J. Russell Woodman |" say "|-------------------------------------------------------------|" say "| | Say a message on current ITN channel |" say "| : or ; | Pose a message on current ITN channel |" say "| /add | Add a channel or channels to listen to |" say "| /channel [] | Go to channel or show current channel |" say "| /default | Set ITN to do given no arguments |" say "| /help | Display this help screen |" say "| /invite ... | Invite player(s) to current channel |" say "| /listen [...] | Add channels or list with no |" say "| /msg | Send message to channel |" say "| /off | Stop listening temporarily to ITN |" say "| /on | Resume listening to ITN |" say "| /prefix [] | Set prefixes or list with no |" say "| /remove ... | Remove a channel or channels |" say "| /users | List users who can hear you on ITN |" say "| /who | See /users |" say "|-------------------------------------------------------------|" say "| [] indicates that an argument is optional |" say "| ... indicates you may supply more than one argument |" say "`-------------------------------------------------------------'" say ; : chan ( s -- ) dup 2 > if 6 error exit then dup 1 = if "(ITN) Message: You are on channel %c." me @ ".itn_channel" getpropstr "%c" subst say exit then pop swap pop tolower me @ ".itn_channel" getpropstr tolower over over stringcmp not if "(ITN) Message: You are already on that channel." say me @ ".itn_listen" getpropstr tolower over box instr not if "(ITN) Message: Not listening to current channel; adding." say me @ ".itn_listen" getpropstr swap box strcat me @ ".itn_listen" rot 0 addprop else pop then 1 exit else pop dup strlen 10 > if "(ITN) Message: Channel name limit is 10 characters." say 1 exit then "(ITN) Message: Switching to channel %c; modifying listen list." over tolower "%c" subst say "sys" itime "has left this channel." me @ ".itn_channel" getpropstr send me @ ".itn_listen" getpropstr over box tolower over over instr not if strcat me @ ".itn_listen" rot 0 addprop else pop pop then me @ ".itn_channel" 3 pick 0 addprop "sys" itime "has joined this channel." 4 rotate send 0 then ; : doon ( s -- ) me @ ".itn_quiet" getpropstr not if "(ITN) Message: You are not quiet." say exit else me @ ".itn_quiet" remove_prop "sys" itime "is now listening to ITN." me @ ".itn_channel" getpropstr send "(ITN) Message: You are now listening." say then ; : quie ( s -- ) me @ ".itn_quiet" getpropstr not if "sys" itime "has stopped listening to ITN." me @ ".itn_channel" getpropstr send "(ITN) Message: You are now quiet." say me @ ".itn_listen" getpropstr me @ ".itn_quiet" rot 0 addprop exit else "(ITN) Message: You are already quiet." say then ; : invi ( s -- ) dup 1 = if 6 error exit then dup 1 + rotate pop 1 - begin dup while over .pmatch #-1 dbcmp if "(ITN) Message: Player %n not recognized." rot "%n" subst say swap pop 1 - continue then over .pmatch dup awake? not if "(ITN) Message: Player %n is asleep." swap name "%n" subst say swap pop 1 - continue else pop then over .pmatch dup ".itn_channel" getpropstr not if "(ITN) Message: %n is not registered on ITN." swap name "%n" subst say swap pop 1 - continue else pop then over .pmatch dup ".itn_quiet" getpropstr if "(ITN) Message: %n is quiet." swap name "%n" subst say swap pop 1 - continue else pop then "(ITN) Message: You send an invitation to %n." 3 pick .pmatch name "%n" subst say "(ITN) Message: %n invites you to channel %c." me @ name "%n" subst me @ ".itn_channel" getpropstr "%c" subst rot .pmatch swap notify 1 - loop ; : pref ( s s -- ) dup 2 > if 6 error exit then dup 1 = if "(ITN) Message: Prefixes: " prefixes strcat say exit strcat say exit then pop swap pop me @ ".itn_prefixes" rot addprop "(ITN) Message: Prefixes set to: " prefixes strcat say 0 ; : lstn ( s s -- ) dup 1 = if "(ITN) Message: You are listening on the following channels:" say me @ ".itn_listen" getpropstr 1 strcut swap pop dup strlen 1 - strcut pop "||" explode begin dup while "(ITN) Message: " rot strcat say 1 - loop pop exit then 1 - begin dup while over tolower box me @ ".itn_listen" getpropstr tolower swap instr if "(ITN) Message: You are already listening to channel %c." rot "%c" subst say 1 - continue then over strlen 10 > if "(ITN) Message: Channel name %c too long." rot "%c" subst say 1 - continue then over tolower box me @ ".itn_listen" getpropstr tolower swap strcat me @ ".itn_listen" rot addprop 1 - "sys" itime "is now listening to this channel." 5 rotate tolower send loop pop 1 lstn ; : remo ( s s -- ) dup 1 = if 6 error exit then 1 - begin dup while over tolower "public" stringcmp not if "(ITN) Message: You can't remove channel public." say swap pop 1 - continue then over tolower box me @ ".itn_listen" getpropstr tolower swap instr not if "(ITN) Message: Not listening on channel %c." rot "%c" subst say 1 - continue then over tolower box me @ ".itn_listen" getpropstr "" rot subst "sys" itime "has stopped listening to this channel." 6 rotate tolower send me @ ".itn_listen" rot addprop 1 - loop pop 1 lstn ; : doad ( s s -- ) dup 1 = if 6 error exit then lstn ; : defa ( s s -- ) dup 1 = if "(ITN) Message: Default argument cleared." say me @ ".itn_default" remove_prop exit then dup 1 + rotate pop 2 - dup if 1 swap 1 for pop " " swap strcat strcat loop else pop then .sstrip "(ITN) Message: Default argument set to '%a'" over "%a" subst say me @ ".itn_default" rot addprop 0 ; : main ( s -- ) .sstrip dup not if me @ ".itn_default" prop-exists? if pop me @ ".itn_default" getpropstr else pop 2 error exit then then dup strlen 1 > if dup tolower dup 1 strcut pop prefixes swap instr swap 1 strcut swap pop 1 strcut pop "m" 1 strncmp and if 1 strcut swap pop args dup 1 + pick tolower dup "a" 1 strncmp not if pop doad clear_args exit then dup "c" 1 strncmp not if pop chan clear_args exit then dup "d" 1 strncmp not if pop defa clear_args exit then dup "h" 1 strncmp not if pop help clear_args exit then dup "i" 1 strncmp not if pop invi clear_args exit then dup "l" 1 strncmp not if pop lstn clear_args exit then dup "of" 2 strncmp not if pop quie clear_args exit then dup "on" 2 strncmp not if pop doon clear_args exit then dup "p" 1 strncmp not if pop pref clear_args exit then dup "r" 1 strncmp not if pop remo clear_args exit then dup "u" 1 strncmp not if pop list clear_args exit then dup "w" 1 strncmp not if pop list clear_args exit then pop clear_args 1 error exit then then me @ ".itn_quiet" getpropstr if pop 5 error exit else me @ ".itn_channel" getpropstr .sstrip not me @ ".itn_listen" getpropstr .sstrip not or if 4 error me @ ".itn_channel" "public" 0 addprop me @ ".itn_listen" "|public|" 0 addprop then then dup strlen 1 > if dup tolower 1 strcut 1 strcut pop "m" stringcmp not swap prefixes swap instr and if dup " " instr dup not if pop pop 6 error exit then strcut dup " " instr dup not if pop pop pop 6 error exit then strcut rot pop .sstrip swap .sstrip swap else "???????????" swap then else "???????????" swap then dup dup ":" 1 strncmp not swap ";" 1 strncmp not or if 1 strcut swap pop dup 1 strcut pop ".!?'=-><" swap instr if "pns" itime rot 4 pick "???????????" stringcmp not if 4 rotate pop me @ ".itn_channel" getpropstr else 4 rotate tolower then send exit else "ps" itime rot 4 pick "???????????" stringcmp not if 4 rotate pop me @ ".itn_channel" getpropstr else 4 rotate tolower then send exit then then "say" itime rot 4 pick "???????????" stringcmp not if 4 rotate pop me @ ".itn_channel" getpropstr else 4 rotate tolower then send ;