#!/bin/env wish set confdir ~/.config/ntalk set scriptpath "${confdir}/cscript.tcl" file mkdir $confdir proc quit {} {exit 0} proc restart {} { global argv0 exec [info nameofexecutable] $argv0 & exit 0 } ### FONT STUFF ### font create testingFont -size 100 proc make16 {} { foreach font {TkDefaultFont TkFixedFont TkTextFont} { font configure testingFont -family [font configure $font -family] set fontsize [expr {int(ceil(16.0 / [font metrics testingFont -linespace] * 100))}] font configure $font -size $fontsize } } make16 ### UI SETUP ### frame .foot entry .foot.input label .foot.msgs -textvariable lastmsg label .foot.name scrollbar .scroll -command {.buffer yview} text .buffer -width 72 -yscrollcommand {.scroll set} pack .foot.msgs -side right pack .foot.name -side left 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 { if {[.foot.input get] != {}} { history::add .foot.input [.foot.input get] } } } bind . quit bind . restart ### CONNECTING ### set user marmalade set cmds {} set sok {} set server "the web" 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. your changes will be saved. set server localhost set sok [socket $server 44322] set user marmalade } } bind .buffer { eval [.buffer get 1.0 end] make16 if {$sok != {}} { set cscript [.buffer get 1.0 end] } } .buffer mark set insert end focus .buffer vwait cscript bind .buffer {} .buffer configure -state disabled set fp [open $scriptpath w] puts $fp [string trim $cscript] close $fp fconfigure $sok -translation lf; # dammit set user [string trim $user] .foot.name configure -text "${user}:" wm title . "nanochatting on $server" ### NETCODE ### proc sendl {line} { global sok regsub "\n" $line " " line if [catch { puts $sok $line flush $sok }] { restart } } proc recvl {} { global sok if [catch { gets $sok ret }] { restart } return $ret } 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 } proc quit {} { sendl QUIT exit 0 } ### 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 ### focus .foot.input set lastmsg 0 last 16 after 10000 pollmsgs bind .foot.input [concat [bind .foot.input ] ";" { set line [.foot.input get] .foot.input delete 0 end switch -glob -- $line [concat $cmds { /hist { hist } /quit { quit } /restart { restart } {/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]" } {/nick *} { set user [string trim [string range $line 6 end]] .foot.name configure -text "${user}:" } {/eval *} { .foot.input insert 0 [eval [string range $line 6 end]] } {/exec *} { .foot.input insert 0 [exec sh -c [string range $line 6 end]] } {/calc *} { .foot.input insert 0 [expr [string range $line 6 end]] } default { sendmsg "$user: $line" } }] }]