[MS]: A compressor using [Fibonacci coding] of numbers. Could probably be improved with [Arithmetic coding].

Results:
   * courier12.fibo 985b
   * times12i.fibo 948b
   * castle.fibo 11542b
   * ouster.fibo 1775b
----

The image is
   * analyzed as in [Binary image compression challenge - mig's Entry] - get bytes of transition encoding
   * the bits are grouped in bytes (last one completed with 0s to length 8)
   * the bytes are ranked by decreasing frequency, and numbered accordingly 
   * the byte-number stream is converted to a bitstream by [Fibonacci coding]

Note that the most frequent 20 bytes are encoded in less than 8 bits, up to rank 33 in 8 bits, after that there is a loss.

The bytes in the compressed file are
    Encoding:
      2 width
      2 height
      4 clr0
      4 clr1
      2 table length
    256 table (may be shorter)
      ? data (fibo encoded)
----
Requires the code at [Fibonacci coding]. Usage:
 set w [encode $img]
 set img [decode $w]

The code:
 proc analyze 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
 
     # Find the second color (assumes just two!)
     catch {
 	foreach line $raw {
 	    foreach pix $line {
 		if {$pix ne $clr} {
 		    set clr1 $pix
 		    return; #double break
 		}
 	    }
 	}
 	set clr1 $clr0
     }
 
     # Compute a sequence of bytes encoding the color
     # transitions (bit 1 marks a transition)
     set mask 128
     set byte 0
     set bytes [list]
     foreach line $raw {
 	foreach pix $line {
 	    if {$pix ne $clr} {
 		incr byte $mask
 		set clr $pix
 	    }
 	    if {$mask != 1} {
 		set mask [expr {$mask >> 1}]
 	    } else {
 		lappend bytes $byte
 		set byte 0
 		set mask 128
 	    }
 	}
     }
     if {$mask!=128} {
 	lappend bytes $byte
     }
 
     return [list $w $h $clr0 $clr1 $bytes]
 }
 
 proc stats nums {
     foreach num $nums {
 	if {[info exists a($num)]} {
 	    incr a($num)
 	} else {
 	    set a($num) 1
 	}
     }
     set tally [list]
     foreach {num ct} [array get a] {
 	lappend tally [list $num $ct]
     }
     lsort -decreasing -index 1 -integer $tally
     
 }
 
 proc encode img {
     foreach {w h clr0 clr1 bytes} [analyze $img] break
     set data [list $w $h]
     lappend data [expr {[string replace $clr0 0 0 0x]}]
     lappend data [expr {[string replace $clr1 0 0 0x]}]
 
     set tally [stats $bytes]
     set len [llength $tally]
     lappend data $len
 
     # Compute the map: the most frequent byte is encoded
     # as 1, the secondmost frequent as 2, ...
     set i 0
     foreach item $tally {
 	set byte [lindex $item 0]
 	set rmap($byte) [incr i]
 	lappend data $byte
     }
 
     # Fibonacci-encode the byte sequence
     set toEnc [list]
     foreach byte $bytes {
 	lappend toEnc $rmap($byte)
     }
     lappend data [fiboEncodeList $toEnc]
 
     # Convert the data stream to binary
     set clen [string repeat c $len]
     set cmd [linsert $data 0 binary format ssiii${clen}B*]
     return [eval $cmd]
 }
 
 proc decode bin {
     set empty [list]
     
     # Read the map and fibo sequence together, separate
     # them and convert the map to 0/1 strings.
     # Note that the map will be read with 1-based indices,
     # hence add a dummy 0-th value
 
     binary scan $bin ssiiiB* w h clr0 clr1 len fib
     set map [list *]
     set lim [expr {$len*8-1}]
     set bmap [string range $fib 0 $lim]
     set fib [string range $fib [incr lim] end]
     for {set i 0} {$i < $len} {incr i} {
 	lappend map [string range $bmap 0 7]
 	set bmap [string range $bmap 8 end]
     }
 
     # Decode the Fibonacci-encoded bits
     set fibData [fiboDecodeString $fib]
     set bits {}
     foreach num $fibData {
 	append bits [lindex $map $num]
     }
     set bits [string range $bits 0 [expr {$w*$h-1}]]
     set fibdata {}
 
     # Regenerate the img data
     set clrs [list \#[format %06x $clr0] \#[format %06x $clr1]]
     set nclr 0
     set clr [lindex $clrs 0]
     set i 0
     set data $empty
     set line $empty
     foreach bit [split $bits {}] {
 	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
 	}
     }
 
     # Create the image
     set img [image create photo -width $w -height $h]
     $img put $data -to 0 0
     return $img
 }

----
[Category Compression]