1 2# JStrack copyright does NOT belong on this file (see next comment). 3 4# This code is an example I found on the Wiki (http://mini.net/tcl/757). 5 6proc jpg_xy {filename} { 7 8 # open the file 9 set img [open $filename r+] 10 # set to binary mode - VERY important 11 fconfigure $img -translation binary 12 13 # read in first two bytes 14 binary scan [read $img 2] "H4" byte1 15 # check to see if this is a JPEG, all JPEGs start with "ffd8", make 16 # that SHOULD start with 17 if {$byte1!="ffd8"} { 18 puts "Error! $filename is not a valid JPEG file!" 19 exit 20 } 21 22 # cool, it's a JPG so let's loop through the whole file until we 23 # find the next marker. 24 while { ![eof $img]} { 25 while {$byte1!="ff"} { 26 binary scan [read $img 1] "H2" byte1 27 } 28 29 # we found the next marker, now read in the marker type byte, 30 # throw out any extra "ff"'s 31 while {$byte1=="ff"} { 32 binary scan [read $img 1] "H2" byte1 33 } 34 35 # if this the the "SOF" marker then get the data 36 if { ($byte1>="c0") && ($byte1<="c3") } { 37 # it is the right frame. read in a chunk of data containing the 38 # dimensions. 39 binary scan [read $img 7] "x3SS" height width 40 # return the dimensions in a list 41 return [list $width $height] 42 } else { 43 44 # this is not the the "SOF" marker, read in the offset of the 45 # next marker 46 binary scan [read $img 2] "S" offset 47 # the offset includes its own two bytes so we need to subtract 48 # them 49 set offset [expr $offset -2] 50 # move ahead to the next marker 51 seek $img $offset current 52 } ;# end else 53 54 } ;# end while 55 # we didn't find an "SOF" marker, return zeros for error detection 56 set height 0 57 set width 0 58 return [list $width $height] 59 60} ;# end proc 61 62