#!/bin/env wish


set confdir [file normalize ~/.config/ntalk]
set persisted "${confdir}/persist.tcldict"
set config "${confdir}/config.tcl"
set scriptdir "${confdir}/cscript"
set sixelpath "${confdir}/sixels.txt"
file mkdir $confdir

set bootargs $argv

proc quit {} {exit 0}
proc runself args {
	global argv0
	exec [info nameofexecutable] $argv0 {*}$args &
}
proc restart args {
	global bootargs
	if {$args == {}} { set args $bootargs }
	runself {*}$args
	exit 0
}

proc settitle {title} {
	wm title . ".  o  (  $title  )  o  ."
}
settitle ntalk
tk appname ntalk


### PERSISTED DATA ###

set persistwhat {
	talktype irc
}
foreach {var val} $persistwhat {
	set $var $val
}
if {[file readable $persisted]} {
	set fp [open $persisted r]
	set pdata [read $fp]
	close $fp
	foreach {var _} $persistwhat {
		if {[dict exists $pdata $var]} {
			set $var [dict get $pdata $var]
		}
	}
}

proc savepersist {} {
	global persistwhat persisted
	foreach {var _} $persistwhat {
		global $var
		dict set pdata $var [set $var]
	}
	set fp [open $persisted w]
	puts $fp $pdata
	close $fp
}


### ICON ###

# do not be alarmed!! 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 {
			- {
				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
.buffer tag configure url -underline 1 -foreground "dark cyan"
.buffer tag configure url2 -underline 1 -foreground "dark blue"

.buffer tag bind url <Enter> {
	set range [.buffer tag prevrange url current]
	.buffer tag add url2 {*}$range
	.buffer tag remove url {*}$range
	.buffer configure -cursor hand2
}
.buffer tag bind url2 <Leave> {
	set range [.buffer tag prevrange url2 current]
	.buffer tag add url {*}$range
	.buffer tag remove url2 {*}$range
	.buffer configure -cursor xterm
}
.buffer tag bind url2 <Button-1> {
	set range [.buffer tag prevrange url2 current]
	exec xdg-open [.buffer get {*}$range] &
}


### MENU ###

menu .menu
menu .menu.nt -tearoff 0
menu .menu.opt -tearoff 1
menu .menu.opt.style -tearoff 0
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-10-21" \
		-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}]
	}
.menu.opt add separator
.menu.opt add cascade -label "message style..." -menu .menu.opt.style
.menu.opt.style add radiobutton -label "IRC" -value irc \
	-variable talktype -command savepersist
.menu.opt.style add radiobutton -label "MOO" -value moo \
	-variable talktype -command savepersist

. 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> {}

set fp [open $scriptpath w]
puts $fp [string trim $cscript]
close $fp

fconfigure $sok -translation lf -blocking false -encoding iso8859-1
fileevent $sok readable [list incoming $sok]
set user [string trim $user]
.foot.name configure -text "${user}:"

settitle "nanochatting on $servername"


### NETCODE ###

proc neterr {} {
	restart
}

set nettimeout {}
proc heartbeat {} {
	global nettimeout
	killtimeout
	# double-wait, in case we're coming out of suspend
	set nettimeout [after 10000 {set nettimeout [after 20000 neterr]}]
}
proc killtimeout {} {
	global nettimeout
	after cancel $nettimeout
}

set next {}
set sendqueue {}

proc incoming {sok} {
	global next
	if [catch {
		while {[gets $sok line] != -1} {
			heartbeat; # yay networking!
			eval $next [list $line]
		}
		if {[eof $sok]} { neterr }
	}] { neterr }
}

proc sendl {line} {
	global sok
	regsub "\n" $line " " line
	if [catch {
		puts $sok $line
		flush $sok
	}] { neterr }
	
	heartbeat; # start timeout
}
proc pumpq {} {
	global next sendqueue
	set sendqueue [lassign $sendqueue send recv]
	set next $recv
	killtimeout; # in case $send == {}
	eval $send
}
proc sendq {send recv} {
	global next sendqueue
	if {$next == {}} {
		set next $recv
		eval $send
	} else {
		lappend sendqueue $send $recv
	}
}

proc sendr {line id} {
	global lastmsg 
	if {$lastmsg+1 == $id} {
		set lastmsg $id
		bufpush $line
		bufdown
	}
	pumpq
}
proc send {line} {
	sendq [list sendl "SEND $line"] [list sendr $line]
}

