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