@program xpub.muf
1 1000 d
i
( Do _NOT_ use this program without _EXPLICIT_ permission from Hinoserm.  )
( Thank you.                                                              )
$def |  27 itoc strcat
$def |s 27 itoc strcat strcat
$def muckname prog "@muckname" getpropstr
$def hostname prog "@hostname" getpropstr
$def thepid prog "@pid" getpropstr atoi
$def catmuck ( s -- ) "@" strcat muckname strcat
$def punctarr { " "  "." ","  "'" "`"  ":" ";"  "!" "?"  "-" "_"  "+" "=" } array_make
(Proto1.50 stuff)
($def nbsockrecv sockrecv 1 swap)
$def getthingie "data" array_getitem
$define sit ( i -- )
    0 = if
      "IMCli: Restarting." logstatus
      prog "@pid" remove_prop
      8 prog "" queue pop pid kill exit
    then
$enddef
 
: notifypeople ( s -- )
   online_array foreach
     swap pop dup "~/inet/status" getpropstr atoi 1 = if
       prog "@tag" getpropstr " " strcat 3 pick strcat ansi_notify
     else pop then
   repeat pop
;
: dothingie ( k s -- )
   dup 27 itoc instr 0 > if 27 itoc split dup strlen 1 < if 4 popn exit else
     swap toupper
     dup "NALL" stringcmp 0 = if pop notifypeople pop exit then
     dup "GWHO" stringcmp 0 = if pop 27 itoc split
       online_array foreach
         swap pop dup "~/inet/status" getpropstr atoi 1 = if
           name "@" strcat "> " swap strcat muckname strcat 
           "SWHO" | 4 pick |s 3 pick |s swap strcat 4 pick swap socksend sit
         else pop then
       repeat 3 popn exit
     then dup "SWHO" stringcmp 0 = if pop 27 itoc explode pop muckname stringcmp 0 = not if 3 popn exit else
       stod swap notify pop exit
     then then 3 popn exit
   then else
     swap pop notifypeople exit
   then
   
;
     
: main-clientserver
   background
     "IMCli: Connection error. Restarting in 30 seconds." strcat logstatus
   hostname 39397 sockopen "noerr" stringcmp 0 = not if
     prog "@pid" remove_prop
     30 prog "" queue pop pid kill
   then
   prog "@pid" pid intostr setprop
   begin
     dup nbsockrecv swap sit dup strlen 0 > if
       over swap dothingie
     else pop then
     "USER.out" event_exists dup 0 > if
       1 swap 1 for pop
         event_wait pop getthingie over swap socksend sit
       repeat
     else pop then
     prog "d" flag? sleep
   repeat
;
: main-client ( s -- )
    dup "#restart" stringcmp 0 = if
      me @ mlevel 4 < if "^RED^Permission denied." me @ swap ansi_notify exit then
      prog "@pid" remove_prop
      1 prog "" queue pop
      "^GREEN^Restarted." me @ swap ansi_notify
    exit then
    thepid ispid? not if "^RED^No connection." me @ swap ansi_notify exit then
    dup "#off" stringcmp 0 = over "off" stringcmp 0 = or if
      me @ name catmuck " has turned the channel off." strcat thepid "out" rot event_send
      me @ "~/inet/status" "0" setprop
      "Channel Off." me @ swap ansi_notify exit
    then
    dup "#on" stringcmp 0 = over "on" stringcmp 0 = or if
      me @ "~/inet/status" "1" setprop
      me @ name catmuck " has turned the channel on." strcat thepid "out" rot event_send
      "Channel On." me @ swap ansi_notify exit
    then
    me @ "~/inet/status" getpropstr atoi 1 = not if "^RED^Channel is off!" me @ swap ansi_notify exit then
    dup "#who" stringcmp 0 = over "who" stringcmp 0 = or if
      "GWHO" | muckname |s me @ dtos strcat thepid "out" rot event_send
    exit then
    
    1 strcut swap dup ":" stringcmp if swap strcat
      me @ name catmuck " says, \"" strcat 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
      me @ name catmuck swap strcat
    then
    thepid "out" rot event_send
;
: main
   depth try
     trigger @ exit? if
       trigger @ "@thingie" getpropstr strlen 0 > if
         main-client exit
       else
         main-clientserver exit
       then
     else
       main-clientserver exit
     then
   catch
     dup strlen 0 > if
       "IMCli: Connection error: " swap strcat ". Restarting in 15 seconds." strcat logstatus
       prog "@pid" remove_prop
       10 prog "" queue pid kill
     else pop then
   endcatch
;
.
c
q
@act xpub;@xpub;]=#0,xpub.muf
@set ]=@thingie:yes
@act xpubst=#0,xpub.muf
@set xpub.muf=@hostname:ginkosoft.com
@set xpub.muf=@muckname:FF:W
@set xpub.muf=@tag:=XPub>