#!/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
}

wm title . ".  o  (  ntalk  )  o  ."
tk appname ntalk


### SIXEL LIB ###

set images {}
proc char2n {char} {
	binary scan $char c n
	expr {($n&0x7F)-0x3F}
}

proc chars2bytes {sixels} {
	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(16, [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]
	dict set images "sixel:$sixels" $image
	dict set images "xbm:$xbm" $image

	return $image
}


### 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.sep -text " // "
label .foot.ppl -textvariable clients
label .foot.name

scrollbar .scroll -command {.buffer yview}
text .buffer -width 72 -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 .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 . <Control-q> quit
bind . <Control-R> restart
bind . <Control-s> {.menu.opt invoke "show raw sixel codes"}

.buffer tag configure rawsixel -elide true -foreground DarkSlateGrey


### MENU ###

menu .menu
menu .menu.nt -tearoff 0
menu .menu.opt -tearoff 1

.menu add cascade -label "ntalk" -menu .menu.nt
.menu.nt add command -label "about..." -command {
	tk_dialog .about "about ntalk" \
		"ntalk\nby aleteoryx\nlast updated 2025-09-20" \
		"info" \
		0 okay
}
.menu.nt add separator
.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 "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


### 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 <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

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 . ".  o  (  nanochatting on $server  )  o  ."


### 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
}
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
	}
	set lastmsg [recvl]
	set inrecv 0
}

proc bufpush {line} {
	global images

	.buffer configure -state normal
	
	set idx1 -1
	set idx2 -1
	while {[set idx2 [string first "\\(" $line $idx1]] != -1} {
		# insert the prefix text
		.buffer insert end [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
		.buffer insert end [string range $line $idx1 $idx2] rawsixel
		set image [sixels2image [string range $line $idx1+2 $idx2-1]]
		.buffer image create end -image $image
		
		set idx1 [expr {$idx2 + 1}]
	}
	.buffer insert end [string range $line $idx1 end]
	.buffer insert end "\n"
	
	.buffer configure -state disabled
}
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
}

proc stat {} {
	global clients

	sendl STAT
	lassign [recvl] msgs
	lassign [recvl] bytes
	lassign [recvl] clients
}


### ACTUAL CLIENT CODE LMAO ###

proc sendmsg {msg} {
	global lastmsg
	set msgid [send $msg]
	if {$msgid == $lastmsg} {
		bufpush "$msg\n"
		bufdown
	} else { skip }
}

proc pollmsgs {} {
	stat
	skip
	after 10000 pollmsgs
}


### BOOT ###

set lastmsg 0
last 16
stat
after 10000 pollmsgs

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 *} {
			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"
		}
	}]
}]

focus .foot.input