( MSG|FROM|CHAN|...) $include $iwc/sys $def pad ( s i -- s ) " " rot swap strcat swap ansi_strcut pop $def rpad ( s i -- s ) " " rot swap strcat swap ansi_strcut pop $def DEFAULTFRMT "^RED^%c> ^YELLOW^[^CYAN^%f^YELLOW^] ^NORMAL^%t%m" $def punctarr { " " "." "," "'" "`" ":" ";" "!" "?" "-" "_" "+" "=" } array_make : _iwc_broadcast ( a -- ) ( CHAN|PNAME|PREF|TITLE|ENC|MESG ) dup "from" [] swap "data" [] | rsplit base64decode 0 escape_ansi (MESG) swap | rsplit atoi (ENC) swap | rsplit base64decode (TITLE) swap | rsplit (PREF) swap | rsplit base64decode (PNAME) swap (CHAN) ( FROM MESG ENC TITLE PREF PNAME CHAN ) online_array 1 array_nunion { "@/nni/channels/" 4 pick "/on?" }cat "yes" array_filter_prop foreach swap pop dup { "_/nni/channels/" 5 pick "/format" }cat getpropstr dup not if pop dup "_/nni/format" getpropstr dup not if pop DEFAULTFRMT then then 1 parse_ansi 3 parse_ansi 3 pick toupper "%c" subst 4 pick "%n" subst 6 pick "%t" subst 8 pick "%m" subst 9 pick "%f" subst ansi_notify repeat 7 popn ; ARCHCALL _iwc_broadcast : _iwc_chanlist ( a -- ) dup "data" [] swap "from" [] #0 exits_array "@/nni/channel" "*" array_filter_prop foreach swap pop dup getlink prog dbcmp if "@/nni/channel" getpropstr toupper 3 pick 3 pick iwc-send not if break then else pop then repeat "" -3 rotate iwc-send pop ; ARCHCALL _iwc_chanlist : _iwc_wholist ( a -- ) dup "data" [] | rsplit rot "from" [] online_array 1 array_nunion 4 pick if "@/nni/channels/" 5 rotate strcat "/on?" strcat "yes" array_filter_prop else 4 rotate pop then foreach swap pop dup descrleastidle swap name | strcat over descridle intostr | strcat strcat over descrtime intostr | strcat strcat swap descrhost strcat 3 pick 3 pick iwc-send not if break then repeat "" -3 rotate iwc-send pop ; ARCHCALL _iwc_wholist : nni-chanlist ( str:muck -- a OR 0 ) "s" checkargs pid "nni:chanlist" rot iwc-send not if 0 exit then 5 "NNI.TO.CL" timer_start 0 array_make begin { "TIMER.NNI.TO.CL" "USER.IWC.SEND" }list event_waitfor "TIMER.NNI.TO.CL" stringpfx if pop pop 0 break else "data" [] "data" [] dup not if pop break then swap array_appenditem then repeat "NNI.TO.CL" timer_stop ; MAGECALL nni-chanlist $libdef nni-chanlist : nni-who ( str:chan -- a OR 0 ) "NNI" iwc-mod-mlist dup int? if pop 0 exit else dup not if pop 0 array_make_dict exit then then { rot | pid }cat "nni:wholist" iwc-bcast not if pop 0 exit then 0 array_make_dict 5 "NNI.TO.WL" timer_start begin { "TIMER.NNI.TO.WL" "USER.IWC.SEND" }list event_waitfor "TIMER.NNI.TO.WL" stringpfx if pop swap pop break else ( mlist a darr a data ) "data" [] dup "data" [] dup if "muck" 3 pick "from" [] 1 array_make_dict swap | rsplit rot "host" array_setitem swap | rsplit rot "ontime" array_setitem swap | rsplit rot "idle" array_setitem "name" array_setitem -3 rotate "from" [] 2 dupn array_getitem dup not if pop 0 array_make then 4 rotate swap array_appenditem -3 rotate array_setitem else pop rot dup rot "from" [] array_excludeval array_extract dup not if pop break else swap then then then repeat "NNI.TO.WL" timer_stop ; MAGECALL nni-who $libdef nni-who : nni-channels ( -- a OR 0 ) "NNI" iwc-mod-mlist dup int? if pop 0 exit else dup not if pop 0 array_make_dict exit then then pid "nni:chanlist" iwc-bcast not if pop 0 exit then 0 array_make_dict 5 "NNI.TO.CL" timer_start begin { "TIMER.NNI.TO.CL" "USER.IWC.SEND" }list event_waitfor "TIMER.NNI.TO.CL" stringpfx if pop swap pop break else ( mlist a darr a data ) "data" [] dup "data" [] dup if -3 rotate "from" [] 2 dupn array_getitem dup not if pop 0 array_make then 4 rotate swap array_appenditem -3 rotate array_setitem else pop rot dup rot "from" [] array_excludeval array_extract dup not if pop break else swap then then then repeat "NNI.TO.CL" timer_stop ; MAGECALL nni-channels $libdef nni-channels $def numpad ( s -- s ) dup strlen 2 < if "0" swap strcat then : ontostr ( f -- s ) float dup int swap over - swap dup 60 / swap 60 % swap dup 60 / swap 60 % swap dup 24 / swap 24 % swap dup if intostr "d " strcat swap intostr numpad strcat ":" strcat swap intostr numpad strcat -3 rotate pop pop else pop dup if intostr numpad ":" strcat swap intostr numpad strcat ":" strcat swap intostr numpad strcat swap pop else pop intostr numpad ":" strcat swap intostr numpad strcat "." strcat swap 2 round ftostrc "." split swap pop numpad strcat then then ; : idletostr ( i -- s ) dup 31535999 > if pop "365d" else dup 86399 > if 86400 / intostr "d" strcat else dup 3599 > if 3600 / intostr "h" strcat else dup 59 > if 60 / intostr "m" strcat else intostr "s" strcat then then then then ; $def gettitle name : nni-send ( chan str -- i ) ( CHAN|PNAME|PREF|TITLE|ENC|MESG ) { rot | me @ name base64encode | me @ dtos | me @ gettitle base64encode | 0 | }cat swap base64encode strcat "nni:broadcast" iwc-bcast ; : nni-sysmesg ( chan str -- i ) ( CHAN|PNAME|PREF|TITLE|ENC|MESG ) { rot | "\[[1;32m>> " me @ name strcat base64encode | me @ dtos | "\[[1;32m>> " me @ gettitle strcat base64encode | 0 | }cat " " rot strcat base64encode strcat "nni:broadcast" iwc-bcast ; : do_who ( str:chan str:name str:muck -- ) me @ { "Downloading listing, please wait... (" 6 pick ")" }cat ansi_notify "*" strcat swap "*" strcat rot nni-who dup int? if 3 popn me @ "Timeout while waiting for data. The network might be down." ansi_notify exit else dup not if 3 popn me @ "Network OK, but received empty data. There might be a configuration error." ansi_notify exit then then rot array_matchkey dup not if pop pop me @ "I couldn't find any data for the specified MUCK name." ansi_notify exit then me @ " " ansi_notify me @ "Player Name MUCK name On For Idle" ansi_notify me @ "---------------- -------------------- -------- ----" ansi_notify 0 swap foreach foreach swap pop ( name i MUCK arr s ) dup "name" [] dup 6 pick smatch if 16 pad " " strcat 3 pick 20 pad " " strcat strcat over "ontime" [] atoi ontostr 8 rpad " " strcat strcat swap "idle" [] atoi idletostr 6 pad " " strcat strcat me @ swap notify swap ++ swap else pop pop then repeat pop repeat me @ over intostr " player" strcat rot 1 = not if "s" strcat then " found." strcat me @ swap notify pop ; : do_chanoff ( s -- ) strip dup not if pop trigger @ "@/nni/channel" getpropstr then me @ "@/nni/channels/" 3 pick strcat "/on?" strcat getpropstr "yes" stringcmp if pop me @ "You are not on this channel." notify exit then dup "has left the channel." nni-sysmesg pop me @ "@/nni/channels/" rot strcat "/on?" strcat remove_prop me @ "Channel turned off." notify ; : do_chanon ( s -- ) strip dup not if pop trigger @ "@/nni/channel" getpropstr then me @ "@/nni/channels/" 3 pick strcat "/on?" strcat getpropstr "yes" stringcmp not if pop me @ "You are already on this channel." notify exit then dup "has joined the channel." nni-sysmesg pop me @ "@/nni/channels/" rot strcat "/on?" strcat "yes" setprop me @ "Channel turned on." notify ; : do_join ( s -- ) " " split swap pop strip dup not if me @ { "Usage: " command @ tolower " #join [=]" }cat notify pop exit then dup "=" instr if "=" split strip dup not if me @ { "Usage: " command @ tolower " #join [=]" }cat notify pop pop exit then dup name-ok? not if me @ "You cannot name an action that." notify pop pop exit then swap strip else dup then dup " " instr over | instr or if me @ "You cannot name a channel that." notify pop pop exit then me @ { "@/nni/channels/" 4 pick "/ref" }cat getpropstr stod dup exit? if me @ "You have already joined this channel. The action is: " rot unparseobj strcat notify pop pop exit else pop then me @ rot newexit dup exit? not if pop pop me @ "Failed to create the action." notify exit then dup "@/nni/channel" 4 pick setprop dup "@/nni/personal?" "yes" setprop dup me @ setown dup prog setlink me @ "@/nni/channels/" 4 pick strcat "/ref" strcat rot setprop me @ "Created." notify do_chanon ; : do_leave ( s -- ) pop trig "@/nni/channel" getpropstr dup do_chanoff me @ "@/nni/channels/" 3 pick strcat "/ref" strcat getpropstr stod dup exit? if me @ over controls not if "ERROR! CONTROLS(me @, TRIG) != 1" abort exit else recycle then me @ "@/nni/channels/" rot strcat "/ref" strcat remove_prop me @ "Your personal action for this channel has been removed." notify else pop pop then ; : do_talk ( s -- ) trig "@/nni/channel" getpropstr me @ "@/nni/channels/" 3 pick strcat "/on?" strcat getpropstr "yes" stringcmp if pop me @ "You are not on this channel!" notify exit then swap 1 strcut swap dup ":" stringcmp if swap strcat " says, \"" swap strcat "\"" strcat else pop dup 1 strcut pop punctarr foreach swap pop over stringcmp not if pop "" break then repeat if " " swap strcat then then dup strlen 1024 > if pop pop me @ "Message too long. Limit is 1kb." notify exit then nni-send not if me @ "No connection. The network may be down." notify exit then ; : do_help ( s -- ) me @ "InterMUCK channel program, written by Hinoserm. (v2.0)" ansi_notify me @ "(Since this is a beta version, some commands don't work.)" ansi_notify me @ " \rCommunications commands: " ansi_notify me @ { " " command @ " - Speak over this channel." }cat ansi_notify me @ { " " command @ " : - Pose over this channel." }cat ansi_notify me @ " \rInformational commands: " ansi_notify me @ { " " command @ " #help - Display this help screen." }cat ansi_notify me @ { " " command @ " #who [][@] - List who's on this channel" }cat ansi_notify me @ { " " command @ " #list [][@] *- List global channels on a particular MUCK." }cat ansi_notify me @ " \rChannel control commands: " ansi_notify me @ { " " command @ " #join [=] - Join a channel." }cat ansi_notify me @ { " " command @ " #leave - Leave (and remove) this channel." }cat ansi_notify me @ { " " command @ " #on [] - Switch this channel off." }cat ansi_notify me @ { " " command @ " #off [] - Switch this channel on." }cat ansi_notify me @ "W" flag? if me @ " \rAdministrative commands: " ansi_notify me @ { " " command @ " #add [=] *- Add a global channel." }cat ansi_notify me @ { " " command @ " #del *- Remove global channel (based on exit match)." }cat ansi_notify then ; : do_chan ( s -- ) trig "@/nni/channel" getpropstr not if me @ "This channel is not properly configured." notify exit then dup not if do_help exit then dup "#WHO" stringpfx if " " split trig "@/nni/channel" getpropstr toupper rot pop swap "@" split do_who exit else dup "#JOIN" stringpfx if do_join exit then dup "#LEAVE" stringpfx if do_leave exit then dup "#ON" stringpfx if " " split do_chanon pop exit then dup "#OFF" stringpfx if " " split do_chanoff pop exit then dup "#HELP" stringpfx if do_help exit then do_talk exit then ;