Keith Vetter 2016-05-25 : here's another utility I wrote a while ago that I thought I'd share here. It's a command line utility that displays the size of images, regardless of image type and not requiring Tk. It's similar to ImageMagick's
identify -format "%i [%m] %w x %h\n img.png' but it's more lightweight and has better handling of filenames. For example, if you invoke it without any arguments, it will find all the image files in the current directory.
% imgSizes
chevrons.xbm [xbm] : 14 x 9
klimb.bmp [bmp] : 50 x 50
logo3.png [png] : 532 x 532
me.jpg [jpg] : 1,024 x 683
quito.jpg [jpg] : 922 x 691
sample.webp [webp] : 256 x 22
seascape.jpg [jpg] : 1,024 x 683
t_and_e.jpg [jpg] : 691 x 922
test.png [png] : 566 x 611
##+##########################################################################
#
# imgSizes.tsh -- command line tool for listing image sizes
# by Keith Vetter, October 28, 2005
#
package require jpeg
package require png
package require tiff
proc GetSize {fname} {
if {[file size $fname] == 0} {return [list $fname - -]}
set bestGuess "try[string tolower [file extension $fname]]"
foreach itype [concat $bestGuess [info procs try.*]] {
if {[info procs $itype] eq ""} continue
set try [$itype $fname]
if {$try ne {}} { return $try }
}
return {? - -}
}
proc try.jpg {fname} {
if {! [::jpeg::isJPEG $fname]} { return {} }
return [concat jpg [::jpeg::dimensions $fname]]
}
proc try.png {fname} {
if {! [::png::isPNG $fname]} { return {} }
array set P [::png::imageInfo $fname]
return [list png $P(width) $P(height)]
}
proc try.tiff {fname} {
if {! [::tiff::isTIFF $fname]} { return {} }
lassign [::tiff::dimensions $fname] w h
return [list tiff $w $h]
}
proc try.gif {fname} {
# http://wiki.tcl.tk/758
set data [ReadN $fname 10]
set sig [string toupper [string range $data 0 5]]
if {$sig ne "GIF87A" && $sig ne "GIF89A"} { return {} }
binary scan [string range $data 6 7] s width
binary scan [string range $data 8 9] s height
return [list gif $width $height]
}
proc try.ico {fname} {
# Note, may contain multiple images so we return a list of sizes
set f [open $fname r]
fconfigure $f -encoding binary -translation binary
binary scan [read $f 6] sss zero type numImages
if {$zero != 0 || ($type != 1 && $type != 2)} { close $f ; return {} }
set d {}
for {set i 0} {$i < $numImages} {incr i} {
set idata [read $f 16]
binary scan $idata cc w h
if {$w == 0} {set w 256}
if {$h == 0} {set h 256}
append d "${w}x$h "
}
close $f
return [list ico $d ?]
}
proc try.ppm {fname} {
# see http://netpbm.sourceforge.net/doc/ppm.html
set data [ReadN $fname 256]
set magic [string range $data 0 2]
if {! [regexp {^P6\s$} $magic]} { return {} }
set n [regexp {^P6\s+(\d+)\s+(\d+)} $data . width height]
if {! $n} { error "bad ppm format" }
return [list ppm $width $height]
}
proc try.xbm {fname} {
# see https://en.wikipedia.org/wiki/X_PixMap#Comparison_with_other_formats
set data [ReadN $fname 256]
set n1 [regexp -line {^\s*\#define\s+[a-zA-Z_09]+_width\s+(\d+)} $data . width]
set n2 [regexp -line {^\s*\#define\s+[a-zA-Z_09]+_height\s+(\d+)} $data . height]
if {! $n1 || ! $n2} { return {} }
return [list xbm $width $height]
}
proc try.bmp {fname} {
# see https://en.wikipedia.org/wiki/BMP_file_format
set data [ReadN $fname 26]
if {[string range $data 0 1] ne "BM"} { return {} }
binary scan [string range $data 18 21] i width
binary scan [string range $data 22 25] i height
return [list bmp $width $height]
}
##+##########################################################################
#
# Webp (weppy)
#
# gallery
# =======
# http://news.cnet.com/8301-1023_3-57580664-93/facebook-tries-googles-webp-image-format-users-squawk/
#
# File Format
# ===========
# https://developers.google.com/speed/webp/docs/riff_container
# VP8 :
# VP8L : https://gerrit.chromium.org/gerrit/gitweb?p=webm/libwebp.git;a=blob;f=doc/webp-lossless-bitstream-spec.txt;hb=master
proc try.webp {fname} {
set data [ReadN $fname 30]
set chunk0 [string range $data 0 11]
set chunk1 [string range $data 12 end]
binary scan $chunk0 "a4ia4" riff size id
if {$riff ne "RIFF" || $id ne "WEBP"} {return {}}
binary scan $chunk1 "a4" vp8
if {$vp8 eq "VP8L"} { return [webp.VP8L $chunk1]}
# We're assuming start code block starts 11 bytes into the VP8 chunk
binary scan $chunk1 "a4cu7cu3cu2cu2" vp8 . startCode widthInfo heightInfo
if {$vp8 ne "VP8 "} { error "unknown VP8 block" }
lassign $startCode b0 b1 b2
if {$b0 != 0x9d || $b1 != 0x01 || $b2 != 0x2a} {
error "missing start code block"
}
set horizScale [expr {[lindex $widthInfo 1] >> 6}]
lset widthInfo 1 [expr {[lindex $widthInfo 1] & 0x3f}]
set vertScale [expr {[lindex $heightInfo 1] >> 6}]
lset heightInfo 1 [expr {[lindex $heightInfo 1] & 0x3f}]
binary scan [binary format cu2cu2 $widthInfo $heightInfo] tt width height
return [list webp $width $height]
}
proc webp.VP8L {chunk1} {
binary scan $chunk1 a4icucu4 vp8 size signature sizeInfo
if {$signature != 0x2f} {
error "bad VP8L signature byte: $signature"
}
lassign $sizeInfo b0 b1 b2 b3
# 10001111000000010100101100010000
# 10001111 00000001 01001011 00010000
# 10001111.000000 01.01001011.0001 0000
# 10001111.000000 1.01001011.0001
# 1_webp_ll.webp
# width: 400px 110001111
# height: 301px 100101100
# 2_webp_ll.webp
# 386x295
set width [expr {1 + ($b0 << 6) + ($b1 >> 2)}]
set height [expr {1 + ($b1 << 12) + ($b2 << 4) + ($b3 >> 4)}]
return [list webp $width $height]
}
proc commify number {regsub -all {\d(?=(\d{3})+($|\.))} $number {\0,}}
proc ReadN {fname n} {
set fin [open $fname rb]
set data [read $fin $n]
close $fin
return $data
}
if {$argv == {}} {
set argv [list *.gif *.jpg *.jpeg *.png *.ico *.webp *.bmp *.tiff *.tif *.ppm *.xbm]
}
set fnames {}
set longestName 0
foreach arg $argv {
regsub -all {\\} $arg {/} arg
foreach fname [glob -nocomplain $arg] {
if {! [file isfile $fname]} continue
lappend fnames $fname
set longestName [expr {max($longestName, 2 + [string length $fname])}]
}
}
if {$tcl_interactive} return
foreach fname [lsort -dictionary $fnames] {
set sizes [GetSize $fname]
lassign $sizes itype w h
set type " \[$itype\]"
if {$itype eq "ico"} {
puts [format "%-*s%s : %s" $longestName $fname $type $w]
} else {
puts [format "%-*s%s : %s x %s" $longestName $fname $type [commify $w] [commify $h]]
}
}
exit
