MS Note: 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.
My compressing entry is at Binary image compression challenge - MS's Entry
The differences are:
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
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 }
PS I've tried your version in my compression code (my second attempt). The results are interesting indeed, both castle and courier12 compress less than with the JH variant. Howerver, times12i compresses somewhat better - Here are the numbers: