PCX2GIF

2007-05-18 VI PCX is an image format used by old versions of paintbrush. http://courses.ece.uiuc.edu/ece390/books/labmanual/graphics-pcx.html and http://www.qzx.com/pc-gpe/pcx.txt are good references.

This proc just takes 2 filenames, an input pcx and an output gif filename. Requires just Tcl and Tk. I have tested it only for 8-bitsperpixel though there is code for 1,2 and 4 bits per pixel

e.g.

 pcx2gif P2007_0517_1042.pcx PQ.gif

 proc scan1 {fi} { binary scan [read $fi 1] c val; return [expr {$val & 0xFF}] }
 proc scan2 {fi} { binary scan [read $fi 2] s val; return [expr {$val & 0xFFFF}] }

 proc pcx2gif {pcxfn giffn} {
    set header {
        manufacturer 1
        version      1
        encoding     1
        bitsperpixel 1
        xmin         2
        ymin         2
        xmax         2
        ymax         2
        horizdpi     2
        vertdpi      2
        palette     48
        rsvd1        1
        colorplanes  1
        bytesperline 2
        palettetype  2
        hscrsize     2
        vscrsize     2
        filler      54
    }
    set fi [open $pcxfn r]
    fconfigure $fi -translation binary

    foreach {name len} $header {
        switch $len {
            1 {set pcx($name) [scan1 $fi]}
            2 {set pcx($name) [scan2 $fi]}
            default {set pcx($name) [read $fi $len]}
        }
    }

    if {$pcx(manufacturer) != 10 } {error "Manufacturer is not 1"}
    if {$pcx(encoding) != 1} {error "Encoding is not 1"}
    switch $pcx(bitsperpixel) {
        1 {set p2c(0) \#000000;set p2c(1) \#FFFFFF}
        2 - 4 {
            if {$pcx(bitsperpixel) == 2} {
                set bytes 12
            } else {
                set bytes 48
            }
            binary scan $pcx(palette) c$bytes l
            set i 0
            foreach {r g b} $l {
                set p2c($i) [format "#%02X%02X%02X" $r $g $b]
                incr i
            }
        }
        8 {
            set pos [tell $fi]
            seek $fi -769 end
            if {[scan1 $fi] != 12} {
                error "No palette found"
            } 
            for {set i 0} {$i < 256} {incr i} {
                set p2c($i) [format "#%02X%02X%02X" [scan1 $fi] [scan1 $fi] [scan1 $fi]]
            }
            seek $fi $pos
        }
    }

    set image [list]
    for {set row $pcx(ymin)} {$row <= $pcx(ymax)} {incr row} {
        set line [list]
        for {set col $pcx(xmin)} {$col <= $pcx(xmax)} {incr col} {
            set c [scan1 $fi]
            if {$c >= 192} {                #found length byte 
                set len [expr $c & 0x3F]
                set pxl $p2c([scan1 $fi])
                for {set i 0} {$i < $len} {incr i} {
                    lappend line $pxl
                    incr col
                }
                incr col -1
            } else {
                lappend line $p2c($c)
            }
        }
        lappend image $line
    }

    image create photo pic -height [expr $pcx(ymax) - $pcx(ymin) + 1] \
        -width [expr $pcx(xmax) - $pcx(ymin) + 1]
    pic put $image
    pic write $giffn -format gif
 }