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 } ----