When I wrote this, I only focussed on compression speed so sometimes it doesn't compress very well. 

'''How does it work?'''

It uses RLE compression with a fixed 5 pixel pattern ABCDE that can be repeated up to NNN times. Result is sent in a single byte ABCDENNN so NNN can't be greater than 7 (111). 

Each line must end with 0x80. 

If only white points remain on a line, I don't store them: they're replaced by 0x80. 

Finally, if there are more than 70 consecutive points of the same color on a line, I do like that:
   * for white points: I add 0x10 0xYY - with YY == number of 5 white point length segments found. So the max number is 0xFF = 255 * 5 = 1275 following white points.
   * for black points: like white point but uses 0x20 instead of 0x10.

'''Some speed results''' (on a 600 Mhz Crusoe with 192 MB Ram) :

 courier12.gif :   892 bytes (done in 0.23 seconds)
 times12i.gif  :   890 bytes (done in 0.21 seconds)
 castle.gif    : 15288 bytes (done in 1.85 seconds)
 ouster.gif    :  2612 bytes (done in 0.30 seconds)
 cat.gif       : this one fails actually :(
 oldeng16.gif  :  1976 bytes (done in 0.30 seconds)

'''The script''' (updated to work without [TkImg]) :

 package require Tk
 wm withdraw .
 
 # You only need to run this proc to test :
 proc Go { giffile } {
    set tps [time "gif2rle $giffile"]
    rle2gif [file rootname $giffile].rle
    set match [photo'eq rle gif]
    set tps [expr round([lindex $tps 0] / 10000.0) / 100.0]
    set rlesz [file size [file rootname $giffile].rle]
    if { $match } {
        puts "Done with succes. Results for $giffile :"
        puts "Start size      : [file size $giffile] bytes"
        puts "Compressed size : $rlesz bytes (done in $tps seconds)"
    } else  {
        puts "Error : "
        gif write [file rootname $giffile]-rle.gif
        puts "$giffile does not match [file rootname $giffile]-rle.gif"
    }
 }
 
 proc photo'eq {im1 im2} {
    set h [image height $im1]
    if {[image height $im2] != $h} {return 0}
    set w [image width $im1]
    if {[image width $im2] != $w} {return 0}
    for {set y 0} {$y<$h} {incr y} {
        for {set x 0} {$x<$w} {incr x} {
            if {[$im1 get $x $y] ne [$im2 get $x $y]} {return 0}
        }
    }
    return 1
 }
 
 proc rle2gif { fichier } {
    set fin [open $fichier r]
    fconfigure $fin -encoding binary -translation binary
    set data [read $fin]
    close $fin
    image create photo gif
    gif put white -to 0 0 $::largeur $::hauteur
    set ln 0
    foreach ligne [split $data \x80] {
        set segblanc 0
        set segnoir 0
        set lg 0
        foreach octet [split $ligne {}] {
            if { $segblanc } {
                incr lg [expr [scan $octet %c] * 5]
                set segblanc 0
            } elseif { $segnoir } {
                set qte [expr [scan $octet %c] * 5]
                set ori $lg
                incr lg $qte
                gif put black -to $ori $ln $lg $ln
                set segnoir 0
            } elseif {[string match \x10 $octet]} {
                set segblanc 1
            } elseif {[string match \x20 $octet]} {
                set segnoir 1
            } else {
                foreach p [pixel $octet] {
                    if {$p} {
                        gif put black -to $lg $ln
                    }
                    incr lg
                }
            }
        }
        incr ln
    }
 }
 
 proc gif2rle { fichier } {
    image create photo rle -file $fichier
    set data [ascii rle]
    set RES ""
    foreach ligne $data {
        append RES [compress $ligne]
    }
    set fout [open [file rootname $fichier].rle w]
    fconfigure $fout -encoding binary -translation binary
    puts -nonewline $fout $RES
    close $fout
 }
 
 proc compress { ligne } {
    if {[string first 1 $ligne] == -1} {
        return \x80
    } else {
        set PAT ""
        set occ 1
        set RES ""
        while {[string length $ligne]} {
            if {[string first 1 $ligne] == -1} {
                set ligne ""
            } elseif {[string first 1 $ligne] > 70} {
                if {[string length $PAT]} {
                    append RES [octet $PAT $occ]
                }
                set PAT ""
                set occ 1
                append RES \x10
                set ind [expr [string first 1 $ligne]-([string first 1 $ligne]%5)]
                if { $ind == 640 } {
                    set ind 635
                } elseif { $ind > 1275 } {
                    set ind 1275
                }
                set ligne [string range $ligne $ind end]
                eval append RES \\x[format %x [expr int($ind / 5)]]
            } elseif {[string first 0 $ligne] > 70} {
                if {[string length $PAT]} {
                    append RES [octet $PAT $occ]
                }
                set PAT ""
                set occ 1
                append RES \x20
                set ind [expr [string first 0 $ligne]-([string first 0 $ligne]%5)]
                if { $ind == 640 } {
                    set ind 639
                } elseif { $ind > 1275 } {
                    set ind 1275
                }
                set ligne [string range $ligne $ind end]
                eval append RES \\x[format %x [expr int($ind / 5)]]
            } else {
                set pat [string range $ligne 0 4]
                set ligne [string range $ligne 5 end]
                if {[string match $pat $PAT] && $occ < 7} {
                    incr occ
                } else {
                    if {[string length $PAT]} {
                        append RES [octet $PAT $occ]
                    }
                    set PAT $pat
                    set occ 1
                }
            }
        }
        if {[string length $PAT]} {
            append RES [octet $PAT $occ]
        }
        if {[string length $RES]} {
            return ${RES}\x80
        }
    }
 }
 
 proc ascii { image } {
    set res ""
    set ::largeur [image width $image]
    if {[expr $::largeur % 5]} {
        set fl "[string repeat 0 [expr 5 - ( $::largeur % 5)]] "
    } else  {
        set fl " "
    }
    set ::hauteur [image height $image]
    foreach ligne [$image data] {
        foreach p $ligne {
            if { "$p" eq "#000000" } {
                append res 1
            } else {
                append res 0
            }
        }
        append res $fl
    }
    return $res
 }
 
 proc octet { pat occ } {
    switch $occ \
            1 "set N 001" 2 "set N 010" 3 "set N 011" 4 "set N 100" \
            5 "set N 101" 6 "set N  110" 7 "set N  111"
    return [binary format B8 ${pat}${N}]
 }
 
 proc pixel { octet } {
    binary scan $octet B8 res
    set pat [string range $res 0 4]
    set occ [string range $res 5 7]
    switch $occ \
            001 "set N 1" 010 "set N 2" 011 "set N 3" 100 "set N 4" \
            101 "set N 5" 110 "set N  6" 111 "set N  7"
    return [split [string repeat $pat $N] {}]
 }

----
[Category Compression]