proc pngsize {filename} {
if {[file size $filename] < 33} {
error "File $filename not large enough to contain PNG header"
}
set f [open $filename r]
fconfigure $f -encoding binary -translation binary
# Read PNG file signature
binary scan [read $f 8] c8 sig
foreach b1 $sig b2 {-119 80 78 71 13 10 26 10} {
if {$b1 != $b2} {
close $f
error "$filename is not a PNG file"
}
}
# Read IHDR chunk signature
binary scan [read $f 8] c8 sig
foreach b1 $sig b2 {0 0 0 13 73 72 68 82} {
if {$b1 != $b2} {
close $f
error "$filename is missing a leading IHDR chunk"
}
}
# Read off the size of the image
binary scan [read $f 8] II width height
# Ignore the rest of the data, including the chunk CRC!
#binary scan [read $f 5] ccccc depth type compression filter interlace
#binary scan [read $f 4] I chunkCRC
close $f
return [list $width $height]
}See also "Reading GIF image dimensions", "CRC", and "Reading JPEG image dimensions".AM Also see Writing PNG files for sample code to write a PNG file - precursor for a package to be ... :)
AF I accidentally duplicated this, but mine is somewhat shorter and returns all of the image info:
proc read_png_header {file} {
set fh [open $file r]
fconfigure $fh -encoding binary -translation binary -eofchar {}
if {[read $fh 8] != "\x89PNG\r\n\x1a\n"} { close $fh; return }
binary scan [read $fh 8] Ia4 len type
set r [read $fh $len]
if {![eof $fh] && $type == "IHDR"} {
binary scan $r IIccccc width height depth color compression filter interlace
close $fh
return [list $width $height $depth $color $compression $filter $interlace]
}
close $fh
return
}This functionality is also present in the tcllib png module.
