Version 0 of Binary image compression challenge - mig's Entry

Updated 2004-09-04 01:50:25

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]
 }

 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
 }