proc lines {post n line} {
	global lastmsg next
	if {$n == 0} {
		set lastmsg $line
		eval $post
		pumpq
	} else {
		set next [list lines $post [expr {$n - 1}]]
		bufpush $line
	}
}
proc appended {post n} {
	global next
	set next [list lines $post $n]
}
proc cleared {n} {
	bufclear
	appended bufdown $n
}

proc hist {} {
	sendq {sendl HIST} cleared
}
proc last {n} {
	sendq [list sendl "LAST $n"] cleared
}

set skipid {}
proc skipr {delay} {
	global skipid
	set skipid [after $delay skip $delay]
}
proc skip {delay} {
	global skipid
	after cancel $skipid

	sendq {
		global lastmsg
		sendl "SKIP $lastmsg"
	} [list appended [list skipr $delay]]
}

proc quit {} {
	sendl QUIT
	exit 0
}

proc statr {line} {
	global clients
	lassign $line n type
	switch -- $type {
		clients {
			set clients $n
			after 10000 stat
			pumpq
		}
	}
}
proc stat {} {
	sendq {sendl STAT} {statr}
}


### ACTUAL CLIENT CODE LMAO ###

proc bufpush {line} {
	global images motd user

	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}\\M" $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}
		}
	}

	set urlre {(https?:(//)?)?([^ ./?#]+\.)+[^ ./?#]{2,}([/?#][^\s]*)?}
	set urls [.buffer search -all -strictlimits -regexp -- $urlre "end - 1 lines" end]
	foreach idx $urls {
		set idx2 [.buffer search -regexp -- {\s} "$idx + 1 chars"]
		.buffer tag add url $idx $idx2
	}
	

	.buffer insert end "\n"
	.buffer configure -state disabled
}
proc bufdown {} {
	.buffer yview moveto 1
}
proc bufclear {} {
	.buffer configure -state normal
	.buffer replace 1.0 end {}
	.buffer configure -state disabled
	setmotd "no MOTD yet! maybe you should send one..."
}

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]
}

proc setuser {new} {
	global user
	set user [string trim $new]
	.foot.name configure -text "${user}:"
}
proc say {msg} {
	global talktype user
	if {$talktype == "moo"} {
		send "${user} says, \"$msg\""
	} else {
		send "${user}: $msg"
	}
}


### BOOT ###

.buffer configure -state disabled
bind .buffer <KeyPress> {
	set k %A
	if {$k == " " || ![string is control $k]} {
		focus .foot.input
		.foot.input insert insert $k
	} elseif {$k == "\b" && [selection own] == ".foot.input"} {
		focus .foot.input
		.foot.input delete sel.first sel.last
	} elseif {$k == "\b"} {
		focus .foot.input
		.foot.input delete [expr {max(0,[.foot.input index insert]-1)}]
	}
}

set typingid {}
bind .foot.input <KeyPress> {
	if {$typingid == {}} {skip 3000}

	after cancel $typingid
	set typingid [after 15000 {
		set typingid {}
		skip 15000
	}]
}


bind .foot.input <Return> [concat [bind .foot.input <Return>] ";" {
	set line [.foot.input get]
	.foot.input delete 0 end

	set line [string trim $line]
	if {[string length $line] == 0} {
		return
	} elseif {[string first "//" $line] == 0} {
		say [string range $line 1 end]
		return
	} elseif {[string first "/" $line] != 0} {
		say $line
		return
	}

	set idx [string first " " $line]
	if {$idx == -1} {
		set idx end
	} else {
		incr idx -1
	}
	set cmd [string range $line 1 $idx]
	set line [string range $line $idx+2 end]
	switch -nocase -- $cmd [concat $cmds {
		hist { hist }
		quit { quit }
		restart { restart }

		nick { setuser $line }
		name { setuser $line }
		user { setuser $line }

		last { last $line }
		send { send $line }

		motd { send "MOTD $line" }
		me   { send "${user} $line" }
		my   { send "${user}'s $line" }
		idea { send "${user} . o ( $line )" }
		<=   { send "${user} <= $line" }

		eval { .foot.input insert 0 [eval $line] }
		exec { .foot.input insert 0 [exec sh -c $line] }
		calc { .foot.input insert 0 [expr $line] }
		
		n64k { .foot.input insert 0 [n64k_date] }
	}]
}]

focus .foot.input

stat
last 64
skip 15000