diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/jpeg | |
parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/jpeg')
34 files changed, 2123 insertions, 0 deletions
diff --git a/tcllib/modules/jpeg/ChangeLog b/tcllib/modules/jpeg/ChangeLog new file mode 100644 index 0000000..f15eb1c --- /dev/null +++ b/tcllib/modules/jpeg/ChangeLog @@ -0,0 +1,197 @@ +2013-11-07 Andreas Kupries <andreask@activestate.com> + + * testimage/1000.JPG: Ticket [1d2b62d10d] followup. + * testimage/1000.exif.txt: Extended testsuite with an + * testimage/1000.thumbexif.txt: example image missing the + thumbnail and triggering the issue. With thanks to + aldo.w.buratti@gmail.com for donating the image. + +2013-10-30 Andreas Kupries <andreask@activestate.com> + + * testimage/IMG_7950_dt.JPG: Ticket [1d2b62d10d] followup. + * testimage/IMG_7950_dt.exif.txt: Extended testsuite with + * testimage/IMG_7950_dt.thumbexif.txt: example image missing any + embedded exif information (Not triggering the issue). Made + testsuite 8.4+ and converted to tcltest 2 format. + +2013-10-28 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * jpeg.tcl: Ticket [1d2b62d10d]: Fixed unwanted double-close of + * jpeg.man: channel when accessing a non-existing thumbnail in a + * pkgIndex.tcl: file. Introduced by the refactoring. Bumped + version to 0.5. Thanks to Aldo Buratti for the report. + +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-05-06 Pat Thoyts <patthoyts@users.sourceforge.net> + + * jpeg.tcl: Refactored the getExif function into two parts with + * pkgIndex.tcl: one that operates on a previously opened + * jpeg.man: channel. This means it can be used with other channel + * jpeg.test: implementations such as memchan or embedded + streams. Updated the documentation and version. + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2009-06-05 Andreas Kupries <andreask@activestate.com> + + * jpeg.tcl (::jpeg::exif): Accepted (with slight changes) and + * pkgIndex.tcl: applied patch by Matt Plumlee <mdplumlee@users.sourceforge.net> + * jpeg.man: to parse GPS data in the EXIF block. Bumped the + package to version 0.3.5. This fixes [Bug 2801896]. + + * jpeg.man: Added binary settings to the thumbnail example. This + fixes [Bug 2801587]. + +2009-03-02 Andreas Kupries <andreask@activestate.com> + + * jpeg.tcl (::jpeg::imageInfo): Accepted and applied patch by + * pkgIndex.tcl: Mikhail Teterin <kot@users.sourceforge.net> to + * jpeg.man: have imageInfo open the image only for reading. Bumped + to version 0.3.4. This fixes [Bug 2646568]. + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2008-06-14 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * jpeg.pcx: New file. Syntax definitions for the public commands + of the jpeg package. + +2008-03-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * jpeg.tcl (::jpeg::getExif): Added check to reject bad section + * jpeg.man: types outside of {main, thumbnail}. Bumped version to + * pkgIndex.tcl: 0.3.3 + + * jpeg.test: Added testsuite and example images for it. + * testimages/IMG_7898.JPG: + * testimages/IMG_7898.JPG.thumb: + * testimages/IMG_7898.exif.txt: + * testimages/IMG_7898.thumbexif.txt: + * testimages/IMG_7917.JPG: + * testimages/IMG_7917.JPG.thumb: + * testimages/IMG_7917.exif.txt: + * testimages/IMG_7917.thumbexif.txt: + * testimages/IMG_7950.JPG: + * testimages/IMG_7950.JPG.thumb: + * testimages/IMG_7950.exif.txt: + * testimages/IMG_7950.thumbexif.txt: + +2008-1-10 Aaron Faupell <afaupell@users.sourceforge.net> + + * jpeg.tcl: fix for bug 1868088 "Integer value too large to + represent" in MaxAperture arm of formatExif. Bumped version to + 0.3.2 + +2007-11-20 Andreas Kupries <andreask@activestate.com> + + * jpeg.tcl (::jpeg::stripJPEG): Fixed encoding bug reported by + * pkgIndex.tcl: Martin Lemburg on news:clt, and solved by Ohtsuka + * jpeg.man: Yoshio. The output file was not set to binary, + breaking the jpeg data written to it. Bumped version to 0.3.1. + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * jpeg.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-09-19 Andreas Kupries <andreask@activestate.com> + + * jpeg.man: Bumped version to 0.3 + * jpeg.tcl: + * pkgIndex.tcl: + +2005-12-15 Aaron Faupell <afaupell@users.sourceforge.net> + + * jpeg.tcl fixed bug in removeComments and removeExif + where file was opened and not configured as binary + +2005-11-10 Aaron Faupell <afaupell@users.sourceforge.net> + + * Added support for non-baseline and progressive files by + accepting c0-3 for SOF marker + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-04-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * jpeg.man: Synchronized indexed vs provided versions. + * pkgIndex.tcl: + +2005-04-01 Aaron Faupell <afaupell@users.sourceforge.net> + + * jpeg.tcl: added comments, bumped version number because of + potential incompatibility due to inverting the return value + of isJPEG. + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-10-05 Andreas Kupries <andreask@activestate.com> + + * jpeg.tcl: Accepted last-minute fixes from Aaron in the exif + decoder code. + +2004-08-16 Aaron Faupell <afaupell@users.sourceforge.net> + + * jpeg.tcl: added commands isJPEG, stripJPEG, formatExif, exifKeys + * jpeg.man: updated for new commands, new examples + +2004-05-26 Aaron Faupell <afaupell@users.sourceforge.net> + + * jpeg.tcl: rewritten/factored + * jpeg.man: updated + +2004-05-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * New module for querying JPEG images, and manipulating their + comments. diff --git a/tcllib/modules/jpeg/jpeg.man b/tcllib/modules/jpeg/jpeg.man new file mode 100644 index 0000000..2661cbd --- /dev/null +++ b/tcllib/modules/jpeg/jpeg.man @@ -0,0 +1,196 @@ +[manpage_begin jpeg n 0.5] +[keywords comment] +[keywords exif] +[keywords image] +[keywords jfif] +[keywords jpeg] +[keywords thumbnail] +[copyright {2004-2005, Code: Aaron Faupell <afaupell@users.sourceforge.net>}] +[copyright {2007, Code: Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[copyright {2004-2009, Doc: Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[copyright {2011, Code: Pat Thoyts <patthoyts@users.sourceforge.net>}] +[moddesc {JPEG image manipulation}] +[titledesc {JPEG querying and manipulation of meta data}] +[category {File formats}] +[require Tcl 8.2] +[require jpeg [opt 0.5]] +[description] +[para] + +This package provides commands to query and modify JPEG images. JPEG +stands for [term {Joint Photography Experts Group}] and is a standard +for the lossy compression of photographical images. It is specified at +[uri LINK_HERE]. + +[section COMMANDS] +[list_begin definitions] + +[call [cmd ::jpeg::isJPEG] [arg file]] + +Returns a boolean value indicating if [arg file] is a +JPEG image. + +[call [cmd ::jpeg::imageInfo] [arg file]] + +Returns a dictionary with keys [const version], [const units], +[const xdensity], [const ydensity], [const xthumb], and +[const ythumb]. The values are the associated properties of the JPEG +image in [arg file]. + +Throws an error if [arg file] is not a JPEG image. + +[call [cmd ::jpeg::dimensions] [arg file]] + +Returns the dimensions of the JPEG [arg file] as a list of the +horizontal and vertical pixel count. + +Throws an error if [arg file] is not a JPEG image. + +[call [cmd ::jpeg::getThumbnail] [arg file]] + +This procedure will return the binary thumbnail image data, if a JPEG +thumbnail is included in [arg file], and the empty string +otherwise. Note that it is possible to include thumbnails in formats +other than JPEG although that is not common. The command finds +thumbnails that are encoded in either the JFXX or EXIF segments of the +JPEG information. If both are present the EXIF thumbnail will take precedence. + +Throws an error if [arg file] is not a JPEG image. + +[example { + set fh [open thumbnail.jpg w+] + fconfigure $fh -translation binary -encoding binary + puts -nonewline $fh [::jpeg::getThumbnail photo.jpg] + close $fh +}] + +[call [cmd ::jpeg::getExif] [arg file] [opt [arg section]]] + +[arg section] must be one of [const main] or [const thumbnail]. +The default is [const main]. + +Returns a dictionary containing the EXIF information for the specified section. + +For example: +[para] +[example { + set exif { + Make Canon + Model {Canon DIGITAL IXUS} + DateTime {2001:06:09 15:17:32} + } +}] + +Throws an error if [arg file] is not a JPEG image. + +[call [cmd ::jpeg::getExifFromChannel] [arg channel] [opt [arg section]]] + +This command is as per [cmd ::jpeg::getExif] except that it uses a +previously opened channel. [arg channel] should be a seekable channel +and [arg section] is as described in the documentation of +[cmd ::jpeg::getExif]. + +[para][emph Note]: The jpeg parser expects that the start of the +channel is the start of the image data. If working with an image +embedded in a container file format it may be necessary to read the +jpeg data into a temporary container: either a temporary file or a +memory channel. + +[para][emph Attention]: It is the resonsibility of the caller to close +the channel after its use. + + +[call [cmd ::jpeg::formatExif] [arg keys]] + +Takes a list of key-value pairs as returned by [cmd getExif] and formats +many of the values into a more human readable form. As few as one key-value +may be passed in, the entire exif is not required. + +[example { + foreach {key val} [::jpeg::formatExif [::jpeg::getExif photo.jpg]] { + puts "$key: $val" + } +}] +[para] +[example { + array set exif [::jpeg::getExif photo.jpg] + puts "max f-stop: [::jpeg::formatExif [list MaxAperture $exif(MaxAperture)]] +}] + +[call [cmd ::jpeg::exifKeys]] + +Returns a list of the EXIF keys which are currently understood. +There may be keys present in [cmd getExif] data that are not understood. +Those keys will appear in a 4 digit hexadecimal format. + +[call [cmd ::jpeg::removeExif] [arg file]] + +Removes the Exif data segment from the specified file and replaces +it with a standard JFIF segment. + +Throws an error if [arg file] is not a JPEG image. + +[call [cmd ::jpeg::stripJPEG] [arg file]] + +Removes all metadata from the JPEG file leaving only +the image. This includes comments, EXIF segments, JFXX +segments, and application specific segments. + +Throws an error if [arg file] is not a JPEG image. + +[call [cmd ::jpeg::getComments] [arg file]] + +Returns a list containing all the JPEG comments found in +the [arg file]. + +Throws an error if [arg file] is not a valid JPEG image. + +[call [cmd ::jpeg::addComment] [arg file] [arg text]...] + +Adds one or more plain [arg text] comments to the JPEG image +in [arg file]. + +Throws an error if [arg file] is not a valid JPEG image. + +[call [cmd ::jpeg::removeComments] [arg file]] + +Removes all comments from the file specified. + +Throws an error if [arg file] is not a valid JPEG image. + +[call [cmd ::jpeg::replaceComment] [arg file] [arg text]] + +Replaces the first comment in the file with the new [arg text]. +This is merely a shortcut for [cmd ::jpeg::removeComments] +and [cmd ::jpeg::addComment] + +Throws an error if [arg file] is not a valid JPEG image. + +[call [cmd ::jpeg::debug] [arg file]] + +Prints everything we know about the given file in a nice format. + +[call [cmd ::jpeg::markers] [arg channel]] + +This is an internal helper command, we document it for use by advanced +users of the package. The argument [arg channel] is an open file +handle positioned at the start of the first marker (usually 2 +bytes). The command returns a list with one element for each JFIF +marker found in the file. Each element consists of a list of the +marker name, its offset in the file, and its length. The offset points +to the beginning of the sections data, not the marker itself. The +length is the length of the data from the offset listed to the start +of the next marker. + +[list_end] + +[section LIMITATIONS] + +can only work with files +cant write exif data +gps exif data not parsed +makernote data not yet implemented + +[vset CATEGORY jpeg] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/jpeg/jpeg.pcx b/tcllib/modules/jpeg/jpeg.pcx new file mode 100644 index 0000000..4b626c1 --- /dev/null +++ b/tcllib/modules/jpeg/jpeg.pcx @@ -0,0 +1,83 @@ +# -*- tcl -*- jpeg.pcx +# Syntax of the commands provided by package jpeg. +# +# For use by TclDevKit's static syntax checker (v4.1+). +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the specification of the format of the code in this file. +# + +package require pcx +pcx::register jpeg +pcx::tcldep 0.3.2 needs tcl 8.2 + +namespace eval ::jpeg {} + +#pcx::message FOO {... text ...} type +#pcx::scan <VERSION> <NAME> <RULE> + +pcx::check 0.3.2 std ::jpeg::addComment \ + {checkSimpleArgs 2 -1 { + checkFileName + checkWord + }} +pcx::check 0.3.2 std ::jpeg::debug \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::dimensions \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::exifKeys \ + {checkSimpleArgs 0 0 {}} +pcx::check 0.3.2 std ::jpeg::formatExif \ + {checkSimpleArgs 1 1 { + checkDict + }} +pcx::check 0.3.2 std ::jpeg::getComments \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::getExif \ + {checkSimpleArgs 1 2 { + checkFileName + {checkKeyword 1 {main thumbnail}} + }} +pcx::check 0.3.2 std ::jpeg::getThumbnail \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::imageInfo \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::isJPEG \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::markers \ + {checkSimpleArgs 1 1 { + checkChannelID + }} +pcx::check 0.3.2 std ::jpeg::removeComments \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::removeExif \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.3.2 std ::jpeg::replaceComment \ + {checkSimpleArgs 2 2 { + checkFileName + checkWord + }} +pcx::check 0.3.2 std ::jpeg::stripJPEG \ + {checkSimpleArgs 1 1 { + checkFileName + }} + +# Initialization via pcx::init. +# Use a ::jpeg::init procedure for non-standard initialization. +pcx::complete diff --git a/tcllib/modules/jpeg/jpeg.tcl b/tcllib/modules/jpeg/jpeg.tcl new file mode 100644 index 0000000..0c37f90 --- /dev/null +++ b/tcllib/modules/jpeg/jpeg.tcl @@ -0,0 +1,1125 @@ +# jpeg.tcl -- +# +# Querying and modifying JPEG image files. +# +# Copyright (c) 2004 Aaron Faupell <afaupell@users.sourceforge.net> +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: jpeg.tcl,v 1.19 2011/05/06 13:39:27 patthoyts Exp $ + +# ### ### ### ######### ######### ######### +## Requisites + +namespace eval ::jpeg {} + +# ### ### ### ######### ######### ######### +## Notes :: Structure of jpeg files. + +# Base types +# +# BYTE = 1 byte +# SHORT = 2 bytes, endianess determined by context. +# BESHORT = 2 bytes, big endian +# INT = 4 bytes, endianess determined by context. + +# JPEG types +# +# JPEG = < +# BYTE [2] == 0xFF 0xD8 (SOI (Start Of Image)) +# JSEGMENT [.] 1 or more jpeg segments, variadic size +# BYTE [2] == 0xFF 0xD9 (EOI (End Of Image)) +# > +# +# JSEGMENT = < +# BYTE [1] == 0xFF +# BYTE [1] Segment Tag, type marker +# BESHORT [1] Segment Length N +# BYTE [N-2] Segment Data, interpreted dependent on tag. +# > +# +# Notable segments, and their structure. +# +# Comment = JSEGMENT (Tag = 0xFE, Data = < +# +# >) + + +# Type 0xFE (Comment) +# Data BYTE [ ] +# Note: Multiple comment segments are allowed. + +# Type 0xC0/0xC1/0xC2/0xC3 (Start of Frame) +# Data BYTE [1] Precision +# BESHORT [1] Height +# BESHORT [1] Width +# BYTE [1] Number of color components +# ... + +# Type 0xEx (x=0-9A-F) (App0 - App15) +# Data It is expected that the data starts with a checkable marker, as +# the app segments can be used by multiple applications for +# different purposes. I.e. a sub-type is needed before the +# segment data can be processed. + +# App0/JFIF image info +# Type 0xE0 +# Data BYTE [5] 'JFIF\0' JFIF sub-type marker +# BYTE [1] Version1 (major) +# BYTE [1] Version2 (minor) +# BYTE [1] Units +# BESHORT [1] X-density (dots per inch ?) +# BESHORT [1] Y-density +# BYTE [1] X-thumb (Width of thumbnail, if any, or zero) +# BYTE [1] Y-thumb (Height of thumbnail, if any, or zero) + +# App0/JFXX extended image information +# Type 0xE0 +# Data BYTE [5] 'JFXX\0' JFXX sub-type marker +# BYTE [1] Extension code 10 -> JPEG thumbnail +# 11 -> Palletized thumbnail +# 13 -> RGB thumbnail +# BYTE [ ] Data per the extension code. + +# App1/EXIF +# Type 0xE1 +# Data BYTE [6] 'Exif\0\0' EXIF sub-type marker. (1) +# BYTE [2] Byte Order 0x4d 0x4d = big endian +# or 0x49 0x49 = small endian +# SHORT [1] Magic == 42 under the specified byteorder. +# INT [1] Next == Offset to the first actual EXIF data block. +# +# EXIF data block structure (IFD = Image File Directory) +# +# 1. SHORT [1] Number N of exif entries +# 2. ENTRY [N] Array of exif entries +# 3. INT [1] Offset to the next EXIF data block, or <0 for the last block. +# + +# exif ENTRY structure +# +# 1. SHORT [1] num +# 2. SHORT [1] tag = exif key +# 3. SHORT [1] format +# 4. INT [1] component +# 5. INT [1] value + +# The 'value is interpreted dependent on the values of tag, format, +# and component. +# +# A. Tag in ( 0x8769, 0xA005 ) +# Value is offset to a subordinate exif data block, process recursively. +# B. Size = components * sizeof(format) +# B1. Size > 4 +# Value is offset to the actual value. +# B2. Size <= 4 +# Value is the actual value. + +# Usually a jpeg with exif information has two exif data blocks. The +# first is the main block, the second the thumbnail block. +# +# Note that all the exif data structures are within the app1/exif +# segment. +# +# (1) The offset of the first byte after the exif marker is what all +# the offsets in exif are relative to. + +# Type 0xDA (SOS, Start of Stream/Scan) +# Followed by the JPEG data. Last segment before EOI + +# ### ### ### ######### ######### ######### + +# open a file, check jpeg signature, and a return a file handle +# at the start of the first marker +proc ::jpeg::openJFIF {file {mode r}} { + set fh [open $file $mode] + fconfigure $fh -encoding binary -translation binary -eofchar {} + # jpeg sig is FFD8, FF is start of first marker + if {[read $fh 3] != "\xFF\xD8\xFF"} { close $fh; return -code error "not a jpg file" } + # rewind to first marker + seek $fh -1 current + return $fh +} + +# return a boolean indicating if a file starts with the jpeg sig +proc ::jpeg::isJPEG {file} { + set is [catch {openJFIF $file} fh] + catch {close $fh} + return [expr {!$is}] +} + +# takes an open filehandle at the start of a jpeg marker, and returns a list +# containing information about the file markers in the jpeg file. each list +# element itself a list of the marker type, offset of the start of its data, +# and the length of its data. +proc ::jpeg::markers {fh} { + set chunks [list] + while {[read $fh 1] == "\xFF"} { + binary scan [read $fh 3] H2S type len + # convert to unsigned + set len [expr {$len & 0x0000FFFF}] + # decrement len to account for marker bytes + incr len -2 + lappend chunks [list $type [tell $fh] $len] + seek $fh $len current + } + # chunks = list (list (type offset length) ...) + return $chunks +} + +proc ::jpeg::imageInfo {file} { + set fh [openJFIF $file r] + set data {} + if {[set app0 [lsearch -inline [markers $fh] "e0 *"]] != ""} { + seek $fh [lindex $app0 1] start + set id [read $fh 5] + if {$id == "JFIF\x00"} { + binary scan [read $fh 9] cccSScc ver1 ver2 units xr yr xt yt + set data [list version $ver1.$ver2 units $units xdensity $xr ydensity $yr xthumb $xt ythumb $yt] + } + } + close $fh + return $data +} + +# return an images dimensions by reading the Start Of Frame marker +proc ::jpeg::dimensions {file} { + set fh [openJFIF $file] + set sof [lsearch -inline [markers $fh] {c[0-3] *}] + seek $fh [lindex $sof 1] start + binary scan [read $fh 5] cSS precision height width + close $fh + return [list $width $height] +} + +# returns a list of all comments (FE segments) in the file +proc ::jpeg::getComments {file} { + set fh [openJFIF $file] + set comments {} + foreach x [lsearch -all -inline [markers $fh] "fe *"] { + seek $fh [lindex $x 1] start + lappend comments [read $fh [lindex $x 2]] + } + close $fh + return $comments +} + +# add a new comment to the file +proc ::jpeg::addComment {file comment args} { + set fh [openJFIF $file r+] + # find the SoF and save all data after it + set sof [lsearch -inline [markers $fh] {c[0-3] *}] + seek $fh [expr {[lindex $sof 1] - 4}] start + set data2 [read $fh] + # seek back to the SoF and write comment(s) segment + seek $fh [expr {[lindex $sof 1] - 4}] start + foreach x [linsert $args 0 $comment] { + if {$x == ""} continue + puts -nonewline $fh [binary format a2Sa* "\xFF\xFE" [expr {[string length $x] + 2}] $x] + } + # write the saved data bac + puts -nonewline $fh $data2 + close $fh +} + +proc ::jpeg::replaceComment {file comment} { + set com [getComments $file] + removeComments $file + eval [list addComment $file] [lreplace $com 0 0 $comment] +} + +# removes all comment segments from the file +proc ::jpeg::removeComments {file} { + set fh [openJFIF $file] + set data "\xFF\xD8" + foreach marker [markers $fh] { + if {[lindex $marker 0] != "fe"} { + # seek back 4 bytes to include the marker and length bytes + seek $fh [expr {[lindex $marker 1] - 4}] start + append data [read $fh [expr {[lindex $marker 2] + 4}]] + } + } + append data [read $fh] + close $fh + set fh [open $file w] + fconfigure $fh -encoding binary -translation binary -eofchar {} + puts -nonewline $fh $data + close $fh +} + +# rewrites a jpeg file and removes all metadata (comments, exif, photoshop) +proc ::jpeg::stripJPEG {file} { + set fh [openJFIF $file] + set data {} + + set markers [markers $fh] + # look for a jfif header segment and save it + if {[lindex $markers 0 0] == "e0"} { + seek $fh [lindex $markers 0 1] start + if {[read $fh 5] == "JFIF\x00"} { + seek $fh -9 current + set jfif [read $fh [expr {[lindex $markers 0 2] + 4}]] + } + } + # if we dont have a jfif header (exif files), create a fake one + if {![info exists jfif]} { + set jfif [binary format a2Sa5cccSScc "\xFF\xE0" 16 "JFIF\x00" 1 2 1 72 72 0 0] + } + + # remove all the e* and f* markers (metadata) + foreach marker $markers { + if {![string match {[ef]*} [lindex $marker 0]]} { + seek $fh [expr {[lindex $marker 1] - 4}] start + append data [read $fh [expr {[lindex $marker 2] + 4}]] + } + } + append data [read $fh] + + close $fh + set fh [open $file w+] + fconfigure $fh -encoding binary -translation binary -eofchar {} + # write a jpeg file sig, a jfif header, and all the remaining data + puts -nonewline $fh \xFF\xD8$jfif$data + close $fh +} + +# if file contains a jpeg thumbnail return it. the returned data is the actual +# jpeg data, it can be written directly to a file +proc ::jpeg::getThumbnail {file} { + # check if the exif information contains a thumbnail + array set exif [getExif $file thumbnail] + if {[info exists exif(Compression)] && \ + $exif(Compression) == 6 && \ + [info exists exif(JPEGInterchangeFormat)] && \ + [info exists exif(JPEGInterchangeFormatLength)]} { + set fh [openJFIF $file] + seek $fh [expr {$exif(ExifOffset) + $exif(JPEGInterchangeFormat)}] start + set thumb [read $fh $exif(JPEGInterchangeFormatLength)] + close $fh + return $thumb + } + # check for a JFXX segment which contains a thumbnail + set fh [openJFIF $file] + foreach x [lsearch -inline -all [markers $fh] "e0 *"] { + seek $fh [lindex $x 1] start + binary scan [read $fh 6] a5H2 id excode + # excode 10 is jpeg encoding, we cant interpret the other types + if {$id == "JFXX\x00" && $excode == "10"} { + set thumb [read $fh [expr {[lindex $x 2] - 6}]] + close $fh + return $thumb + } + } + close $fh +} + + +# takes key-value pairs returned by getExif and converts their values into +# human readable format +proc ::jpeg::formatExif {exif} { + variable exif_values + set out {} + foreach {tag val} $exif { + if {[info exists exif_values($tag,$val)]} { + set val $exif_values($tag,$val) + } elseif {[info exists exif_values($tag,)]} { + set val $exif_values($tag,) + } else { + switch -exact -- $tag { + UserComment {set val [string trim [string range $val 8 end] \x00]} + ComponentsConfiguration {binary scan $val cccc a b c d; set val $a,$b,$c,$d} + ExifVersion {set val [expr [string range $val 0 1].[string range $val 2 3]]} + FNumber {set val [format %2.1f $val]} + MaxApertureValue - + ApertureValue { + if {$val > 0} { + set val [format %2.1f [expr {2 * (log($val) / log(2))}]] + } + } + ShutterSpeedValue { + set val [expr {pow(2, $val)}] + if {abs(round($val) - $val) < 0.2} {set val [expr {round($val)}]} + set val 1/[string trimright [string trimright [format %.2f $val] 0] .] + } + ExposureTime { + set val 1/[string trimright [string trimright [format %.4f [expr {1 / $val}]] 0] .] + } + } + } + lappend out $tag $val + } + return $out +} + +# returns a list of all known exif keys +proc ::jpeg::exifKeys {} { + variable exif_tags + set ret {} + foreach {x y} [array get exif_tags] {lappend ret $y} + return $ret +} + +proc ::jpeg::getExif {file {type main}} { + set fh [openJFIF $file] + set r [catch {getExifFromChannel $fh $type} err] + close $fh + return -code $r $err +} + +proc ::jpeg::getExifFromChannel {chan {type main}} { + # foreach because file may have multiple e1 markers + foreach app1 [lsearch -inline -all [markers $chan] "e1 *"] { + seek $chan [lindex $app1 1] start + # check that this e1 is really an Exif segment + if {[read $chan 6] != "Exif\x00\x00"} continue + # save offset because exif offsets are relative to this + set start [tell $chan] + # next 2 bytes determine byte order + binary scan [read $chan 2] H4 byteOrder + if {$byteOrder == "4d4d"} { + set byteOrder big + } elseif {$byteOrder == "4949"} { + set byteOrder little + } else { + return -code error "invalid byte order magic" + } + # the answer is 42, if we have our byte order correct + _scan $byteOrder [read $chan 6] si magic next + if {$magic != 42} { return -code error "invalid byte order"} + + seek $chan [expr {$start + $next}] start + if {$type != "thumbnail"} { + if {$type != "main"} { + return -code error "Bad type \"$type\", expected one of \"main\", or \"thumbnail\"" + } + set data [_exif $chan $byteOrder $start] + } else { + # number of entries in this exif block + _scan $byteOrder [read $chan 2] s num + # each entry is 12 bytes + seek $chan [expr {$num * 12}] current + # offset of next exif block (for thumbnail) + _scan $byteOrder [read $chan 4] i next + if {$next <= 0} { return } + # but its relative to start + seek $chan [expr {$start + $next}] start + set data [_exif $chan $byteOrder $start] + } + lappend data ExifOffset $start ExifByteOrder $byteOrder + return $data + } + return +} + +proc ::jpeg::removeExif {file} { + set fh [openJFIF $file] + set data {} + set markers [markers $fh] + if {[lsearch $markers "e1 *"] < 0} { close $fh; return } + foreach marker $markers { + if {[lindex $marker 0] != "e1"} { + seek $fh [expr {[lindex $marker 1] - 4}] start + append data [read $fh [expr {[lindex $marker 2] + 4}]] + } else { + seek $fh [lindex $marker 1] start + if {[read $fh 6] == "Exif\x00\x00"} continue + seek $fh -10 current + append data [read $fh [expr {[lindex $marker 2] + 4}]] + } + } + append data [read $fh] + close $fh + set fh [open $file w] + fconfigure $fh -encoding binary -translation binary -eofchar {} + puts -nonewline $fh "\xFF\xD8" + if {[lindex $markers 0 0] != "e0"} { + puts -nonewline $fh [binary format a2Sa5cccSScc "\xFF\xE0" 16 "JFIF\x00" 1 2 1 72 72 0 0] + } + puts -nonewline $fh $data + close $fh +} + +proc ::jpeg::_exif2 {data} { + variable exif_tags + set byteOrder little + set start 0 + set i 2 + for {_scan $byteOrder $data @0s num} {$num > 0} {incr num -1} { + binary scan $data @${i}H2H2 t1 t2 + if {$byteOrder == "big"} { + set tag $t1$t2 + } else { + set tag $t2$t1 + } + incr i 2 + _scan $byteOrder $data @${i}si format components + incr i 6 + set value [string range $data $i [expr {$i + 3}]] + if {$tag == "8769" || $tag == "a005"} { + _scan $byteOrder $value i next + #set pos [tell $fh] + #seek $fh [expr {$offset + $next}] start + #eval lappend return [_exif $fh $byteOrder $offset] + #seek $fh $pos start + continue + } + if {![info exists exif_formats($format)]} continue + if {[info exists exif_tags($tag)]} { set tag $exif_tags($tag) } + set size [expr {$exif_formats($format) * $components}] + if {$size > 4} { + _scan $byteOrder $value i value + #puts "$value" + #set value [string range $data [expr {$i + $offset + $value}] [expr {$size - 1}]] + } + lappend ret $tag [_format $byteOrder $value $format $components] + } +} + +# reads an exif block and returns key-value pairs +proc ::jpeg::_exif {fh byteOrder offset {tag_info exif_tags}} { + variable exif_formats + variable exif_tags + variable gps_tags + set return {} + for {_scan $byteOrder [read $fh 2] s num} {$num > 0} {incr num -1} { + binary scan [read $fh 2] H2H2 t1 t2 + _scan $byteOrder [read $fh 6] si format components + if {$byteOrder == "big"} { + set tag $t1$t2 + } else { + set tag $t2$t1 + } + set value [read $fh 4] + # special tags, they point to more exif blocks + if {$tag == "8769" || $tag == "a005"} { + _scan $byteOrder $value i next + set pos [tell $fh] + seek $fh [expr {$offset + $next}] start + eval lappend return [_exif $fh $byteOrder $offset] + seek $fh $pos start + continue + } + # special tag, another exif block holding GPS/location information. + if {$tag == "8825"} { + _scan $byteOrder $value i next + set pos [tell $fh] + seek $fh [expr {$offset + $next}] start + eval lappend return [_exif $fh $byteOrder $offset gps_tags] + seek $fh $pos start + continue + } + if {![info exists exif_formats($format)]} continue + upvar 0 $tag_info thetags + if {[info exists thetags($tag)]} { set tag $thetags($tag) } + set size [expr {$exif_formats($format) * $components}] + # if the data is over 4 bytes, its stored later in the file, with the + # data being the offset relative to the exif header + if {$size > 4} { + set pos [tell $fh] + _scan $byteOrder $value i value + seek $fh [expr {$offset + $value}] start + set value [read $fh $size] + seek $fh $pos start + } + lappend return $tag [_format $byteOrder $value $format $components] + } + return $return +} + +proc ::jpeg::MakerNote {offset byteOrder Make data} { + if {$Make == "Canon"} { + set data [MakerNoteCanon $offset $byteOrder $data] + } elseif {[string match Nikon* $data] || $Make == "NIKON"} { + set data [MakerNoteNikon $offset $byteOrder $data] + } elseif {[string match FUJIFILM* $data]} { + set data [MakerNoteFuji $offset $byteOrder $data] + } elseif {[string match OLYMP* $data]} { + set data [MakerNoteOlympus $offset $byteOrder $data] + } + return $data +} + +proc ::jpeg::MakerNoteNikon {offset byteOrder data} { + variable exif_formats + set return {} + if {[string match Nikon* $data]} { + set i 8 + } else { + set i 0 + } + binary scan $data @8s num + incr i 2 + puts [expr {($num * 12) + $i}] + puts [string range $data 142 150] + #exit + for {} {$num > 0} {incr num -1} { + binary scan $data @${i}H2H2 t1 t2 + if {$byteOrder == "big"} { + set tag $t1$t2 + } else { + set tag $t2$t1 + } + incr i 2 + _scan $byteOrder $data @${i}si format components + incr i 6 + set value [string range $data $i [expr {$i + 3}]] + if {![info exists exif_formats($format)]} continue + #if {[info exists exif_tags($tag)]} { set tag $exif_tags($tag) } + set size [expr {$exif_formats($format) * $components}] + if {$size > 4} { + _scan $byteOrder $value i value + puts "$value" + set value 1 + #set value [string range $data [expr {$i + $offset + $value}] [expr {$size - 1}]] + } else { + + lappend ret $tag [_format $byteOrder $value $format $components] + } + puts "$tag $format $components $value" + } + return $return +} + +proc ::jpeg::debug {file} { + set fh [openJFIF $file] + + puts "marker: d8 length: 0" + puts " SOI (Start Of Image)" + + foreach marker [markers $fh] { + seek $fh [lindex $marker 1] + puts "marker: [lindex $marker 0] length: [lindex $marker 2]" + switch -glob -- [lindex $marker 0] { + c[0-3] { + binary scan [read $fh 6] cSSc precision height width color + puts " SOF (Start Of Frame) [string map {c0 "Baseline" c1 "Non-baseline" c2 "Progressive" c3 "Lossless"} [lindex $marker 0]]" + puts " Image dimensions: $width $height" + puts " Precision: $precision" + puts " Color Components: $color" + } + c4 { + puts " DHT (Define Huffman Table)" + binary scan [read $fh 17] cS bits symbols + puts " $symbols symbols" + } + da { + puts " SOS (Start Of Scan)" + binary scan [read $fh 2] c num + puts " Components: $num" + } + db { + puts " DQT (Define Quantization Table)" + } + dd { + puts " DRI (Define Restart Interval)" + binary scan [read $fh 2] S num + puts " Interval: $num blocks" + } + e0 { + set id [read $fh 5] + if {$id == "JFIF\x00"} { + puts " JFIF" + binary scan [read $fh 9] cccSScc ver1 ver2 units xr vr xt yt + puts " Header: $ver1.$ver2 $units $xr $vr $xt $yt" + } elseif {$id == "JFXX\x00"} { + puts " JFXX (JFIF Extension)" + binary scan [read $fh 1] H2 excode + if {$excode == "10"} { set excode "10 (JPEG thumbnail)" } + if {$excode == "11"} { set excode "11 (Palletized thumbnail)" } + if {$excode == "13"} { set excode "13 (RGB thumbnail)" } + puts " Extension code: 0x$excode" + } else { + puts " Unknown APP0 segment: $id" + } + } + e1 { + if {[read $fh 6] == "Exif\x00\x00"} { + puts " EXIF data" + puts " MAIN EXIF" + foreach {x y} [getExif $file] { + puts " $x $y" + } + puts " THUMBNAIL EXIF" + foreach {x y} [getExif $file thumbnail] { + puts " $x $y" + } + } else { + puts " APP1 (unknown)" + } + } + e2 { + if {[read $fh 12] == "ICC_PROFILE\x00"} { + puts " ICC profile" + } else { + puts " APP2 (unknown)" + } + } + ed { + if {[read $fh 18] == "Photoshop 3.0\0008BIM"} { + puts " Photoshop 8BIM data" + } else { + puts " APP13 (unknown)" + } + } + ee { + if {[read $fh 5] == "Adobe"} { + puts " Adobe metadata" + } else { + puts " APP14 (unknown)" + } + } + e[3456789abcf] { + puts [format " %s%d %s" APP 0x[string index [lindex $marker 0] 1] (unknown)] + } + fe { + puts " Comment: [read $fh [lindex $marker 2]]" + } + default { + puts " Unknown" + } + } + } +} + +# for mapping the exif format types to byte lengths +array set ::jpeg::exif_formats [list 1 1 2 1 3 2 4 4 5 8 6 1 7 1 8 2 9 4 10 8 11 4 12 8] + +# list of recognized exif tags. if a tag is not listed here it will show up as its raw hex value +array set ::jpeg::exif_tags { + 0100 ImageWidth + 0101 ImageLength + 0102 BitsPerSample + 0103 Compression + 0106 PhotometricInterpretation + 0112 Orientation + 0115 SamplesPerPixel + 011c PlanarConfiguration + 0212 YCbCrSubSampling + 0213 YCbCrPositioning + 011a XResolution + 011b YResolution + 0128 ResolutionUnit + + 0111 StripOffsets + 0116 RowsPerStrip + 0117 StripByteCounts + 0201 JPEGInterchangeFormat + 0202 JPEGInterchangeFormatLength + + 012d TransferFunction + 013e WhitePoint + 013f PrimaryChromaticities + 0211 YCbCrCoefficients + 0213 YCbCrPositioning + 0214 ReferenceBlackWhite + + 0132 DateTime + 010e ImageDescription + 010f Make + 0110 Model + 0131 Software + 013b Artist + 8298 Copyright + + 9000 ExifVersion + a000 FlashpixVersion + + a001 ColorSpace + + 9101 ComponentsConfiguration + 9102 CompressedBitsPerPixel + a002 ExifImageWidth + a003 ExifImageHeight + + 927c MakerNote + 9286 UserComment + + a004 RelatedSoundFile + + 9003 DateTimeOriginal + 9004 DateTimeDigitized + 9290 SubsecTime + 9291 SubsecTimeOriginal + 9292 SubsecTimeDigitized + + 829a ExposureTime + 829d FNumber + 8822 ExposureProgram + 8824 SpectralSensitivity + 8827 ISOSpeedRatings + 8828 OECF + 9201 ShutterSpeedValue + 9202 ApertureValue + 9203 BrightnessValue + 9204 ExposureBiasValue + 9205 MaxApertureValue + 9206 SubjectDistance + 9207 MeteringMode + 9208 LightSource + 9209 Flash + 920a FocalLength + 9214 SubjectArea + a20b FlashEnergy + a20c SpatialFrequencyResponse + a20e FocalPlaneXResolution + a20f FocalPlaneYResolution + a210 FocalPlaneResolutionUnit + a214 SubjectLocation + a215 ExposureIndex + a217 SensingMethod + a300 FileSource + a301 SceneType + a302 CFAPattern + a401 CustomRendered + a402 ExposureMode + a403 WhiteBalance + a404 DigitalZoomRatio + a405 FocalLengthIn35mmFilm + a406 SceneCaptureType + a407 GainControl + a408 Contrast + a409 Saturation + a40a Sharpness + a40b DeviceSettingDescription + a40c SubjectDistanceRange + a420 ImageUniqueID + + + 0001 InteroperabilityIndex + 0002 InteroperabilityVersion + 1000 RelatedImageFileFormat + 1001 RelatedImageWidth + 1002 RelatedImageLength + + 00fe NewSubfileType + 00ff SubfileType + 013d Predictor + 0142 TileWidth + 0143 TileLength + 0144 TileOffsets + 0145 TileByteCounts + 014a SubIFDs + 015b JPEGTables + 828d CFARepeatPatternDim + 828e CFAPattern + 828f BatteryLevel + 83bb IPTC/NAA + 8773 InterColorProfile + 8825 GPSInfo + 8829 Interlace + 882a TimeZoneOffset + 882b SelfTimerMode + 920c SpatialFrequencyResponse + 920d Noise + 9211 ImageNumber + 9212 SecurityClassification + 9213 ImageHistory + 9215 ExposureIndex + 9216 TIFF/EPStandardID +} + +# list of recognized exif tags for the GPSInfo section--added by mdp 6/5/2009 +array set ::jpeg::gps_tags { + 0000 GPSVersionID + 0001 GPSLatitudeRef + 0002 GPSLatitude + 0003 GPSLongitudeRef + 0004 GPSLongitude + 0005 GPSAltitudeRef + 0006 GPSAltitude + 0007 GPSTimeStamp + 0008 GPSSatellites + 0009 GPSStatus + 000a GPSMeasureMode + 000b GPSDOP + 000c GPSSpeedRef + 000d GPSSpeed + 000e GPSTrackRef + 000f GPSTrack + 0010 GPSImgDirectionRef + 0011 GPSImgDirection + 0012 GPSMapDatum + 0013 GPSDestLatitudeRef + 0014 GPSDestLatitude + 0015 GPSDestLongitudeRef + 0016 GPSDestLongitude + 0017 GPSDestBearingRef + 0018 GPSDestBearing + 0019 GPSDestDistanceRef + 001a GPSDestDistance + 001b GPSProcessingMethod + 001c GPSAreaInformation + 001d GPSDateStamp + 001e GPSDifferential +} + +# for mapping exif values to plain english by [formatExif] +array set ::jpeg::exif_values { + Compression,1 none + Compression,6 JPEG + Compression, unknown + + PhotometricInterpretation,2 RGB + PhotometricInterpretation,6 YCbCr + PhotometricInterpretation, unknown + + Orientation,1 normal + Orientation,2 mirrored + Orientation,3 "180 degrees" + Orientation,4 "180 degrees, mirrored" + Orientation,5 "90 degrees ccw, mirrored" + Orientation,6 "90 degrees cw" + Orientation,7 "90 degrees cw, mirrored" + Orientation,8 "90 degrees ccw" + Orientation, unknown + + PlanarConfiguration,1 chunky + PlanarConfiguration,2 planar + PlanarConfiguration, unknown + + YCbCrSubSampling,2,1 YCbCr4:2:2 + YCbCrSubSampling,2,2 YCbCr4:2:0 + YCbCrSubSampling, unknown + + YCbCrPositioning,1 centered + YCbCrPositioning,2 co-sited + YCbCrPositioning, unknown + + FlashpixVersion,0100 "Flashpix Format Version 1.0" + FlashpixVersion, unknown + + ColorSpace,1 sRGB + ColorSpace,32768 uncalibrated + ColorSpace, unknown + + ExposureProgram,0 undefined + ExposureProgram,1 manual + ExposureProgram,2 normal + ExposureProgram,3 "aperture priority" + ExposureProgram,4 "shutter priority" + ExposureProgram,5 creative + ExposureProgram,6 action + ExposureProgram,7 portrait + ExposureProgram,8 landscape + ExposureProgram, unknown + + LightSource,0 unknown + LightSource,1 daylight + LightSource,2 flourescent + LightSource,3 tungsten + LightSource,4 flash + LightSource,9 "fine weather" + LightSource,10 "cloudy weather" + LightSource,11 shade + LightSource,12 "daylight flourescent" + LightSource,13 "day white flourescent" + LightSource,14 "cool white flourescent" + LightSource,15 "white flourescent" + LightSource,17 "standard light A" + LightSource,18 "standard light B" + LightSource,19 "standard light C" + LightSource,20 D55 + LightSource,21 D65 + LightSource,22 D75 + LightSource,23 D50 + LightSource,24 "ISO studio tungsten" + LightSource,255 other + LightSource, unknown + + Flash,0 "no flash" + Flash,1 "flash fired" + Flash,5 "strobe return light not detected" + Flash,7 "strobe return light detected" + Flash,9 "flash fired, compulsory flash mode" + Flash,13 "flash fired, compulsory flash mode, return light not detected" + Flash,15 "flash fired, compulsory flash mode, return light detected" + Flash,16 "flash did not fire, compulsory flash mode" + Flash,24 "flash did not fire, auto mode" + Flash,25 "flash fired, auto mode" + Flash,29 "flash fired, auto mode, return light not detected" + Flash,31 "flash fired, auto mode, return light detected" + Flash,32 "no flash function" + Flash,65 "flash fired, red-eye reduction mode" + Flash,69 "flash fired, red-eye reduction mode, return light not detected" + Flash,71 "flash fired, red-eye reduction mode, return light detected" + Flash,73 "flash fired, compulsory mode, red-eye reduction mode" + Flash,77 "flash fired, compulsory mode, red-eye reduction mode, return light not detected" + Flash,79 "flash fired, compulsory mode, red-eye reduction mode, return light detected" + Flash,89 "flash fired, auto mode, red-eye reduction mode" + Flash,93 "flash fired, auto mode, return light not detected, red-eye reduction mode" + Flash,95 "flash fired, auto mode, return light detected, red-eye reduction mode" + Flash, unknown + + ResolutionUnit,2 inch + ResolutionUnit,3 centimeter + ResolutionUnit, unknown + + SensingMethod,1 undefined + SensingMethod,2 "one chip color area sensor" + SensingMethod,3 "two chip color area sensor" + SensingMethod,4 "three chip color area sensor" + SensingMethod,5 "color sequential area sensor" + SensingMethod,7 "trilinear sensor" + SensingMethod,8 "color sequential linear sensor" + SensingMethod, unknown + + SceneType,\x01\x00\x00\x00 "directly photographed image" + SceneType, unknown + + CustomRendered,0 normal + CustomRendered,1 custom + + ExposureMode,0 auto + ExposureMode,1 manual + ExposureMode,2 "auto bracket" + ExposureMode, unknown + + WhiteBalance,0 auto + WhiteBlanace,1 manual + WhiteBlanace, unknown + + SceneCaptureType,0 standard + SceneCaptureType,1 landscape + SceneCaptureType,2 portrait + SceneCaptureType,3 night + SceneCaptureType, unknown + + GainControl,0 none + GainControl,1 "low gain up" + GainControl,2 "high gain up" + GainControl,3 "low gain down" + GainControl,4 "high gain down" + GainControl, unknown + + Contrast,0 normal + Contrast,1 soft + Contrast,2 hard + Contrast, unknown + + Saturation,0 normal + Saturation,1 low + Saturation,2 high + Saturation, unknown + + Sharpness,0 normal + Sharpness,1 soft + Sharpness,2 hard + Sharpness, unknown + + SubjectDistanceRange,0 unknown + SubjectDistanceRange,1 macro + SubjectDistanceRange,2 close + SubjectDistanceRange,3 distant + SubjectDistanceRange, unknown + + MeteringMode,0 unknown + MeteringMode,1 average + MeteringMode,2 "center weighted average" + MeteringMode,3 spot + MeteringMode,4 multi-spot + MeteringMode,5 multi-segment + MeteringMode,6 partial + MeteringMode,255 other + MeteringMode, unknown + + FocalPlaneResolutionUnit,2 inch + FocalPlaneResolutionUnit,3 centimeter + FocalPlaneResolutionUnit, none + + DigitalZoomRatio,0 "not used" + + FileSource,\x03\x00\x00\x00 "digital still camera" + FileSource, unknown +} + +# [binary scan], in the byte order indicated by $e +proc ::jpeg::_scan {e v f args} { + foreach x $args { upvar 1 $x $x } + if {$e == "big"} { + eval [list binary scan $v [string map {b B h H s S i I} $f]] $args + } else { + eval [list binary scan $v $f] $args + } +} + + +# formats exif values, the numbers correspond to data types +# values may be either byte order, as indicated by $end +# see the exif spec for more info +proc ::jpeg::_format {end value type num} { + if {$num > 1 && $type != 2 && $type != 7} { + variable exif_formats + set r {} + for {set i 0} {$i < $num} {incr i} { + set len $exif_formats($type) + lappend r [_format $end [string range $value [expr {$len * $i}] [expr {($len * $i) + $len - 1}]] $type 1] + } + return [join $r ,] + } + switch -exact -- $type { + 1 { _scan $end $value c value } + 2 { set value [string trimright $value \x00] } + 3 { + _scan $end $value s value + set value [format %u $value] + } + 4 { + _scan $end $value i value + set value [format %u $value] + } + 5 { + _scan $end $value ii n d + set n [format %u $n] + set d [format %u $d] + if {$d == 0} {set d 1} + #set value [string trimright [string trimright [format %5.4f [expr {double($n) / $d}]] 0] .] + set value [string trimright [string trimright [expr {double($n) / $d}] 0] .] + #set value "$n/$d" + } + 6 { _scan $end $value c value } + 8 { _scan $end $value s value } + 9 { _scan $end $value i value } + 10 { + _scan $end $value ii n d + if {$d == 0} {set d 1} + #set value [string trimright [string trimright [format %5.4f [expr {double($n) / $d}]] 0] .] + set value [string trimright [string trimright [expr {double($n) / $d}] 0] .] + #set value "$n/$d" + } + 11 { _scan $end $value i value } + 12 { _scan $end $value w value } + } + return $value +} + +# Do a compatibility version of [lassign] for versions of Tcl without +# that command. Not using a version check as special builds may have +# the command even if they are a version which nominally would not. + +if {![llength [info commands lassign]]} { + proc ::jpeg::lassign {sequence v args} { + set args [linsert $args 0 $v] + set a [::llength $args] + + # Nothing to assign. + #if {$a == 0} {return $sequence} + + # Perform assignments + set i 0 + foreach v $args { + upvar 1 $v var + set var [::lindex $sequence $i] + incr i + } + + # Return remainder, if there is any. + return [::lrange $sequence $a end] + } +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide jpeg 0.5 + diff --git a/tcllib/modules/jpeg/jpeg.test b/tcllib/modules/jpeg/jpeg.test new file mode 100644 index 0000000..8c28751 --- /dev/null +++ b/tcllib/modules/jpeg/jpeg.test @@ -0,0 +1,503 @@ +# -*- tcl -*- +# jpeg.test: Tests for the JPEG utilities. +# +# Copyright (c) 2008-2013 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# +# JPEG: @(#) $Id: jpeg.test,v 1.2 2011/05/06 13:39:27 patthoyts Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 2 + +support { + use fileutil/fileutil.tcl fileutil +} +testing { + useLocal jpeg.tcl jpeg +} + +# ------------------------------------------------------------------------- + +proc strdiff {a b} { + set la [string length $a] + set lb [string length $b] + if {$la < $lb} { + set b [string range $b 0 [expr {$la - 1}]] + set s b + } elseif {$lb < $la} { + set a [string range $a 0 [expr {$lb - 1}]] + set s a + } else { + set s - + } + set n -1 + foreach ca [split $a {}] cb [split $b {}] { + incr n + if {[string equal $ca $cb]} continue + lappend s $n $ca $cb + } + return $s +} + +proc fixupdata {dict} { + array set tmp $dict + catch {unset tmp(MakerNote)} + foreach k { + FocalPlaneXResolution + FocalPlaneYResolution + } { + if {![info exists tmp($k)]} continue + set tmp($k) [format %8.2f $tmp($k)] + } + return [array get tmp] +} + +# ------------------------------------------------------------------------- + +test jpeg-1.0 {isJPEG error, wrong#args, not enough} -body { + ::jpeg::isJPEG +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::isJPEG} {file} 0] + +test jpeg-1.1 {isJPEG error, wrong#args, too many} -body { + ::jpeg::isJPEG foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::isJPEG} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*JPG*] { + test jpeg-2.$n "isJPEG, ok, [file tail $f]" -body { + ::jpeg::isJPEG $f + } -result 1 + incr n +} + +test jpeg-2.$n "isJPEG, fail, [file tail [info script]]" -body { + ::jpeg::isJPEG [info script] +} -result 0 + +# ------------------------------------------------------------------------- + +test jpeg-2.0 {imageInfo error, wrong#args, not enough} -body { + ::jpeg::imageInfo +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::imageInfo} {file} 0] + +test jpeg-2.1 {imageInfo error, wrong#args, too many} -body { + ::jpeg::imageInfo foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::imageInfo} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*.JPG] { + test jpeg-3.$n "imageInfo regular, [file tail $f]" -body { + ::jpeg::imageInfo $f + } -result [string trim [fileutil::cat [file rootname $f].info.txt]] + incr n +} + +set n 0 +foreach f [TestFilesGlob testimages/*.thumb] { + test jpeg-4.$n "imageInfo thumbnails, [file tail $f]" -body { + ::jpeg::imageInfo $f + } -result {} + incr n +} + +test jpeg-5.0 "imageInfo, fail, [file tail [info script]]" -body { + ::jpeg::imageInfo [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-6.0 {dimensions error, wrong#args, not enough} -body { + ::jpeg::dimensions +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::dimensions} {file} 0] + +test jpeg-6.1 {dimensions error, wrong#args, too many} -body { + ::jpeg::dimensions foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::dimensions} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*.JPG] { + test jpeg-7.$n "dimensions regular, [file tail $f]" -body { + ::jpeg::dimensions $f + } -result [string trim [fileutil::cat [file rootname $f].WxH.txt]] + incr n +} + +set n 0 +foreach f [TestFilesGlob testimages/*.thumb] { + test jpeg-8.$n "dimensions thumbnails, [file tail $f]" -body { + ::jpeg::dimensions $f + } -result {160 120} + incr n +} + +test jpeg-9.0 "dimensions, fail, [file tail [info script]]" -body { +::jpeg::dimensions [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-10.0 {getThumbnail error, wrong#args, not enough} -body { + ::jpeg::getThumbnail +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getThumbnail} {file} 0] + +test jpeg-10.1 {getThumbnail error, wrong#args, too many} -body { + ::jpeg::getThumbnail foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getThumbnail} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*.JPG] { + if {![file exists $f.thumb]} { + test jpeg-11.$n "getThumbnail - no thumbnail, [file tail $f]" -body { + ::jpeg::getThumbnail $f + } -result {} + } else { + test jpeg-11.$n "getThumbnail regular, [file tail $f]" -body { + #fileutil::writeFile -translation binary ${f}.x.jpg [::jpeg::getThumbnail $f] + # Note: The .thumb files were created from the .JPG files + # using 'jhead -st', version 2.6. + set expected [fileutil::cat -translation binary ${f}.thumb] + set have [::jpeg::getThumbnail $f] + list [string equal $expected $have] [strdiff $expected $have] + } -result {1 -} + } + + incr n +} + +set n 0 +foreach f [TestFilesGlob testimages/*.thumb] { + test jpeg-12.$n "getThumbnail thumbnails, [file tail $f]" -body { + ::jpeg::getThumbnail $f + } -result {} + incr n +} + +test jpeg-13.0 "getThumbnail, fail, [file tail [info script]]" -body { + ::jpeg::getThumbnail [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-14.0 {exifKeys error, wrong#args, too many} -body { + ::jpeg::exifKeys bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::exifKeys} {}] + +# ------------------------------------------------------------------------- + +test jpeg-15.0 {exifKeys} -body { + ::jpeg::exifKeys +} -result {SubjectDistanceRange InterColorProfile InteroperabilityIndex InteroperabilityVersion Copyright ShutterSpeedValue ApertureValue BrightnessValue ImageDescription ExposureBiasValue Make MaxApertureValue SubjectDistance FlashpixVersion MeteringMode ColorSpace LightSource XResolution ExifImageWidth Flash YResolution ExifImageHeight ImageNumber PlanarConfiguration RelatedSoundFile SecurityClassification CustomRendered ImageHistory ExposureMode WhiteBalance SubjectArea ExposureIndex DigitalZoomRatio ImageWidth UserComment TIFF/EPStandardID FocalLengthIn35mmFilm ImageLength TimeZoneOffset SceneCaptureType BitsPerSample SelfTimerMode GainControl Compression SubsecTime Contrast SubsecTimeOriginal Saturation SubsecTimeDigitized PhotometricInterpretation TransferFunction RelatedImageFileFormat RelatedImageWidth Model NewSubfileType RelatedImageLength StripOffsets SubfileType Orientation FlashEnergy SpatialFrequencyResponse Artist ImageUniqueID SamplesPerPixel Predictor FocalPlaneXResolution RowsPerStrip FocalPlaneYResolution StripByteCounts WhitePoint ExifVersion PrimaryChromaticities JPEGInterchangeFormat JPEGInterchangeFormatLength DateTimeOriginal ExposureProgram DateTimeDigitized CFARepeatPatternDim SubIFDs SpectralSensitivity GPSInfo CFAPattern BatteryLevel ISOSpeedRatings OECF Interlace ResolutionUnit YCbCrCoefficients ExposureTime YCbCrSubSampling Software YCbCrPositioning DateTime IPTC/NAA ReferenceBlackWhite FNumber JPEGTables ComponentsConfiguration FocalPlaneResolutionUnit FocalLength CompressedBitsPerPixel MakerNote SpatialFrequencyResponse Noise TileWidth TileLength SubjectLocation TileOffsets ExposureIndex TileByteCounts SensingMethod FileSource SceneType Sharpness CFAPattern DeviceSettingDescription} + +# ------------------------------------------------------------------------- + +test jpeg-16.0 {getComments error, wrong#args, not enough} -body { + ::jpeg::getComments +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getComments} {file} 0] + +test jpeg-16.1 {getComments error, wrong#args, too many} -body { + ::jpeg::getComments foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getComments} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*.JPG] { + test jpeg-17.$n "getComments regular, [file tail $f]" -body { + ::jpeg::getComments $f + } -result {} + incr n +} + +set n 0 +foreach f [TestFilesGlob testimages/*.thumb] { + test jpeg-18.$n "getComments thumbnails, [file tail $f]" -body { + ::jpeg::getComments $f + } -result {} + incr n +} + +test jpeg-19.0 "getComments, fail, [file tail [info script]]" -body { + ::jpeg::getComments [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-20.0 {addComment error, wrong#args, not enough} -body { + ::jpeg::addComment +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::addComment} {file comment args} 0] + +test jpeg-20.1 {addComment error, wrong#args, not enough} -body { + ::jpeg::addComment foo +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::addComment} {file comment args} 1] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*JPG*] { + test jpeg-21.$n "addComment regular, [file tail $f]" -setup { + file copy -force $f [set fx [makeFile {} jtmp]] + ::jpeg::addComment $fx {a b} {c d} + } -body { + ::jpeg::getComments $fx + } -cleanup { + removeFile $fx + unset fx + } -result {{a b} {c d}} + incr n +} + +test jpeg-22.0 "addComment, fail, [file tail [info script]]" -body { + ::jpeg::addComment [info script] foo +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-23.0 {removeComments error, wrong#args, not enough} -body { + ::jpeg::removeComments +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::removeComments} {file} 0] + +test jpeg-23.1 {removeComments error, wrong#args, too many} -body { + ::jpeg::removeComments foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::removeComments} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*JPG*] { + test jpeg-24.$n "removeComments regular, [file tail $f]" -setup { + file copy -force $f [set fx [makeFile {} jtmp]] + ::jpeg::addComment $fx {a b} {c d} + } -body { + ::jpeg::removeComments $fx + ::jpeg::getComments $fx + } -cleanup { + removeFile $fx + unset fx + } -result {} + incr n +} + +test jpeg-25.0 "removeComments, fail, [file tail [info script]]" -body { + ::jpeg::removeComments [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-26.0 {replaceComment error, wrong#args, not enough} -body { + ::jpeg::replaceComment +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::replaceComment} {file comment} 0] + +test jpeg-26.1 {replaceComment error, wrong#args, not enough} -body { + ::jpeg::replaceComment foo +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::replaceComment} {file comment} 0] + +test jpeg-26.2 {replaceComment error, wrong#args, too many} -body { + ::jpeg::replaceComment foo bar barf +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::replaceComment} {file comment}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*JPG*] { + test jpeg-27.$n "replaceComment regular, [file tail $f]" -setup { + file copy -force $f [set fx [makeFile {} jtmp]] + ::jpeg::addComment $fx {a b} {c d} + } -body { + ::jpeg::replaceComment $fx new + ::jpeg::getComments $fx + } -cleanup { + removeFile $fx + unset fx + } -result {new {c d}} + incr n +} + +test jpeg-28.0 "replaceComment, fail, [file tail [info script]]" -body { + ::jpeg::replaceComment [info script] foo +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-29.0 {getExif error, wrong#args, not enough} -body { + ::jpeg::getExif +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getExif} {file ?type?} 0] + +test jpeg-29.1 {getExif error, wrong#args, too many} -body { + ::jpeg::getExif foo bar barf +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getExif} {file ?type?}] + +test jpeg-29.2 {getExif error, bad section type} -body { + ::jpeg::getExif [localPath testimages/IMG_7950.JPG] fufara +} -returnCodes error -result {Bad type "fufara", expected one of "main", or "thumbnail"} + +test jpeg-29.3 {getExifFromChannel error, wrong#args, not enough} -body { + ::jpeg::getExifFromChannel +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getExifFromChannel} {chan ?type?} 0] + +test jpeg-29.4 {getExifFromChannel error, wrong#args, too many} -body { + ::jpeg::getExifFromChannel foo bar barf +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getExifFromChannel} {chan ?type?}] + +test jpeg-29.5 {getExifFromChannel error, bad section type} -setup { + set fd [::jpeg::openJFIF [localPath testimages/IMG_7950.JPG] r] +} -body { + ::jpeg::getExifFromChannel $fd fufara +} -cleanup { + close $fd + unset fd +} -returnCodes error -result {Bad type "fufara", expected one of "main", or "thumbnail"} + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*.JPG] { + test jpeg-30.$n "getExif, main section, $f" -body { + dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f]]] + } -result [string trimright [fileutil::cat [file rootname $f].exif.txt]] + incr n +} + +set n 0 +foreach f [TestFilesGlob testimages/*.thumb] { + test jpeg-31.$n "getExif, main section, $f" -body { + dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f]]] + } -result {} + incr n +} + +set n 0 +foreach f [TestFilesGlob testimages/*.JPG] { + test jpeg-32.$n "getExif, thumbnail section, $f" -body { + dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f thumbnail]]] + } -result [string trimright [fileutil::cat [file rootname $f].thumbexif.txt]] + incr n +} + +set n 0 +foreach f [TestFilesGlob testimages/*.thumb] { + test jpeg-33.$n "getExif, thumbnail section, $f" -body { + dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f thumbnail]]] + } -result {} + incr n +} + +test jpeg-34.0 "getExif, fail, [file tail [info script]]" -body { + ::jpeg::getExif [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- +# formatExif is implicitly tested in the previous tests (30-33), with getExif. + +test jpeg-33.0 {formatExif error, wrong#args, not enough} -body { + ::jpeg::formatExif +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::formatExif} {exif} 0] + +test jpeg-33.1 {formatExif error, wrong#args, too many} -body { + ::jpeg::formatExif foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::formatExif} {exif}] + +# ------------------------------------------------------------------------- + +test jpeg-34.0 {removeExif error, wrong#args, not enough} -body { + ::jpeg::removeExif +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::removeExif} {file} 0] + +test jpeg-34.1 {removeExif error, wrong#args, too many} -body { + ::jpeg::removeExif foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::removeExif} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*JPG*] { + test jpeg-35.$n "removeExif ok, [file tail $f]" -setup { + file copy -force $f [set fx [makeFile {} jtmp]] + ::jpeg::addComment $fx {a b} {c d} + } -body { + ::jpeg::removeExif $fx + set res [list [::jpeg::getComments $fx] [::jpeg::getExif $fx] [::jpeg::getExif $fx thumbnail]] + } -cleanup { + removeFile $fx + unset fx + } -result {{{a b} {c d}} {} {}} + incr n +} + +test jpeg-36.0 "removeExif, fail, [file tail [info script]]" -body { +::jpeg::removeExif [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-37.0 {stripJPEG error, wrong#args, not enough} -body { + ::jpeg::stripJPEG +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::stripJPEG} {file} 0] + +test jpeg-37.1 {stripJPEG error, wrong#args, too many} -body { + ::jpeg::stripJPEG foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::stripJPEG} {file}] + +# ------------------------------------------------------------------------- + +set n 0 +foreach f [TestFilesGlob testimages/*JPG*] { + test jpeg-38.$n "stripJPEG ok, [file tail $f]" -setup { + file copy -force $f [set fx [makeFile {} jtmp]] + ::jpeg::addComment $fx {a b} {c d} + } -body { + ::jpeg::stripJPEG $fx + set res [list [::jpeg::getComments $fx] [::jpeg::getExif $fx] [::jpeg::getExif $fx thumbnail]] + } -cleanup { + removeFile $fx + unset fx + } -result {{} {} {}} + incr n +} + +test jpeg-39.0 "stripJPEG, fail, [file tail [info script]]" -body { + ::jpeg::stripJPEG [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- + +test jpeg-40.0 {debug error, wrong#args, not enough} -body { + ::jpeg::debug +} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::debug} {file} 0] + +test jpeg-40.1 {debug error, wrong#args, too many} -body { + ::jpeg::debug foo bar +} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::debug} {file}] + +# ------------------------------------------------------------------------- +# We do not try to actually run 'debug', because it prints its results +# to stdout. This may change when we can capture stdout as test result + +set n 0 +foreach f [TestFilesGlob testimages/*JPG*] { + test jpeg-41.$n "debug ok, [file tail $f]" -constraints donotrun -body { + ::jpeg::debug $f + } -result {} + incr n +} + +test jpeg-42.0 "debug, fail, [file tail [info script]]" -body { + ::jpeg::debug [info script] +} -returnCodes error -result {not a jpg file} + +# ------------------------------------------------------------------------- +rename strdiff {} +testsuiteCleanup diff --git a/tcllib/modules/jpeg/pkgIndex.tcl b/tcllib/modules/jpeg/pkgIndex.tcl new file mode 100644 index 0000000..a5aeabc --- /dev/null +++ b/tcllib/modules/jpeg/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded jpeg 0.5 [list source [file join $dir jpeg.tcl]] diff --git a/tcllib/modules/jpeg/testimages/1000.JPG b/tcllib/modules/jpeg/testimages/1000.JPG Binary files differnew file mode 100644 index 0000000..551d9cb --- /dev/null +++ b/tcllib/modules/jpeg/testimages/1000.JPG diff --git a/tcllib/modules/jpeg/testimages/1000.WxH.txt b/tcllib/modules/jpeg/testimages/1000.WxH.txt new file mode 100644 index 0000000..42cd169 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/1000.WxH.txt @@ -0,0 +1 @@ +1000 1000 diff --git a/tcllib/modules/jpeg/testimages/1000.exif.txt b/tcllib/modules/jpeg/testimages/1000.exif.txt new file mode 100644 index 0000000..fe5a223 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/1000.exif.txt @@ -0,0 +1 @@ +ExifByteOrder little ExifOffset 30 diff --git a/tcllib/modules/jpeg/testimages/1000.info.txt b/tcllib/modules/jpeg/testimages/1000.info.txt new file mode 100644 index 0000000..78ebf12 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/1000.info.txt @@ -0,0 +1 @@ +version 1.1 units 1 xdensity 96 ydensity 96 xthumb 0 ythumb 0 diff --git a/tcllib/modules/jpeg/testimages/1000.thumbexif.txt b/tcllib/modules/jpeg/testimages/1000.thumbexif.txt new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/1000.thumbexif.txt diff --git a/tcllib/modules/jpeg/testimages/IMG_7898.JPG b/tcllib/modules/jpeg/testimages/IMG_7898.JPG Binary files differnew file mode 100644 index 0000000..8932ee9 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7898.JPG diff --git a/tcllib/modules/jpeg/testimages/IMG_7898.JPG.thumb b/tcllib/modules/jpeg/testimages/IMG_7898.JPG.thumb Binary files differnew file mode 100644 index 0000000..cd25b58 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7898.JPG.thumb diff --git a/tcllib/modules/jpeg/testimages/IMG_7898.WxH.txt b/tcllib/modules/jpeg/testimages/IMG_7898.WxH.txt new file mode 100644 index 0000000..d27cc65 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7898.WxH.txt @@ -0,0 +1 @@ +320 240 diff --git a/tcllib/modules/jpeg/testimages/IMG_7898.exif.txt b/tcllib/modules/jpeg/testimages/IMG_7898.exif.txt new file mode 100644 index 0000000..9eb78a7 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7898.exif.txt @@ -0,0 +1 @@ +ApertureValue 4.0 ColorSpace sRGB ComponentsConfiguration 1,2,3,0 CompressedBitsPerPixel 5 CustomRendered normal DateTime {2008:03:14 15:40:06} DateTimeDigitized {2008:03:14 15:40:06} DateTimeOriginal {2008:03:14 15:40:06} DigitalZoomRatio 1 ExifByteOrder little ExifImageHeight 2448 ExifImageWidth 3264 ExifOffset 30 ExifVersion 2.2 ExposureBiasValue 0 ExposureMode auto ExposureTime 1/60 FNumber 4.0 FileSource {digital still camera} Flash {flash did not fire, compulsory flash mode} FlashpixVersion {Flashpix Format Version 1.0} FocalLength 6 FocalPlaneResolutionUnit inch FocalPlaneXResolution 14506.67 FocalPlaneYResolution 14485.21 ISOSpeedRatings 80 InteroperabilityIndex R98 InteroperabilityVersion 0100 Make Canon MaxApertureValue 3.0 MeteringMode multi-segment Model {Canon PowerShot S5 IS} Orientation normal RelatedImageLength 2448 RelatedImageWidth 3264 ResolutionUnit inch SceneCaptureType standard SensingMethod {one chip color area sensor} ShutterSpeedValue 1/60 UserComment {} WhiteBalance auto XResolution 180 YCbCrPositioning centered YResolution 180 diff --git a/tcllib/modules/jpeg/testimages/IMG_7898.info.txt b/tcllib/modules/jpeg/testimages/IMG_7898.info.txt new file mode 100644 index 0000000..855f1f7 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7898.info.txt @@ -0,0 +1 @@ +version 1.1 units 1 xdensity 180 ydensity 180 xthumb 0 ythumb 0 diff --git a/tcllib/modules/jpeg/testimages/IMG_7898.thumbexif.txt b/tcllib/modules/jpeg/testimages/IMG_7898.thumbexif.txt new file mode 100644 index 0000000..2cee21a --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7898.thumbexif.txt @@ -0,0 +1 @@ +Compression JPEG ExifByteOrder little ExifOffset 30 JPEGInterchangeFormat 5108 JPEGInterchangeFormatLength 6496 ResolutionUnit inch XResolution 180 YResolution 180 diff --git a/tcllib/modules/jpeg/testimages/IMG_7917.JPG b/tcllib/modules/jpeg/testimages/IMG_7917.JPG Binary files differnew file mode 100644 index 0000000..3b5d22e --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7917.JPG diff --git a/tcllib/modules/jpeg/testimages/IMG_7917.JPG.thumb b/tcllib/modules/jpeg/testimages/IMG_7917.JPG.thumb Binary files differnew file mode 100644 index 0000000..75b3991 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7917.JPG.thumb diff --git a/tcllib/modules/jpeg/testimages/IMG_7917.WxH.txt b/tcllib/modules/jpeg/testimages/IMG_7917.WxH.txt new file mode 100644 index 0000000..d27cc65 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7917.WxH.txt @@ -0,0 +1 @@ +320 240 diff --git a/tcllib/modules/jpeg/testimages/IMG_7917.exif.txt b/tcllib/modules/jpeg/testimages/IMG_7917.exif.txt new file mode 100644 index 0000000..5bd3c38 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7917.exif.txt @@ -0,0 +1 @@ +ApertureValue 3.5 ColorSpace sRGB ComponentsConfiguration 1,2,3,0 CompressedBitsPerPixel 5 CustomRendered normal DateTime {2008:03:14 16:20:16} DateTimeDigitized {2008:03:14 16:20:16} DateTimeOriginal {2008:03:14 16:20:16} DigitalZoomRatio 1 ExifByteOrder little ExifImageHeight 2448 ExifImageWidth 3264 ExifOffset 30 ExifVersion 2.2 ExposureBiasValue 0 ExposureMode auto ExposureTime 1/60 FNumber 3.2 FileSource {digital still camera} Flash {flash did not fire, compulsory flash mode} FlashpixVersion {Flashpix Format Version 1.0} FocalLength 6 FocalPlaneResolutionUnit inch FocalPlaneXResolution 14506.67 FocalPlaneYResolution 14485.21 ISOSpeedRatings 80 InteroperabilityIndex R98 InteroperabilityVersion 0100 Make Canon MaxApertureValue 3.0 MeteringMode multi-segment Model {Canon PowerShot S5 IS} Orientation normal RelatedImageLength 2448 RelatedImageWidth 3264 ResolutionUnit inch SceneCaptureType standard SensingMethod {one chip color area sensor} ShutterSpeedValue 1/60 UserComment {} WhiteBalance auto XResolution 180 YCbCrPositioning centered YResolution 180 diff --git a/tcllib/modules/jpeg/testimages/IMG_7917.info.txt b/tcllib/modules/jpeg/testimages/IMG_7917.info.txt new file mode 100644 index 0000000..855f1f7 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7917.info.txt @@ -0,0 +1 @@ +version 1.1 units 1 xdensity 180 ydensity 180 xthumb 0 ythumb 0 diff --git a/tcllib/modules/jpeg/testimages/IMG_7917.thumbexif.txt b/tcllib/modules/jpeg/testimages/IMG_7917.thumbexif.txt new file mode 100644 index 0000000..681ce4d --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7917.thumbexif.txt @@ -0,0 +1 @@ +Compression JPEG ExifByteOrder little ExifOffset 30 JPEGInterchangeFormat 5108 JPEGInterchangeFormatLength 5219 ResolutionUnit inch XResolution 180 YResolution 180 diff --git a/tcllib/modules/jpeg/testimages/IMG_7950.JPG b/tcllib/modules/jpeg/testimages/IMG_7950.JPG Binary files differnew file mode 100644 index 0000000..a395a37 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950.JPG diff --git a/tcllib/modules/jpeg/testimages/IMG_7950.JPG.thumb b/tcllib/modules/jpeg/testimages/IMG_7950.JPG.thumb Binary files differnew file mode 100644 index 0000000..f821d3f --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950.JPG.thumb diff --git a/tcllib/modules/jpeg/testimages/IMG_7950.WxH.txt b/tcllib/modules/jpeg/testimages/IMG_7950.WxH.txt new file mode 100644 index 0000000..d27cc65 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950.WxH.txt @@ -0,0 +1 @@ +320 240 diff --git a/tcllib/modules/jpeg/testimages/IMG_7950.exif.txt b/tcllib/modules/jpeg/testimages/IMG_7950.exif.txt new file mode 100644 index 0000000..a2b58f7 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950.exif.txt @@ -0,0 +1 @@ +ApertureValue 3.7 ColorSpace sRGB ComponentsConfiguration 1,2,3,0 CompressedBitsPerPixel 5 CustomRendered normal DateTime {2008:03:14 16:54:36} DateTimeDigitized {2008:03:14 16:54:36} DateTimeOriginal {2008:03:14 16:54:36} DigitalZoomRatio 1 ExifByteOrder little ExifImageHeight 2448 ExifImageWidth 3264 ExifOffset 30 ExifVersion 2.2 ExposureBiasValue 0 ExposureMode auto ExposureTime 1/60 FNumber 3.5 FileSource {digital still camera} Flash {flash did not fire, compulsory flash mode} FlashpixVersion {Flashpix Format Version 1.0} FocalLength 6 FocalPlaneResolutionUnit inch FocalPlaneXResolution 14506.67 FocalPlaneYResolution 14485.21 ISOSpeedRatings 80 InteroperabilityIndex R98 InteroperabilityVersion 0100 Make Canon MaxApertureValue 3.0 MeteringMode multi-segment Model {Canon PowerShot S5 IS} Orientation normal RelatedImageLength 2448 RelatedImageWidth 3264 ResolutionUnit inch SceneCaptureType standard SensingMethod {one chip color area sensor} ShutterSpeedValue 1/60 UserComment {} WhiteBalance auto XResolution 180 YCbCrPositioning centered YResolution 180 diff --git a/tcllib/modules/jpeg/testimages/IMG_7950.info.txt b/tcllib/modules/jpeg/testimages/IMG_7950.info.txt new file mode 100644 index 0000000..855f1f7 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950.info.txt @@ -0,0 +1 @@ +version 1.1 units 1 xdensity 180 ydensity 180 xthumb 0 ythumb 0 diff --git a/tcllib/modules/jpeg/testimages/IMG_7950.thumbexif.txt b/tcllib/modules/jpeg/testimages/IMG_7950.thumbexif.txt new file mode 100644 index 0000000..efd2bf0 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950.thumbexif.txt @@ -0,0 +1 @@ +Compression JPEG ExifByteOrder little ExifOffset 30 JPEGInterchangeFormat 5108 JPEGInterchangeFormatLength 4181 ResolutionUnit inch XResolution 180 YResolution 180 diff --git a/tcllib/modules/jpeg/testimages/IMG_7950_none.JPG b/tcllib/modules/jpeg/testimages/IMG_7950_none.JPG Binary files differnew file mode 100644 index 0000000..ca4c947 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950_none.JPG diff --git a/tcllib/modules/jpeg/testimages/IMG_7950_none.WxH.txt b/tcllib/modules/jpeg/testimages/IMG_7950_none.WxH.txt new file mode 100644 index 0000000..d27cc65 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950_none.WxH.txt @@ -0,0 +1 @@ +320 240 diff --git a/tcllib/modules/jpeg/testimages/IMG_7950_none.exif.txt b/tcllib/modules/jpeg/testimages/IMG_7950_none.exif.txt new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950_none.exif.txt diff --git a/tcllib/modules/jpeg/testimages/IMG_7950_none.info.txt b/tcllib/modules/jpeg/testimages/IMG_7950_none.info.txt new file mode 100644 index 0000000..1cf8542 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950_none.info.txt @@ -0,0 +1 @@ +version 1.1 units 1 xdensity 300 ydensity 300 xthumb 0 ythumb 0 diff --git a/tcllib/modules/jpeg/testimages/IMG_7950_none.thumbexif.txt b/tcllib/modules/jpeg/testimages/IMG_7950_none.thumbexif.txt new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/tcllib/modules/jpeg/testimages/IMG_7950_none.thumbexif.txt |