: say ( s -- ) me @ swap ( ansi_ ) notify ; : clear_args ( s1 .. sN N -- ) begin dup while swap pop 1 - repeat 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 ; : itime-tz ( d -- s ) dup not if pop 0 exit then time rot pop 3 pick "_tzone" getpropstr atoi dup not if pop 0 then 4 rotate ".itn_timezone" getpropstr atoi dup not if pop else swap pop then + dup 23 > if 24 - then dup 0 < if 24 + then intostr dup strlen 1 = if "0" swap strcat then ":" strcat swap intostr dup strlen 1 = if "0" swap strcat then strcat ; : is_wizard? ( -- i ) ( "W" ) dup "C" flag? swap "Q" flag? not and ; : 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 ; : 4rjust ( s -- s ) dup strlen " " swap strcut swap pop swap strcat ; : 10ljust ( s -- s ) dup strlen " " swap strcut swap pop strcat ; : 40ljust ( s -- s ) dup strlen " " swap strcut swap pop strcat ; : args ( s -- s1 .. sN N ) 1 begin over " " instr dup while rot swap 1 - strcut .sstrip rot 1 + repeat pop ; : tr ( -- d ) trigger @ ; : prefixes ( -- s ) me @ ".itn_prefixes" getpropstr dup if exit then pop prog ".itn_prefixes" getpropstr dup if exit then pop "/-%" ; : no_space_chars ( -- s ) me @ is_wizard? if me @ ".itn_nospacechars" getpropstr dup if exit else pop then then prog ".itn_nospacechars" getpropstr dup if exit then pop ".|?'=->< " ; : get_firstname ( d -- s ) name dup ";" instr dup if 1 - strcut pop else pop then ; ( : connections [ d1 .. dN N -- i1 .. iN N ] 1 condescr dup not if pop 0 exit then 1 begin over nextdescr dup while swap 1 + repeat pop ; : prop-exists? [ d s -- i ] getpropstr "" stringcmp ; ) : 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 "Auto-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 dup 7 = if "Function not impletmented." exit then "Fatal error; please report the offending command to %o." ; : error ( i -- ) errorlist tr get_firstname "%t" subst prefixes 1 strcut pop "%p" subst prog owner name "%o" subst "(ITN) Error #%#: %e" swap "%e" subst swap intostr "%#" subst say ; : usertype ( d -- s ) dup if dup is_wizard? if pop ( "W" ) "C" exit then dup "R" flag? if pop "R" exit then dup "M" flag? if pop "M" exit then dup "B" flag? if pop "B" exit then pop "P" else pop "X" then ; : send ( s i s s -- ) connections begin dup while over ( descrcon ) condbref dup not if pop swap pop else rot pop swap over ".itn_listen" getpropstr 3 pick ".itn_quiet" getpropstr if pop swap pop else tolower over 3 + pick box tolower instr not if swap pop else dup 5 + pick "spf" stringcmp not 3 pick "_nospoof" getpropstr tolower "h" 1 strncmp not and if swap pop else ".itn_%yformat" over 6 + pick "%y" subst 3 pick swap getpropstr dup not if pop ".itn_%yformat" over 6 + pick "%y" subst prog swap getpropstr then dup 3 pick 4 + pick "%c" subst 3 pick 6 + pick "%s" subst 4 pick itime-tz "%t" subst me @ intostr "%u" subst me @ name "%n" subst me @ location intostr "%l" subst me @ location name "%r" subst me @ usertype "%f" subst tr ".count" getpropstr "%z" subst 3 pick 5 + pick 4 pick 8 + pick "spf" stringcmp not if 5 pick "_nospoof" getpropstr tolower "s" 1 strncmp not if "[@" me @ name strcat "] " strcat swap strcat then then "%m" subst swap 3 pick 4 + pick "%c" subst 3 pick 6 + pick "%s" subst 4 pick itime-tz "%t" subst me @ name "%n" subst me @ usertype "%f" subst tr ".count" getpropstr "%z" subst 3 pick 5 + pick "%m" subst swap 4 rotate dup is_wizard? if rot pop dup ".itn_gag" getpropstr dup if re-compile 3 pick re-match dup if clear_args pop pop else clear_args swap ( ansi_ ) notify then else pop swap ( ansi_ ) notify then else swap pop dup ".itn_gag" getpropstr dup if re-compile 3 pick re-match dup if clear_args pop pop pop else clear_args swap ( ansi_ ) notify then else pop swap ( ansi_ ) notify then then then then then then 1 - repeat pop pop pop pop pop ; : f->list ( s -- ) dup 2 > if 6 error exit then dup 1 = if me @ ".itn_channel" getpropstr .sstrip tolower else over dup box me @ ".itn_listen" getpropstr swap instr not if "(ITN) Message: You are not listening on channel %c." swap "%c" subst say exit then then ".----------------------------------------." say "| @ Name Channel | Idle |" say "|---------------------------------+------|" say connections begin dup while over ( descrcon ) condbref dup if rot ( descrcon ) conidle swap rot over "U" ( "D" ) flag? not if dup 3 + pick box 3 pick ".itn_listen" getpropstr tolower swap instr if dup 4 + pick 2 = if dup 5 + pick tolower 3 pick ".itn_channel" getpropstr tolower stringcmp not else 0 then 3 pick ".itn_channel" getpropstr tolower dup me @ ".itn_channel" getpropstr tolower stringcmp not swap "public" stringcmp not or or if over ".itn_channel" getpropstr rjust else ".........." rjust then rot 4 pick swap dup name swap ".itn_quiet" getpropstr if ljust "- " swap strcat swap pop else swap 900 >= if ljust "? " swap strcat else ljust "@ " swap strcat then then swap strcat "| " swap strcat " | " strcat rot .idlefmt 4rjust strcat " |" strcat me @ swap ( ansi_ ) notify else swap pop swap pop then else swap pop swap pop then else pop swap pop then 1 - repeat "`----------------------------------------'" say " @ = listening ? = idle - = quiet " say pop pop ; : f->help ( -- ) ".--------------------------------------------------------------." say "| Inter-user Talk Network for MUF v5.2-beta by Sjade |" 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 "| /gag | Gag messages matching or ungag |" 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 "| /topics | List topic-specific channels in use |" say "| /users [] | List users on , default is current |" say "| /who [] | Same as /users |" say "|--------------------------------------------------------------|" say "| [] indicates that an argument is optional |" say "| ... indicates you may supply more than one argument |" say "`--------------------------------------------------------------'" say ; : f->channel ( 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 dup "|" instr if "(ITN) Message: Channel names cannot contain a |" 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 ; : f->on ( 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 ; : f->quiet ( 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 ; : f->invite ( 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 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 '%c'. Use '" tr get_firstname strcat " /ch %c' to join." strcat me @ name "%n" subst me @ ".itn_channel" getpropstr "%c" subst rot .pmatch swap ( ansi_ ) notify 1 - repeat ; : f->prefix ( 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 ( 0 ) addprop "(ITN) Message: Prefixes set to: " prefixes strcat say 0 ; : f->listen ( 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 - repeat 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 "|" instr if "(ITN) Message: Channel names cannot contain a |" say swap pop 1 - continue then over tolower box me @ ".itn_listen" getpropstr tolower swap strcat me @ ".itn_listen" rot ( 0 ) addprop 1 - "sys" itime "is now listening to this channel." 5 rotate tolower send repeat pop 1 f->listen ; : f->remove ( s s -- ) dup 1 = if 6 error exit then 1 - begin dup while 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 ( 0 ) addprop 1 - repeat pop 1 f->listen ; : f->add ( s s -- ) dup 1 = if 6 error exit then f->listen ; : f->default ( s s -- ) dup 1 = if "(ITN) Message: Default argument cleared." say me @ ".itn_default" remove_prop exit then dup 2 > if 6 error exit then dup 1 + rotate pop 2 - dup if begin dup while rot rot " " swap strcat strcat 1 - repeat pop else pop then .sstrip "(ITN) Message: Default argument set to '%1'" over "%1" subst say me @ ".itn_default" rot ( 0 ) addprop 0 ; : f->topics ( -- ) prog ".topics1" getpropstr not if "(ITN) Message: No topic channels defined." say exit then ".-------------------------------------------------------." say "| Channel | Topic |" say "|------------+------------------------------------------|" say 1 begin prog ".topics" 3 pick intostr strcat getpropstr dup while dup "/" instr 1 - strcut 1 strcut swap pop 40ljust " | " swap strcat " |" strcat swap 10ljust "| " swap strcat swap strcat say 1 + repeat "`-------------------------------------------------------'" say pop pop ; : f->gag ( s -- ) dup 2 > if 6 error exit then dup 1 = if me @ ".itn_gag" getpropstr dup not if pop "(ITN) Message: You have no gag pattern set." say exit else "(ITN) Message: Your current gag pattern is:" say "(ITN) Message: " swap strcat say exit then then over "off" stringcmp not if me @ ".itn_gag" remove_prop "(ITN) Message: Your gag pattern has been cleared." say exit then me @ ".itn_gag" 4 pick ( 0 ) addprop "(ITN) Message: You have set your gag pattern to:" say "(ITN) Message: " 3 pick strcat say ; : main ( s -- ) 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 me @ ".itn_quiet" remove_prop "sys" itime "is now listening to ITN." me @ ".itn_channel" getpropstr send then .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 dup "\\" 1 strncmp swap "\"" 1 strncmp and 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 "ad" 2 strncmp not if pop f->add clear_args exit then dup "ch" 2 strncmp not if pop f->channel clear_args exit then dup "def" 3 strncmp not if pop f->default clear_args exit then dup "ga" 2 strncmp not if pop f->gag clear_args exit then dup "h" 1 strncmp not if pop f->help clear_args exit then dup "inv" 3 strncmp not if pop f->invite clear_args exit then dup "lis" 3 strncmp not if pop f->listen clear_args exit then dup "of" 2 strncmp not if pop f->quiet clear_args exit then dup "on" 2 strncmp not if pop f->on clear_args exit then dup "pre" 3 strncmp not if pop f->prefix clear_args exit then dup "rem" 3 strncmp not if pop f->remove clear_args exit then dup "top" 3 strncmp not if pop f->topics clear_args exit then dup "use" 3 strncmp not if pop f->list clear_args exit then dup "wh" 2 strncmp not if pop f->list clear_args exit then pop clear_args 1 error exit then else 1 strcut swap pop then then me @ ".itn_quiet" getpropstr if pop 5 error exit 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 "^" 1 strncmp not if 1 strcut swap pop "spf" itime rot 4 pick "???????????" stringcmp not if 4 rotate pop me @ ".itn_channel" getpropstr else 4 rotate tolower then tr ".count" getpropstr atoi 1 + tr ".count" rot intostr ( 0 ) addprop send exit then dup dup ":" 1 strncmp not swap ";" 1 strncmp not or if 1 strcut swap pop dup 1 strcut pop no_space_chars swap instr if "pns" itime rot 4 pick "???????????" stringcmp not if 4 rotate pop me @ ".itn_channel" getpropstr else 4 rotate tolower then tr ".count" getpropstr atoi 1 + tr ".count" rot intostr ( 0 ) addprop send exit else "ps" itime rot 4 pick "???????????" stringcmp not if 4 rotate pop me @ ".itn_channel" getpropstr else 4 rotate tolower then tr ".count" getpropstr atoi 1 + tr ".count" rot intostr ( 0 ) addprop send exit then then "say" itime rot 4 pick "???????????" stringcmp not if 4 rotate pop me @ ".itn_channel" getpropstr else 4 rotate tolower then tr ".count" getpropstr atoi 1 + tr ".count" rot intostr ( 0 ) addprop send ;