Note that this is still very much a work-in-progress as I ([DKF]) am not putting much time into working on this. :^) ---- package req Tk proc load {file} { image create photo foo -file $file set w [image width foo] set h [image height foo] # Construct basic RLE data from image (assumed monochrome) set init 0 set length 0 set out [list $w $h] set max [expr {$w>$h ? $w : $h}] for {set x 0} {$x<$w} {incr x} { for {set y 0} {$y<$h} {incr y} { set item [expr {[lindex [foo get $x $y] 0] > 127}] if {$item != $init} { lappend out $length if {$max < $length} { set max $length } set init $item set length 0 } incr length } } if {$max < $length} { set max $length } lappend out $length image delete foo return [list $max $out] } proc compress {file} { foreach {max data} [load $file] break set bits [expr {(int(ceil(log($max)/log(2)))>>1) + 1}] set limit [expr {1<<$bits}] # If the chunk size doesn't fit in 4 bits, we're in trouble. binary scan [binary format i $bits] b4 output foreach val $data { if {$val < $limit} { binary scan [binary format i $val] b$bits binary append output $binary } else { set v1 [expr {$val & ($limit-1)}] set v2 [expr {$val >> $bits}] binary scan [binary format i $v1] b$bits b1 binary scan [binary format i $v2] b$bits b2 append output $b1[string repeat 0 $bits]$b2 } } return [binary format b* $output] } proc gzip d { set data [open foo.tmp w] fconfigure $data -translation binary puts -nonewline $data $d close $data set f [open "|gzip -c $w} { set w $w2 } } .t conf -tab "$w left [expr $w+100]" .t insert end "File:\tPrior\tPost\tgzipped\tTimings\n" foreach f $files { set t [time {set d [compress $f]}] set d2 [gzip $d] .t insert end "[file tail $f]\t[file size $f]\t[string length $d]\t[string length $d2]\t$t\n" } ---- [[''?'']]