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
 }