#!/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???"]