~aleteoryx/ntalk

67dcfc529ddcfea7197f507e92c9dd73c0b60906 — Aleteoryx 2 months ago a8feb7c
various things, sixel picker
1 files changed, 170 insertions(+), 10 deletions(-)

M ntalk.tcl
M ntalk.tcl => ntalk.tcl +170 -10
@@ 2,6 2,7 @@

set confdir ~/.config/ntalk
set scriptpath "${confdir}/cscript.tcl"
set sixelpath "${confdir}/sixels.txt"
file mkdir $confdir




@@ 16,7 17,7 @@ wm title . ".  o  (  ntalk  )  o  ."
tk appname ntalk


### SIXEL LIB ###
### SIXEL PARSING LIB ###

set images {}
proc char2n {char} {


@@ 25,6 26,8 @@ proc char2n {char} {
}

proc chars2bytes {sixels} {
	set ret {}
	set nums {}
	foreach sixel $sixels { lappend nums [char2n $sixel] }
	for {set i 0} {$i < 6} {incr i} {
		set s ""


@@ 65,9 68,9 @@ proc sixels2xbm {sixels} {
	set rows [splitsixels $sixels]
	set ba {}
	if {[llength $rows] == 0} { return {} }
	if {[llength $rows] > 3} { set rows [lrange $rows 0 2] }
#	if {[llength $rows] > 3} { set rows [lrange $rows 0 2] }
	
	set height [expr {min(16, [llength $rows]*6)}]
	set height [expr {min(48, [llength $rows]*6)}]
	set width 0
	foreach row $rows {
		set width [expr {max($width, [llength $row])}]


@@ 106,6 109,7 @@ proc sixels2image {sixels} {
	set image [image create bitmap -data $xbm]
	dict set images "sixel:$sixels" $image
	dict set images "xbm:$xbm" $image
	dict set images "image:$image" $sixels

	return $image
}


@@ 135,7 139,7 @@ label .foot.ppl -textvariable clients
label .foot.name

scrollbar .scroll -command {.buffer yview}
text .buffer -width 72 -yscrollcommand {.scroll set}
text .buffer -height 24 -width 128 -yscrollcommand {.scroll set}

pack .foot.ppl .foot.sep .foot.msgs -side right
pack .foot.name -side left


@@ 166,9 170,11 @@ bind . <Control-s> {.menu.opt invoke "show raw sixel codes"}
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 add cascade -label "ntalk" -menu .menu.nt
.menu.nt add command -label "about..." -command {
.menu.nt add command -label "about ntalk" -command {
	tk_dialog .about "about ntalk" \
		"ntalk\nby aleteoryx\nlast updated 2025-09-20" \
		"info" \


@@ 178,6 184,10 @@ menu .menu.opt -tearoff 1
.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 "options" -menu .menu.opt
.menu.opt add checkbutton -label "show raw sixel codes" \
	-accelerator "Ctrl-s" -variable showsixel -command {


@@ 187,12 197,145 @@ menu .menu.opt -tearoff 1
. configure -menu .menu


### 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
	
	.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 data [list "\\($data)"]
		lassign [getsubmenu .menu.sixels $name] menu label
		$menu insert 0 command -label $label -command [subst {
			.foot.input insert insert $data
		}]
		lassign [getsubmenu .menu.sixels.rm $name] menu label
		$menu insert 0 command -label $label -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 "save sixel..." -command {
	bind . <Button> {}

	toplevel .namesixel
	wm title .namesixel "<  |  name sixel  |  >"
	
	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

	canvas .namesixel.img -height [image height $clickedimage] \
		-width [image width $clickedimage]
	.namesixel.img create image 1 1 -anchor nw -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]
		.savesixel post %X %Y
		bind . <Button> {
			.savesixel unpost
			bind . <Button> {}

			set clickedimage {}
		}
	}}
}


### CONNECTING ###

set user marmalade
set cmds {}
set sok {}
set server "the web"
set server "the series of tubes"
if [file readable $scriptpath] {
	set fp [open $scriptpath]
	.buffer insert 1.0 [read $fp]


@@ 351,16 494,30 @@ proc sendmsg {msg} {
}

proc pollmsgs {} {
	stat
	skip
	global inrecv
	if !$inrecv {
		stat
		skip
	}
	after 10000 pollmsgs
}

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

set lastmsg 0
last 16
last [.buffer cget -height]
stat
after 10000 pollmsgs



@@ 381,7 538,7 @@ bind .foot.input <Return> [concat [bind .foot.input <Return>] ";" {
			last [string range $line 6 end]
		}
		{/send *} {
			send [string range $line 6 end]
			sendmsg [string range $line 6 end]
		}
		/me* {
			sendmsg "${user}[string range $line 3 end]"


@@ 402,6 559,9 @@ bind .foot.input <Return> [concat [bind .foot.input <Return>] ";" {
		{/calc *} {
			.foot.input insert 0 [expr [string range $line 6 end]]
		}
		{/n64k} {
			.foot.input insert 0 [n64k_date]
		}
		default {
			sendmsg "$user: $line"
		}