1 files changed, 76 insertions(+), 0 deletions(-)

A sixel.tcl

@@ 0,0 1,76 @@
+#!/bin/env tclsh
+
+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
+}
+
+puts [sixels2xbm "o{}^}{{{}^}{o???-F^^zvvvvvz^^F???"]