1 files changed, 79 insertions(+), 25 deletions(-)

M ntalk.tcl

@@ 1,5 1,6 @@
 #!/bin/env wish
 
+
 set confdir ~/.config/ntalk
 set scriptpath "${confdir}/cscript.tcl"
 set sixelpath "${confdir}/sixels.txt"


@@ 447,7 448,7 @@ set user marmalade
 }
 }
 
-bind .buffer <Control-Return> {
+bind . <Control-Return> {
 	eval [.buffer get 1.0 end]
 	make16
 	if {$sok != {}} { set cscript [.buffer get 1.0 end] }


@@ 471,8 472,22 @@ wm title . ".  o  (  nanochatting on $server  )  o  ."
 
 ### NETCODE ###
 
+proc setclients {newc} {
+	global clients
+	set clients $newc
+}
+proc setlastmsg {new} {
+	global lastmsg
+	set lastmsg $new
+}
+
+set lastmsg 0
+set netcode {
+set lastmsg 0
+
 proc sendl {line} {
-	global sok
+	global sok inrecv
+	if {$inrecv} return
 	regsub "\n" $line " " line
 	if [catch {
 		puts $sok $line


@@ 481,7 496,8 @@ proc sendl {line} {
 }
 proc recvl {} {
 	global sok
-	if [catch { gets $sok ret }] { restart }
+	gets $sok ret
+#	if [catch { gets $sok ret }] { restart }
 	return $ret
 }
 set inrecv 0


@@ 494,13 510,20 @@ proc recvlines {{bd 0}} {
 		bufpush [recvl]
 		if $bd bufdown
 	}
-	set lastmsg [recvl]
+	setlastmsg [recvl]
 	set inrecv 0
 }
 
 proc send {line} {
+	global lastmsg
 	sendl "SEND $line"
-	recvl
+	set msgid [recvl]
+	if {$msgid == $lastmsg+1} {
+		setlastmsg $msgid
+		return 1
+	}
+	after idle skip
+	return 0
 }
 
 proc poll {} {


@@ 533,19 556,60 @@ proc quit {} {
 }
 
 proc stat {} {
-	global clients
-
 	sendl STAT
 	lassign [recvl] msgs
 	lassign [recvl] bytes
 	lassign [recvl] clients
+	
+	setclients $clients
+}
+
+proc pollmsgs {} {
+	global inrecv
+	if !$inrecv {
+		stat
+		skip
+	}
+	after 10000 pollmsgs
+}
+}
+
+if {[catch {package require Thread}] == 0} { # threading supported!
+	set threads 1
+
+	set main [thread::id]
+
+	set nett [thread::create]
+	thread::transfer $nett $sok
+	thread::send $nett [concat [subst -nocommands {
+	set sok $sok
+	interp alias {} restart {} thread::send $main restart
+	interp alias {} bufdown {} thread::send -async $main bufdown
+	interp alias {} bufclear {} thread::send -async $main bufclear
+	proc bufpush {x} { thread::send -async $main [list bufpush [set x]] }
+	proc setclients {x} { thread::send -async $main [list setclients [set x]] }
+	proc setlastmsg {x} {
+		global lastmsg
+		set lastmsg [set x]
+		thread::send -async $main [list setlastmsg [set x]]
+	}
+	}] ";" $netcode]
+
+
+	interp alias {} pollmsgs {} thread::send -async $nett pollmsgs
+	interp alias {} hist {} thread::send -async $nett hist
+	proc send {line} [subst -nocommands { thread::send $nett [list send [set line]] }]
+	proc last {n} [subst -nocommands { thread::send -async $nett [list last [set n]] }]
+} else {
+	set threads 0
+	eval $netcode
 }
 
 
 ### ACTUAL CLIENT CODE LMAO ###
 
 proc bufpush {line} {
-	global images motd user
+	global images motd user threads
 
 	set tag {}
 	if {[string first "MOTD:" $line] == 0} {


@@ 574,36 638,28 @@ proc bufpush {line} {
 	}
 	.buffer insert end "\n" $tag
 	.buffer configure -state disabled
+	if !$threads update
 }
 proc bufdown {} {
+	global threads
 	.buffer yview moveto 1
-	update
+	if !$threads update
 }
 proc bufclear {} {
+	global threads
 	.buffer configure -state normal
 	.buffer replace 1.0 end {}
 	.buffer configure -state disabled
 	setmotd "no MOTD yet! maybe you should send one..."
-	update
+	if !$threads update
 }
 
 proc sendmsg {msg} {
 	global lastmsg
-	set msgid [send $msg]
-	if {$msgid == $lastmsg+1} {
-		set lastmsg $msgid
+	if {[send $msg]} {
 		bufpush "$msg"
 		bufdown
-	} else { skip }
-}
-
-proc pollmsgs {} {
-	global inrecv
-	if !$inrecv {
-		stat
-		skip
 	}
-	after 10000 pollmsgs
 }
 
 proc n64k_secs {msgcount} {


@@ 620,10 676,8 @@ proc n64k_date {} {
 
 ### BOOT ###
 
-set lastmsg 0
 last 64
-stat
-after 10000 pollmsgs
+pollmsgs
 
 bind .foot.input <Return> [concat [bind .foot.input <Return>] ";" {
 	set line [.foot.input get]