1 files changed, 123 insertions(+), 3 deletions(-)

M ntalk.tcl

@@ 13,6 13,101 @@ proc restart {} {
 }
 
 
+### 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


@@ 113,21 208,46 @@ proc recvl {} {
 	if [catch { gets $sok ret }] { restart }
 	return $ret
 }
+set inrecv 0
 proc recvlines {{bd 0}} {
-	global lastmsg
+	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
-	.buffer insert end "$line\n"
+	
+	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} break
+
+		# insert them
+		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
-	update
 }
 proc bufdown {} {
 	.buffer yview moveto 1