#!/bin/env wish
set confdir [file normalize ~/.config/ntalk]
set config "${confdir}/config.tcl"
set scriptdir "${confdir}/cscript"
set sixelpath "${confdir}/sixels.txt"
file mkdir $confdir
proc quit {} {exit 0}
proc runself args {
global argv0
exec [info nameofexecutable] $argv0 {*}$args &
}
proc restart args {
runself {*}$args
exit 0
}
proc settitle {title} {
wm title . ". o ( $title ) o ."
}
settitle ntalk
tk appname ntalk
### ICON ###
# don't worry!! it is just an image!!!!
set nanooo {
iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAAAAACPAi4CAAAABGdBTUEAALGPC/xhBQAAACBjSFJN
AAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAAmJLR0QA/4ePzL8AAAAHdElN
RQfpCRUAHTfQmewlAAAGbUlEQVRYw6WXfVSV9R3AP/dyedUAmRpK6rSBw9TlnAknTr7RsbNRWtLB
tnLNVp10EZi9OJtzs9k8xx0FbRnNKWmFutDlW7hBOlmmJlxUjoCACBMBUXm/3Lfnuz/ufe597mub
ff95nuf78nm+39/7TycEE7MF9EOCeRgCWvq6ja1UbIPkHB1MGxUf4tdN5zeDG223Shr3eOpy0pLG
D/XjKz5iM76U4j+p9PUnLd7ePgBzZfZQAoo+vbRLCQq4/hu+SQ4FA1Td943xsLomEMC0MSlAzNBk
7dfwoj6/gMsPBPzpix95dUmvH0DNzMBZl7VkeCqye3wANdODlF0mm700a7wB9ckBYjckQoJJrsR5
tcoRxQMwsCZA/LyeGbDIIrIB+H26xtLkATgcKPmj9hmwT0QqgfV/cyjf3pILjw9qAE3xvqEhq4HM
HvsMaBcRSwZQlQDAlOLPhmBoFBHRAyBFbTw02WsQ/HwEsPQuq53sGCD0jVBo+j4AKRHRx162FQng
ADS9CVNfSuctLSC+ExK7L52pYEk4wOQYmJYNmXdzNTpq1NO83wjO2biLmJ0c5v4CTfyEK1vhqLUq
j2WOKVhXAH1tUPwmc3uVAcsLrFVLGMzn3fjsZnZ03usG5I2q5e25hqkzmBUKQOLjwMg/o5tLmVUX
bojjVJczg+oQri2/8sH7NY8emKXGz756GxpEpDRenTvmFfRJEfv7dZyVI0VGqHVmUGn/dfg6kiZa
0/qWq4C3xl7kj+OAHc9NdKrCngFmISGZnO2KL6yFM44M7CnkiZTVtlvLyn+7wuGc1Sf7FrWJiPyi
zjXaW+gT28rrsgsy8gDWOTPQ82NI6hphTBtrHQfof8cvh9hb8ppPmBV50N0uCa+dKKuKjGIiHHoF
wO7oRrOVUEh4QGcwNOacAX7yvZwUi7HgTxVD9+yvn6N3AdpCh8V0Xz7Pd1XF2jYQkVOkNlV0i4jY
PpOfASee7DWt29QsItKwz+aqoG+XVUQG1nxhWfkXJ+G66AEd9xaOPCCAdUr3DVgavtrw8cM5Y0Bk
wnSrK4HILAMQueps//BROpdWRL4Czn/QUW9TRIyQ1bW/J/+WiHQVPLT4K+0abG8pKbkhUrf3Qscc
bQYALXFfWE6aGCyGpTELPx8/DPjyhX8VvdepGZx1Y+bvvAhjqkNjnlZ16tZWdGzWwd3XwopvwWiU
T7cDLVuAVaEaQBk8+WDr6IgJEWFjvEsAwFgHcEHa80VE9gF88rJ7ATbnwuisbSLlTdLzHUe/iMfm
+sYzjmdTImCvBHiK56eoZtMmaN0TZw5PNI4L08OkLO5GrwWUqJVtAewfOt4bPVcJ3jNDLP12SJs0
O8D2PjyS4DKSc7fgCXsSnhmoMv5XweOjYtBBWGpsfIAMdLODAxzb96qoVIKdUILLTUg0QIASANA/
4Xje488o21xuPrZFzi3K8FwCwGuuXiRiGcDWuwBCAgOaO5wvU9cDmSvDXJbwJcCkNJ2nv3YkOuSC
OvIGGxoa+rXnh8Ev79toFBERZR7sFhGRYI0YPsFbkVoe69NU/1/ja+Mv2O4AoJVN1m8DsN9hCaro
cr8lgCgtIPEHd8R4RK8CYofcESArHP6XySQK6LwrVWrBcc43gPqqSvVkrefpxvL5tdHJP/I4gdsL
c9w/EFH+6gGYV+3ejKSsVkREbu42a4b07e2gDmVERKq8Miy0u3wPm5ynsHqX6ube+XgBBsI8AfpH
d3Y6d6STrY7naZVpq8xyerW6Aba1Pk03bIdRm7Q4eJabxctdC+4NzUGzzl/z5+7p1CKk+9Lm1zXm
1y0aQO9ivz04J+fTc/2KoiiK9VzFHxZ6Gv/uwDpvbfX39z82dqs3IHlxyLQT9dHm3kGlzNuWsSsW
cF/71q1ZvmQmPHvxa41TfmyvMT22a2J9pm92BxY4G9z5veLVUyM2wlPLYO/DPO+o8rFhIS+m3DO+
5bRX8HYY5xptahP1v3q5dTo1lnzOn48uPfMs8I6IqfXqvwfM7zh9f+pY6Rf8Bw6qce4bS/9tKeSS
2P7xuXKtRak+ePzQZtWUlxHJTKDkSBxjN3Kyg1STL0BElKIm58uxSlFKm1V9c6nxlZJcFvTK0YVb
eg8qHdS6YvzenbtKkqce7x89zaWobE0yF+iX/BB6wiLA2h7vnsXu/9eUl38tIiLHN5hEGo9oc6su
kCv/bBc/8l/mOtXeHS1s7wAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyNS0wOS0yMVQwMDoyOTo1NSsw
MDowMF2jvnEAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjUtMDktMjFUMDA6Mjk6NTUrMDA6MDAs/gbN
AAAAAElFTkSuQmCC}
image create photo nanooo -data [binary decode base64 $nanooo]
wm iconphoto . nanooo
### SIXEL PARSING LIB ###
set images {}
proc char2n {char} {
binary scan $char c n
expr {($n&0x7F)-0x3F}
}
proc chars2bytes {sixels} {
set ret {}
set nums {}
foreach sixel $sixels { lappend nums [char2n $sixel] }
for {set i 0} {$i < 6} {incr i} {
set s ""
foreach n $nums {
append s [expr {($n>>$i)&1}]
}
append s [string repeat "0" [expr {7 - (([string length $s] + 7) % 8)}]]
binary scan [binary format b* $s] c* bytes
foreach byte $bytes {
lappend ret [format "%02x" [expr {$byte&0xff}]]
}
}
return $ret
}
proc splitsixels {str} {
set ret {}
set row {}
foreach c [split $str {}] {
switch -regexp -- $c {
- {
set row [string trimright $row "? "]
lappend ret $row
set row {}
}
[?-~] {
lappend row $c
}
default { # ignored }
}
}
if {$row != {}} { lappend ret $row }
return $ret
}
proc sixels2xbm {sixels} {
set rows [splitsixels $sixels]
set ba {}
if {[llength $rows] == 0} { return {} }
# if {[llength $rows] > 3} { set rows [lrange $rows 0 2] }
set height [expr {min(48, [llength $rows]*6)}]
set width 0
foreach row $rows {
set width [expr {max($width, [llength $row])}]
}
if {$width == 0} { return {} }
foreach row $rows {
append row [string repeat " ?" [expr {$width - [llength $row]}]]
lappend bytes {*}[chars2bytes $row]
}
set nbytes [expr {int(ceil($width / 8.0)) * $height}]
set bytes [lrange $bytes 0 $nbytes-1]
set ret "#define img_width $width\n#define img_height $height\n"
append ret "static unsigned char img_bits\[\] = {\n\t"
foreach byte $bytes {
append ret "0x" $byte ", "
}
set ret [string range $ret 0 end-2]
append ret "\n\t};\n"
return $ret
}
proc sixels2image {sixels} {
global images
if {[dict exists $images "sixel:$sixels"]} {
return [dict get $images "sixel:$sixels"]
}
set xbm [sixels2xbm $sixels]
if {[dict exists $images "xbm:$xbm"]} {
return [dict get $images "xbm:$xbm"]
}
set image [image create bitmap -data $xbm]
image create bitmap motd$image -data $xbm -foreground DarkOliveGreen
image create bitmap mention$image -data $xbm -foreground DarkOrchid4
dict set images "sixel:$sixels" $image
dict set images "xbm:$xbm" $image
dict set images "image:$image" $sixels
dict set images "image:motd$image" $sixels
dict set images "image:mention$image" $sixels
return $image
}
proc parseline {line} {
set chunks {}
set idx1 -1
set idx2 -1
while {[set idx2 [string first "\\(" $line $idx1]] != -1} {
# insert the prefix text
lappend chunks [string range $line $idx1 $idx2-1]
# get the sixels
set idx1 $idx2
set idx2 [string first ")" $line $idx1+2]
if {$idx2 == -1} { set idx2 [string length $line] }
# insert them
set image [sixels2image [string range $line $idx1+2 $idx2-1]]
lappend chunks [list [string range $line $idx1 $idx2] $image]
set idx1 [expr {$idx2 + 1}]
}
lappend chunks [string range $line $idx1 end]
return $chunks
}
### 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
}
}
### UI SETUP ###
frame .motd
frame .foot
entry .foot.input
label .foot.msgs -textvariable lastmsg
label .foot.sep -text " // "
label .foot.ppl -textvariable clients
label .foot.name
scrollbar .scroll -command {.buffer yview}
text .buffer -height 24 -width 128 -yscrollcommand {.scroll set}
pack .foot.ppl .foot.sep .foot.msgs -side right
pack .foot.name -side left
pack .foot.input -side bottom -fill x
pack .motd -side top
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]
}
}
}
bind . <Destroy> {if {[list %W] == "."} quit}
bind . <Control-q> quit
bind . <Control-R> restart
bind . <Control-N> runself
bind . <Control-s> {.menu.opt invoke "show raw sixel codes"}
.buffer tag configure rawsixel -elide true -foreground DarkSlateGrey
.buffer tag configure motd -foreground DarkOliveGreen -justify center -spacing1 5 -spacing3 5 -underline 1
.buffer tag configure mention -foreground DarkOrchid4
### MENU ###
menu .menu
menu .menu.nt -tearoff 0
menu .menu.opt -tearoff 1
menu .menu.sixels -tearoff 1 -title "sixel picker"
menu .menu.sixels.rm -tearoff 0
menu .menu.server -tearoff 0
menu .menu.server.rm -tearoff 0
.menu add cascade -label "ntalk" -menu .menu.nt
.menu.nt add command -label "about ntalk" -command {
tk_messageBox -title "about ntalk" \
-message "ntalk\nby aleteoryx" \
-detail "last updated 2025-09-22" \
-icon "info"
}
.menu.nt add separator
.menu.nt add command -label "new window" -command runself -accelerator "Ctrl-Shift-N"
.menu.nt add command -label "restart" -command restart -accelerator "Ctrl-Shift-R"
.menu.nt add command -label "quit" -command quit -accelerator "Ctrl-Q"
.menu add cascade -label "sixels" -menu .menu.sixels
.menu.sixels add separator
.menu.sixels add cascade -label "delete a sixel..." -menu .menu.sixels.rm
.menu add cascade -label "servers" -menu .menu.server
.menu.server add separator
.menu.server add command -label "add a server" -command addserver_open
.menu.server add cascade -label "delete a server..." -menu .menu.server.rm
.menu add cascade -label "options" -menu .menu.opt
.menu.opt add checkbutton -label "show raw sixel codes" \
-accelerator "Ctrl-s" -variable showsixel -command {
.buffer tag configure rawsixel -elide [expr {!$showsixel}]
}
. configure -menu .menu
### MOTD ###
proc setmotd {newmotd} {
global motd
destroy {*}[winfo children .motd]
foreach {text image} [parseline $newmotd] {
set tlabel [label .motd.[incr i] -text $text]
pack $tlabel -side left
if {$image != {}} {
lassign $image _ image
set ilabel [label .motd.[incr i] -image $image]
pack $ilabel -side left
}
}
set motd $newmotd
}
### USER SIXEL LIBRARY ###
set sixellib {}
proc savesixels {} {
global sixellib sixelpath
set fp [open $sixelpath w]
foreach line [lreverse $sixellib] {
if {$line == {}} {
puts $fp ""
continue
}
lassign $line name data
puts $fp "$name = $data"
}
close $fp
}
proc rmsixel {n} {
global sixellib
set sixellib [lreplace $sixellib $n $n]
savesixels
regensixelmenu
}
proc getsubmenu {menu name} {
while {[set idx [string first / $name]] != -1} {
set chunk [string trim [string range $name 0 $idx-1]]
set name [string trim [string range $name $idx+1 end]]
set submenu "${menu}.u$chunk"
catch {
menu $submenu -tearoff 0
$menu insert 0 cascade -menu $submenu -label $chunk
}
set menu $submenu
}
return [list $menu $name]
}
proc regensixelmenu {} {
global sixellib
if {[.menu.sixels index end] > 2} {
.menu.sixels delete 0 [expr {[.menu.sixels index end]-2}]
.menu.sixels.rm delete 0 end
foreach menu [winfo children .menu.sixels] {
if {$menu == ".menu.sixels.rm"} continue
destroy $menu
}
destroy {*}[winfo children .menu.sixels.rm]
}
for {set i 0} {$i < [llength $sixellib]} {incr i} {
if {[lindex $sixellib $i] == {}} continue
lassign [lindex $sixellib $i] name data
set name [string trim $name]
set data [string trim $data]
set escdata [list "\\($data)"]
lassign [getsubmenu .menu.sixels $name] menu label
$menu insert 0 command -image [sixels2image $data] -hidemargin 1 -command [subst {
.foot.input insert insert $escdata
}]
lassign [getsubmenu .menu.sixels.rm $name] menu label
$menu insert 0 command -image [sixels2image $data] -hidemargin 1 -command [subst {
rmsixel $i
}]
}
}
if {[file readable $sixelpath]} {
set fp [open $sixelpath]
while {![eof $fp]} {
gets $fp line
if {$line == {}} {
lappend sixellib {}
continue
}
set idx [string first "=" $line]
set name [string trim [string range $line 0 $idx-1]]
set data [string trim [string range $line $idx+1 end]]
lappend sixellib [list $name $data]
}
set sixellib [lreverse $sixellib]
close $fp
} else {
set sixellib {}
}
regensixelmenu
set clickedimage {}
proc finishsixel {} {
global clickedimage images sixellib
set data [dict get $images "image:$clickedimage"]
regsub "=" [.namesixel.entry get] ":" name
lappend sixellib [list $name $data]
savesixels
regensixelmenu
destroy .namesixel
}
menu .savesixel -tearoff 0
.savesixel add command -label "copy sixel" -command {
clipboard clear
clipboard append "\\([dict get $images "image:$clickedimage"])"
set clickedsixel {}
}
.savesixel add command -label "save sixel..." -command {
bind . <Button> {}
toplevel .namesixel -pady 5 -padx 5
wm title .namesixel "< | name sixel | >"
wm attributes .namesixel -type dialog
entry .namesixel.entry
button .namesixel.ok -text ok -command finishsixel
pack .namesixel.ok -side bottom -padx 5 -pady 5
pack .namesixel.entry -side bottom -padx 5 -pady 5 -fill x
label .namesixel.img -image $clickedimage
label .namesixel.blurb -text "choose what to save this sixel as..."
pack .namesixel.img -side left -padx 5 -pady 5
pack .namesixel.blurb -side right -padx 5 -pady 5
bind .namesixel <Destroy> { set clickedimage "" }
}
bind .buffer <Button-3> {
if {$clickedimage == {}} {catch {
set clickedimage [.buffer image cget @%x,%y -image]
set clickedimage [dict get $images sixel:[dict get $images image:$clickedimage]]
.savesixel post %X %Y
bind . <Button> {
.savesixel unpost
bind . <Button> {}
set clickedimage {}
}
}}
}
### SERVER MANAGEMENT ###
proc gencscript {{server localhost} {port 44322}} {
set server [list $server]
set port [list $port]
set ret [subst \
{# the entire connection is run through sok, make sure to set it up right.
# press C-RET to connect
# your changes will be saved
# set servername "johann smith's server"
set server $server
set port $port
}]
append ret {set sok [socket $server $port]}
return [string trim $ret]
}
# figure out what server to connect to
proc locatecscript {} {
global scriptpath
set scriptpath [_locatecscript]
# we might have created or moved files
regenservlist
return $scriptpath
}
proc _locatecscript {} {
global confdir scriptdir defaultserver argv
# migrate old config
set scriptpath "${confdir}/cscript.tcl"
if {[file readable $scriptpath] && ![file exists $scriptdir]} {
file mkdir $scriptdir
file rename $scriptpath "$scriptdir/default.tcl"
return "$scriptdir/default.tcl"
}
file mkdir $scriptdir
# handle argument
if {[llength $argv] > 0 && [file readable "${scriptdir}/[lindex $argv 0].tcl"]} {
return "${scriptdir}/[lindex $argv 0].tcl";
}
# try using the default
set scriptpath [file join $scriptdir "${defaultserver}.tcl"]
if {[file readable $scriptpath]} {
return $scriptpath
}
# try picking a default
set servlist [lsort [glob -directory $scriptdir "*.tcl"]]
if {[llength $servlist] > 0} {
return [lindex $servlist 0]
}
# fine, create a new one
set fp [open "${scriptdir}/default.tcl" w]
puts $fp [gencscript]
close $fp
return "${scriptdir}/default.tcl"
}
proc regenservlist {} {
global scriptdir scriptpath
if {[.menu.server index end] > 2} {
.menu.server delete 0 [expr {[.menu.server index end]-3}]
.menu.server.rm delete 0 end
}
foreach filename [lsort -decreasing [glob -directory $scriptdir *.tcl]] {
set slug [file tail [file rootname $filename]]
if {$filename == $scriptpath} {
set slug "$slug (current)"
set en disabled
} else {
set en normal
}
.menu.server insert 0 command -label $slug -state $en \
-command [list restart $slug]
.menu.server.rm insert 0 command -label $slug -state $en \
-command [concat [list file delete $filename] ";" regenservlist]
}
}
proc addserver_open {} {
destroy .addserver
toplevel .addserver -pady 5 -padx 5
wm title .addserver "< | add server | >"
wm attributes .addserver -type dialog
frame .addserver.i
frame .addserver.i.name
label .addserver.i.name.label -text "short name: "
entry .addserver.i.name.entry
pack .addserver.i.name.entry .addserver.i.name.label -side right
frame .addserver.i.host
label .addserver.i.host.label -text "hostname: "
entry .addserver.i.host.entry
.addserver.i.host.entry insert 0 localhost
pack .addserver.i.host.entry .addserver.i.host.label -side right
frame .addserver.i.port
label .addserver.i.port.label -text "port: "
entry .addserver.i.port.entry
.addserver.i.port.entry insert 0 44322
pack .addserver.i.port.entry .addserver.i.port.label -side right
pack .addserver.i.name .addserver.i.host .addserver.i.port -side top -fill x
label .addserver.err -foreground red
frame .addserver.btn
button .addserver.btn.cancel -text "cancel" -command {destroy .addserver}
button .addserver.btn.ok -text "add" -command addserver_finish
pack .addserver.btn.cancel .addserver.btn.ok -side left
pack .addserver.i .addserver.btn -side top -pady 5 -padx 5
focus .addserver.i.name.entry
}
proc addserver_finish {} {
global scriptdir
set name [.addserver.i.name.entry get]
set host [.addserver.i.host.entry get]
set port [.addserver.i.port.entry get]
if {$name == {}} {
.addserver.err configure -text "short name cannot be empty!"
return
} elseif {[string first / $name] != -1} {
.addserver.err configure -text "short name cannot include slashes!"
return
}
set path [file join $scriptdir "${name}.tcl"]
if [file readable $path] {
.addserver.err configure -text "there's already a server called ${name}!"
return
}
set fp [open $path w]
puts $fp [gencscript $host $port]
close $fp
runself $name
destroy .addserver
regenservlist
}
### LOAD BASE CONFIG ###
set servername "the series of tubes"
set sok {}
set baseconfig \
{# these settings are applied to all connections
# hit C-RET to apply and restart
set user marmalade
set cmds {}
set defaultserver default
font configure TkDefaultFont -family monospace
font configure TkTextFont -family monospace
font configure TkFixedFont -family monospace
}
eval $baseconfig
if [file readable $config] {
set fp [open $config]
set $configtext [read $fp]
close $fp
eval $configtext; # TODO: wrap in catch or something
}
make16
### CONNECTING ###
locatecscript
set fp [open $scriptpath]
.buffer insert 1.0 [read $fp]
close $fp
bind . <Control-Return> {
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 . <Control-Return> {}
.buffer configure -state disabled
bind .buffer <KeyPress> {
set k %A
if {[string is alnum $k] || ($k != "\t" && [string is space $k])} {
focus .foot.input
.foot.input insert insert $k
}
}
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}:"
settitle "nanochatting on $servername"
### NETCODE ###
proc setclients {newc} {
global clients
set clients $newc
}
proc setlastmsg {new} {
global lastmsg
set lastmsg $new
}
set lastmsg 0
set netcode { ### ENTER SECTION THAT MAY BE THREADED ###
set lastmsg 0
proc sendl {line} {
global sok inrecv
if {$inrecv} return
regsub "\n" $line " " line
if [catch {
puts $sok $line
flush $sok
}] { restart }
}
proc recvl {} {
global sok
gets $sok ret
# if [catch { gets $sok ret }] { restart }
return $ret
}
set inrecv 0
proc recvlines {{bd 0}} {
global lastmsg inrecv
if {$inrecv} return
set inrecv 1
set n [recvl]
for {set i 0} {$i < $n} {incr i} {
bufpush [recvl]
if $bd bufdown
}
setlastmsg [recvl]
set inrecv 0
}
proc send {line} {
global lastmsg
sendl "SEND $line"
set msgid [recvl]
if {$msgid == $lastmsg+1} {
setlastmsg $msgid
return 1
}
after idle skip
return 0
}
proc sendmsg {msg} {
if {[send $msg]} {
bufpush "$msg"
bufdown
}
}
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
}
proc stat {} {
sendl STAT
lassign [recvl] msgs
lassign [recvl] bytes
lassign [recvl] clients
setclients $clients
}
set pmid {}
proc pollmsgs {delay} {
global inrecv pmid
after cancel $pmid
set pmid [after $delay doskip $delay]
}
proc doskip {delay} {
global inrecv
if !$inrecv {
stat
skip
}
set pmid [after $delay doskip $delay]
}
}; ### END OF SECTION THAT MAY BE THREADED ###
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 {
proc restart {} {
global argv0
exec [info nameofexecutable] $argv0 &
exit 0
}
set sok $sok
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 {} hist {} thread::send -async $nett hist
proc send {line} [subst -nocommands { thread::send $nett [list send [set line]] }]
proc sendmsg {line} [subst -nocommands { thread::send -async $nett [list sendmsg [set line]] }]
proc pollmsgs {n} [subst -nocommands { thread::send -async $nett [list pollmsgs [set n]] }]
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 threads
set tag {}
if {[string first "MOTD:" $line] == 0} {
setmotd [string trim [string range $line 5 end]]
set line "<<< $motd >>>"
set tag motd
} elseif {[string first "MOTD" $line] == 0} {
setmotd [string trim [string range $line 4 end]]
set line "<<< $motd >>>"
set tag motd
} elseif {[regexp "\[^\\w.\]${user}\[^\\w.\]" $line]} {
set tag mention
}
.buffer configure -state normal
foreach {text image} [parseline $line] {
.buffer insert end $text $tag
if {$image != {}} {
lassign $image raw image
set image $tag$image
.buffer insert end $raw [concat rawsixel $tag]
.buffer image create end -image $image
.buffer tag add $tag {end -1 chars}
}
}
.buffer insert end "\n" $tag
.buffer configure -state disabled
if !$threads update
}
proc bufdown {} {
global threads
.buffer yview moveto 1
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..."
if !$threads update
}
proc n64k_secs {msgcount} {
# 2025-09-19 01:59:38 GMT
set proto_epoch 1758247178
expr {$proto_epoch + (([clock seconds] - $proto_epoch) * 65535 / $msgcount)}
}
proc n64k_date {} {
global lastmsg
clock format [n64k_secs $lastmsg]
}
### BOOT ###
last 64
pollmsgs 15000
set typingid {}
bind .foot.input <KeyPress> {
after cancel $typingid
pollmsgs 3000
set typingid [after 15000 pollmsgs 15000]
}
bind .foot.input <Return> [concat [bind .foot.input <Return>] ";" {
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 *} {
sendmsg [string range $line 6 end]
}
{/motd *} {
sendmsg "MOTD [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]]
}
{/n64k} {
.foot.input insert 0 [n64k_date]
}
{} {}
default {
sendmsg "$user: $line"
}
}]
}]
focus .foot.input