The differences are:
- faster encoding - access the [$img data] in one go, instead of repeating [$img get] calls. Note that it does this twice (once hidden in the photo'colors call).
- it encodes changes in color, instead of encoding the color.
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
#
# 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:
- courier12: Was 671, grows to 721, gaining 50 bytes
- times12i: Was 718, shrinks to 684, 34 bytes less
- castle: Was 11442, grows to 12417, gaining 975 bytes.
