1 files changed, 177 insertions(+), 0 deletions(-)

A ntalk.tcl

@@ 0,0 1,177 @@
+#!/bin/env wish
+
+set confdir ~/.config/ntalk
+set scriptpath "${confdir}/cscript.tcl"
+file mkdir $confdir
+
+### UI SETUP ###
+
+frame .foot
+entry .foot.input
+label .foot.msgs -textvariable lastmsg
+
+scrollbar .scroll -command {.buffer yview}
+text .buffer -width 72 -yscrollcommand {.scroll set} -takefocus 1
+
+pack .foot.msgs -side right 
+pack .foot.input -side bottom -fill x
+
+pack .foot -side bottom -fill x
+pack .scroll -side right -fill y
+pack .buffer -fill both
+
+if {[catch {package require history}] == 0} {
+	history::init .foot.input
+	bind .foot.input <Return> {
+		if {[.foot.input get] != {}} {
+			history::add .foot.input [.foot.input get]
+		}
+	}
+}
+
+
+### CONNECTING ###
+
+if [file readable $scriptpath] {
+	set fp [open $scriptpath]
+	.buffer insert 1.0 [read $fp]
+	close $fp
+} else {
+	.buffer insert 1.0 {# input connection script, then hit C-RET
+set sok [socket localhost 44322]
+set user marmalade
+}
+}
+
+bind .buffer <Control-Return> {
+	set cscript [.buffer get 1.0 end]
+}
+.buffer mark set insert end
+vwait cscript
+bind .buffer <Control-Return> {}
+.buffer configure -state disabled
+
+set fp [open $scriptpath w]
+puts $fp [string trim $cscript]
+close $fp
+
+eval $cscript
+fconfigure $sok -translation lf; # dammit
+set lastmsg 0
+
+
+### NETCODE ###
+
+proc sendl {line} {
+	global sok
+	regsub "\n" $line " " line
+	puts $sok $line
+	flush $sok
+}
+proc recvl {} {
+	global sok
+	gets $sok
+}
+proc recvlines {{bd 0}} {
+	global lastmsg
+	set n [recvl]
+	for {set i 0} {$i < $n} {incr i} {
+		bufpush [recvl]
+		if $bd bufdown
+	}
+	set lastmsg [recvl]
+}
+
+proc bufpush {line} {
+	.buffer configure -state normal
+	.buffer insert end "$line\n"
+	.buffer configure -state disabled
+	update
+}
+proc bufdown {} {
+	.buffer yview moveto 1
+	update
+}
+proc bufclear {} {
+	.buffer configure -state normal
+	.buffer replace 1.0 end {}
+	.buffer configure -state disabled
+	update
+}
+
+proc send {line} {
+	sendl "SEND $line"
+	recvl
+}
+
+proc poll {} {
+	global lastmsg
+	sendl "POLL $lastmsg"
+	recvl
+}
+
+proc hist {} {
+	bufclear
+	sendl HIST
+	recvlines 1
+}
+
+proc last {n} {
+	bufclear
+	sendl "LAST $n"
+	recvlines 1
+}
+
+proc skip {} {
+	global lastmsg
+	sendl "SKIP $lastmsg"
+	recvlines
+}
+
+
+### ACTUAL CLIENT CODE LMAO ###
+
+proc sendmsg {msg} {
+	global lastmsg
+	set msgid [send $msg]
+	if {$msgid == $lastmsg} {
+		bufpush "$msg\n"
+	} else { skip }
+	bufdown
+}
+
+proc pollmsgs {} {
+	if {[poll] != "0"} { skip }
+	after 10000 pollmsgs
+}
+
+
+### BOOT ###
+
+last 16
+after 10000 pollmsgs
+bind .foot.input <Return> [concat [bind .foot.input <Return>] ";" {
+	set line [.foot.input get]
+	switch -glob -- $line {
+		/hist {
+			hist
+		}
+		{/last *} {
+			last [string range $line 6 end]
+		}
+		{/send *} {
+			send [string range $line 6 end]
+		}
+		/me* {
+			sendmsg "${user}[string range $line 3 end]"
+		}
+		{/my *} {
+			sendmsg "${user}'s [string range $line 4 end]"
+		}
+		default {
+			sendmsg "$user: $line"
+		}
+	}
+
+	.foot.input delete 0 end
+}]