This is similar to Jeff's non-compressing encoding at [Binary image compression challenge]. It does not compress, the size of the encoded file for an image having ''X'' pixels is (12+X/8) bytes. The differences are: * faster encoding - access the [[$img data]] in one go, instead of repeating [[$img get]] calls. * it encodes ''changes'' in color, instead of encoding the color. The second difference is expected to produce more zeros, and hence (maybe?) a file that compresses better even though it has the same length as Jeff's. ---- '''Results''' * courier12.dif: 2163b (courier12.dif.gz: 660b) courier12.gif: 1923b * times12i.dif: 1611b (times12i.dif.gz: 683b) times12i.gif: 1947b * castle.dif: 15763b (castle.dif.gz: 10234b) castle.gif: 11598b ''castle.dif'' has 80% nonzero bits, versus 69% in ''castle.jeff''. ---- # # Given an image, it returns an encoded binary string. # proc analyse img { set h [image height $img] set w [image width $img] set raw [$img data] set clr0 [lindex [lindex $raw 0] 0] set clr $clr0 set str {} catch { foreach line $raw { foreach pix $line { if {$pix ne $clr} { set clr1 $pix return; #double break } } } set clr1 $clr0 } foreach line $raw { foreach pix $line { append str [expr {$pix ne $clr}] set clr $pix } } set clr0 [expr {[string replace $clr0 0 0 0x]}] set clr1 [expr {[string replace $clr1 0 0 0x]}] return [binary format ssiib* $w $h $clr0 $clr1 $str] } # # Given an encoded binary string, it returns an image. # proc synth {data} { binary scan $data ssiib* w h clr0 clr1 str set img [image create photo -width $w -height $h] set clr0 \#[format %06x $clr0] set clr1 \#[format %06x $clr1] set empty [list] set data $empty set line $empty set clrs [list $clr0 $clr1] set clr $clr0 set nclr 0 set i 0 foreach bit [split $str {}] { if {$bit} { set nclr [expr {!$nclr}] set clr [lindex $clrs $nclr] } lappend line $clr if {[incr i] == $w} { lappend data $line set line $empty set i 0 } } $img put $data -to 0 0 return $img }