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/exif | |
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/exif')
-rw-r--r-- | tcllib/modules/exif/ChangeLog | 176 | ||||
-rw-r--r-- | tcllib/modules/exif/exif.html | 147 | ||||
-rw-r--r-- | tcllib/modules/exif/exif.man | 80 | ||||
-rw-r--r-- | tcllib/modules/exif/exif.pcx | 34 | ||||
-rw-r--r-- | tcllib/modules/exif/exif.tcl | 937 | ||||
-rw-r--r-- | tcllib/modules/exif/exif.test | 42 | ||||
-rw-r--r-- | tcllib/modules/exif/exif.txt | 280 | ||||
-rw-r--r-- | tcllib/modules/exif/exif.xml | 100 | ||||
-rw-r--r-- | tcllib/modules/exif/noafpoint.jpg | bin | 0 -> 1626 bytes | |||
-rw-r--r-- | tcllib/modules/exif/pkgIndex.tcl | 2 |
10 files changed, 1798 insertions, 0 deletions
diff --git a/tcllib/modules/exif/ChangeLog b/tcllib/modules/exif/ChangeLog new file mode 100644 index 0000000..e305b89 --- /dev/null +++ b/tcllib/modules/exif/ChangeLog @@ -0,0 +1,176 @@ +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-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 ======================== + * + +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> + + * exif.pcx: New file. Syntax definitions for the public commands + of the exif package. + +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> + + * exif.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-27 Andreas Kupries <andreask@activestate.com> + + * exif.test: [SF Tcllib Bug 1272798]. Using 'format' to get + results with a deterministic precision. + +2006-01-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * exif.test: More boilerplate simplified via use of test support. + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * exif.test: Hooked into the new common test support code. + +2005-10-21 Andreas Kupries <andreask@activestate.com> + + * exif.test: Fixed typo. + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +Wed Sep 29 15:11:35 2004 Andreas Kupries <andreask@activestate.com> + + * exif.tcl (makerNote): Fixed [Tcllib SF Bug 1028668]. There are + * exif.test: images in the wild which do not provide + AFPoint information in the makerNote Exif + data. Test suite is new. + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2003-05-09 Andreas Kupries <andreask@activestate.com> + + * exif.tcl (::exif::makerNote): Added missing logical operator to + if condition for field 34. Procheck report. + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-11 Andreas Kupries <andreask@activestate.com> + + * exif.tcl: + * exif.man: + * pkgIndex.tcl: Fixed bug #614591. Set version of the package to + to 1.1. + +2003-04-01 Andreas Kupries <andreask@activestate.com> + + * exif.man: + * exif.tcl: Applied patch for SF tcllib bug #665737 provided by + Tim J. Edwards <timje@users.sourceforge.net>. This not only + fixes the bug mentioned above, but also corrects some spelling + mistakes, adds support for a number of additional EXIF tags, and + provides functionality to dump a thumbnail image contained in + the data to a file. + + The change in the interface of 'analyze' (stream -> file) was + reverted and an additional file based command provided + instead. This command is a wrapper around the stream interface. + + Updated the documentation. + +2003-02-06 David N. Welton <davidw@dedasys.com> + + * exif.tcl (exif::makerNote): Use string match instead of regexp. + +2002-08-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * exif.tcl: Applied patch for bug report SF #530907 partially. + + Parts of the patch are accepted and applied + * FlashPixVersion + * Construction of FlashMode + + Not applied parts: + * SubjectDistance. Patch assumes that unit is millimeter and + converts to meter. Spec says that unit _is_ meter. (*). Is it + possible that the specific camera of the submitter implements + the standard incorrectly ? + + * ShutterSpeedValue. Instead of logical inversion (1/value + seconds) I added the proper unit for frequency (Hz). + + (*) http://www.media.mit.edu/pia/Research/deepview/exif.html + 0x9206 SubjectDistance signed rational 1 Distance to focus point, unit is meter + + * exif.tcl: Applied patch SF #582828 provided by Anselm Lingnau + <lingnau@users.sourceforge.net> to make the module work with + Digital IXUS. + +2002-03-25 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * exif.man: Fixed formatting errors in the doctools manpage. + +2002-02-18 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * Added module on behalf of Darren New. + diff --git a/tcllib/modules/exif/exif.html b/tcllib/modules/exif/exif.html new file mode 100644 index 0000000..a98d4e5 --- /dev/null +++ b/tcllib/modules/exif/exif.html @@ -0,0 +1,147 @@ +<html><head><title>The EXIF documentation file: The EXIF Package</title> +<meta http-equiv="Expires" content="Tue, 12 Feb 2002 23:41:06 +0000"> +<STYLE type='text/css'> + .title { color: #990000; font-size: 22px; line-height: 22px; font-weight: bold; text-align: right; + font-family: helvetica, arial, sans-serif } + .filename { color: #666666; font-size: 18px; line-height: 28px; font-weight: bold; text-align: right; + font-family: helvetica, arial, sans-serif } + p.copyright { color: #000000; font-size: 10px; + font-family: verdana, charcoal, helvetica, arial, sans-serif } + p { margin-left: 2em; margin-right: 2em; } + li { margin-left: 3em; } + ol { margin-left: 2em; margin-right: 2em; } + ul.text { margin-left: 2em; margin-right: 2em; } + pre { margin-left: 3em; color: #333333 } + ul.toc { color: #000000; line-height: 16px; + font-family: verdana, charcoal, helvetica, arial, sans-serif } + H3 { color: #333333; font-size: 16px; line-height: 16px; font-family: helvetica, arial, sans-serif } + H4 { color: #000000; font-size: 14px; font-family: helvetica, arial, sans-serif } + TD.header { color: #ffffff; font-size: 10px; font-family: arial, helvetica, san-serif; valign: top } + TD.author-text { color: #000000; font-size: 10px; + font-family: verdana, charcoal, helvetica, arial, sans-serif } + TD.author { color: #000000; font-weight: bold; margin-left: 4em; font-size: 10px; font-family: verdana, charcoal, helvetica, arial, sans-serif } + A:link { color: #990000; font-size: 10px; text-transform: uppercase; font-weight: bold; + font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif } + A:visited { color: #333333; font-weight: bold; font-size: 10px; text-transform: uppercase; + font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif } + A:name { color: #333333; font-weight: bold; font-size: 10px; text-transform: uppercase; + font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif } + .link2 { color:#ffffff; font-weight: bold; text-decoration: none; + font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif; + font-size: 9px } + .RFC { color:#666666; font-weight: bold; text-decoration: none; + font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif; + font-size: 9px } + .hotText { color:#ffffff; font-weight: normal; text-decoration: none; + font-family: charcoal, monaco, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif; + font-size: 9px } +</style> +</head> +<body bgcolor="#ffffff" text="#000000" alink="#000000" vlink="#666666" link="#990000"> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<table width="66%" border="0" cellpadding="0" cellspacing="0"><tr><td><table width="100%" border="0" cellpadding="2" cellspacing="1"> +<tr valign="top"><td width="33%" bgcolor="#666666" class="header">The EXIF documentation file</td><td width="33%" bgcolor="#666666" class="header">D. New</td></tr> +<tr valign="top"><td width="33%" bgcolor="#666666" class="header"> </td><td width="33%" bgcolor="#666666" class="header">February 12, 2002</td></tr> +</table></td></tr></table> +<div align="right"><font face="monaco, MS Sans Serif" color="#990000" size="+3"><b><br><span class="title">The EXIF Package</span></b></font></div> +<font face="verdana, helvetica, arial, sans-serif" size="2"> + +<h3>Abstract</h3> + +<p> + + Tcl EXIF extracts and parses EXIF fields from digital images. + +</p> +<a name="toc"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>Table of Contents</h3> +<ul compact class="toc"> +<b><a href="#anchor1">1.</a> +Synopsis<br></b> +<b><a href="#anchor2">2.</a> +Details<br></b> +<b><a href="#anchor3">3.</a> +Copyrights<br></b> +<b><a href="#anchor4">4.</a> +Acknowledgements<br></b> +</ul> +<br clear="all"> + +<a name="anchor1"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>1. Synopsis</h3> +</font><pre> + package provide exif 1.0 +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p> +The EXIF package is a recoding of Chris Breeze's Perl package to do the same + thing. This version accepts a channel as input and returns a serialized + array with all the recognised fields parsed out. +</p> + +<p> + There is also a function to obtain a list of all possible field names that + might be present, which is useful in building GUIs that present such + information. +</p> + +<a name="anchor2"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>2. Details</h3> +</font><pre> + array set answer [exif::analyze $channel] +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p> + $channel should be an open file handle rewound + to the start. It does not need to be seekable. + $channel will be set to binary mode and is left + wherever it happens to stop being parsed, usually + at the end of the file or the start of the image + data. You must open and close the stream yourself. + If no error is thrown, the return value is a + serialized array with informative English text + about what was found in the EXIF block. Failure + during parsing or I/O throw errors. +</p> +</font><pre> + set names [exif::fieldnames] +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p> + This returns a list of all possible field names. + That is, the array returned by exif::analyze will + not contain keys that are not listed in the return + from exif::fieldnames. Of course, if information is + missing in the image file, exif::analyze may not + return all the fields listed in the return from + exif::fieldnames. This function is expected to be + primarily useful for building GUIs to display results. + N.B.: Read the implementation of exif::fieldnames + before modifying the implementation of exif::analyze. + +</p> + +<a name="anchor3"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>3. Copyrights</h3> + +<p> +(c) 2002 Darren New +</p> + +<p> +Hold harmless the author, and any lawful use is allowed. +</p> + +<a name="anchor4"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>4. Acknowledgements</h3> + +<p> + This code is a direct translation of version 1.3 of exif.pl by Chris + Breeze. See the source for full headers, references, etc. +</p> +</font></body></html> diff --git a/tcllib/modules/exif/exif.man b/tcllib/modules/exif/exif.man new file mode 100644 index 0000000..62c6682 --- /dev/null +++ b/tcllib/modules/exif/exif.man @@ -0,0 +1,80 @@ +[manpage_begin exif n 1.1.2] +[keywords exif] +[keywords jpeg] +[keywords {maker note}] +[keywords tiff] +[moddesc {EXIF parsing}] +[titledesc {Tcl EXIF extracts and parses EXIF fields from digital images}] +[category {File formats}] +[require Tcl 8.2] +[require exif [opt 1.1.2]] +[description] +[para] + +The EXIF package is a recoding of Chris Breeze's Perl package to do +the same thing. This version accepts a channel as input and returns a +serialized array with all the recognised fields parsed out. + +[para] + +There is also a function to obtain a list of all possible field names +that might be present, which is useful in building GUIs that present +such information. + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd exif::analyze] [arg channel] [opt [arg thumbnail]]] + +[arg channel] should be an open file handle rewound to the start. It +does not need to be seekable. [arg channel] will be set to binary +mode and is left wherever it happens to stop being parsed, usually at +the end of the file or the start of the image data. You must open and +close the stream yourself. If no error is thrown, the return value is +a serialized array with informative English text about what was found +in the EXIF block. Failure during parsing or I/O throw errors. + +[para] + +If [arg thumbnail] is present and not the empty string it will be +interpreted as the name of a file, and the thumbnail image contained +in the exif data will be written into it. + +[call [cmd exif::analyzeFile] [arg filename] [opt [arg thumbnail]]] + +This is a file-based wrapper around [cmd exif::analyze]. Instead of +taking a stream it takes a [arg filename] and analyzes the contents of +the specified file. + +[call [cmd exif::fieldnames]] + +This returns a list of all possible field names. That is, the array +returned by [cmd exif::analyze] will not contain keys that are not +listed in the return from [cmd exif::fieldnames]. Of course, if +information is missing in the image file, [cmd exif::analyze] may not +return all the fields listed in the return from exif::fieldnames. +This function is expected to be primarily useful for building GUIs to +display results. + +[para] + +N.B.: Read the implementation of [cmd exif::fieldnames] before +modifying the implementation of [cmd exif::analyze]. + +[list_end] + +[section COPYRIGHTS] + +(c) 2002 Darren New + +Hold harmless the author, and any lawful use is allowed. + +[section ACKNOWLEDGEMENTS] + +This code is a direct translation of version 1.3 of exif.pl by Chris +Breeze. See the source for full headers, references, etc. + +[vset CATEGORY exif] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/exif/exif.pcx b/tcllib/modules/exif/exif.pcx new file mode 100644 index 0000000..cd69941 --- /dev/null +++ b/tcllib/modules/exif/exif.pcx @@ -0,0 +1,34 @@ +# -*- tcl -*- exif.pcx +# Syntax of the commands provided by package exif. +# +# 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 exif +pcx::tcldep 1.1.2 needs tcl 8.3 + +namespace eval ::exif {} + +#pcx::message FOO {... text ...} type +#pcx::scan <VERSION> <NAME> <RULE> + +pcx::check 1.1.2 std ::exif::analyze \ + {checkSimpleArgs 1 2 { + checkChannelID + checkFileName + }} +pcx::check 1.1.2 std ::exif::analyzeFile \ + {checkSimpleArgs 1 2 { + checkFileName + checkFileName + }} +pcx::check 1.1.2 std ::exif::fieldnames \ + {checkAtEnd} + +# Initialization via pcx::init. +# Use a ::exif::init procedure for non-standard initialization. +pcx::complete diff --git a/tcllib/modules/exif/exif.tcl b/tcllib/modules/exif/exif.tcl new file mode 100644 index 0000000..adb5709 --- /dev/null +++ b/tcllib/modules/exif/exif.tcl @@ -0,0 +1,937 @@ +# EXIF parser in Tcl +# Author: Darren New <dnew@san.rr.com> +# Translated directly from the Perl version +# by Chris Breeze <chris@breezesys.com> +# http://www.breezesys.com +# See the original comment block, reproduced +# at the bottom. +# Most of the inline comments about the meanings of fields +# are copied verbatim and without understanding from the +# original, unless "DNew" is there. +# Much of the structure is preserved, except in +# makerNote, where I got tired of typing as verbosely +# as the original Perl. But thanks for making it so +# readable that even someone who doesn't know Perl +# could translate it, Chris! ;-) +# PLEASE read and understand exif::fieldnames +# BEFORE making any changes here! Thanks! + +# Usage of this version: +# exif::analyze $stream ?$thumbnail? +# Stream should be an open file handle +# rewound to the start. It gets set to +# binary mode and is left at EOF or +# possibly pointing at image data. +# You have to open and close the +# stream yourself. +# The return is a serialized array +# (a la [array get]) with informative +# english text about what was found. +# Errors in parsing or I/O or whatever +# throw errors. +# exif::allfields +# returns a list of all possible field names. +# Added by DNew. Funky implementation. +# +# New +# exif::analyzeFile $filename ?$thumbnail? +# +# If you find any mistakes here, feel free to correct them +# and/or send them to me. I just cribbed this - I don't even +# have a camera that puts this kind of info into the file. + +# LICENSE: Standard BSD License. + +# There's probably something here I'm using without knowing it. +package require Tcl 8.3 + +package provide exif 1.1.2 ; # first release + +namespace eval ::exif { + namespace export analyze analyzeFile fieldnames + variable debug 0 ; # set to 1 for puts of debug trace + variable cameraModel ; # used internally to understand options + variable jpeg_markers ; # so we only have to do it once + variable intel ; # byte order - so we don't have to pass to every read + variable cached_fieldnames ; # just what it says + array set jpeg_markers { + SOF0 \xC0 + DHT \xC4 + SOI \xD8 + EOI \xD9 + SOS \xDA + DQT \xDB + DRI \xDD + APP1 \xE1 + } +} + +proc ::exif::debug {str} { + variable debug + if {$debug} {puts $str} +} + +proc ::exif::streq {s1 s2} { + return [string equal $s1 $s2] +} + +proc ::exif::analyzeFile {file {thumbnail {}}} { + set stream [open $file] + set res [analyze $stream $thumbnail] + close $stream + return $res +} + +proc ::exif::analyze {stream {thumbnail {}}} { + variable jpeg_markers + array set result {} + fconfigure $stream -translation binary -encoding binary + while {![eof $stream]} { + set ch [read $stream 1] + if {1 != [string length $ch]} {error "End of file reached @1"} + if {![streq "\xFF" $ch]} {break} ; # skip image data + set marker [read $stream 1] + if {1 != [string length $marker]} {error "End of file reached @2"} + if {[streq $marker $jpeg_markers(SOI)]} { + debug "SOI" + } elseif {[streq $marker $jpeg_markers(EOI)]} { + debug "EOI" + } else { + set msb [read $stream 1] + set lsb [read $stream 1] + if {1 != [string length $msb] || 1 != [string length $lsb]} { + error "File truncated @1" + } + scan $msb %c msb ; scan $lsb %c lsb + set size [expr {256 * $msb + $lsb}] + set data [read $stream [expr {$size-2}]] + debug "read [expr {$size - 2}] bytes of data" + if {[expr {$size-2}] != [string length $data]} { + error "File truncated @2" + } + if {[streq $marker $jpeg_markers(APP1)]} { + debug "APP1\t$size" + array set result [app1 $data $thumbnail] + } elseif {[streq $marker $jpeg_markers(DQT)]} { + debug "DQT\t$size" + } elseif {[streq $marker $jpeg_markers(SOF0)]} { + debug "SOF0\t$size" + } elseif {[streq $marker $jpeg_markers(DHT)]} { + debug "DHT\t$size" + } elseif {[streq $marker $jpeg_markers(SOS)]} { + debug "SOS\t$size" + } else { + binary scan $marker H* x + debug "UNKNOWN MARKER $x" + } + } + } + return [array get result] +} + +proc ::exif::app1 {data thumbnail} { + variable intel + variable cameraModel + array set result {} + if {![string equal [string range $data 0 5] "Exif\0\0"]} { + error "APP1 does not contain EXIF" + } + debug "Reading EXIF data" + set data [string range $data 6 end] + set t [string range $data 0 1] + if {[streq $t "II"]} { + set intel 1 + debug "Intel byte alignment" + } elseif {[streq $t "MM"]} { + set intel 0 + debug "Motorola byte alignment" + } else { + error "Invalid byte alignment: $t" + } + if {[readShort $data 2]!=0x002A} {error "Invalid tag mark"} + set curoffset [readLong $data 4] ; # just called "offset" in the Perl - DNew + debug "Offset to first IFD: $curoffset" + set numEntries [readShort $data $curoffset] + incr curoffset 2 + debug "Number of directory entries: $numEntries" + for {set i 0} {$i < $numEntries} {incr i} { + set head [expr {$curoffset + 12 * $i}] + set entry [string range $data $head [expr {$head+11}]] + set tag [readShort $entry 0] + set format [readShort $entry 2] + set components [readLong $entry 4] + set offset [readLong $entry 8] + set value [readIFDEntry $data $format $components $offset] + if {$tag==0x010e} { + set result(ImageDescription) $value + } elseif {$tag==0x010f} { + set result(CameraMake) $value + } elseif {$tag==0x0110} { + set result(CameraModel) $value + set cameraModel $value + } elseif {$tag==0x0112} { + set result(Orientation) $value + } elseif {$tag == 0x011A} { + set result(XResolution) $value + } elseif {$tag == 0x011B} { + set result(YResolution) $value + } elseif {$tag == 0x0128} { + set result(ResolutionUnit) "unknown" + if {$value==2} {set result(ResolutionUnit) "inch"} + if {$value==3} {set result(ResolutionUnit) "centimeter"} + } elseif {$tag==0x0131} { + set result(Software) $value + } elseif {$tag==0x0132} { + set result(DateTime) $value + } elseif {$tag==0x0213} { + set result(YCbCrPositioning) "unknown" + if {$value==1} {set result(YCbCrPositioning) "Center of pixel array"} + if {$value==2} {set result(YCbCrPositioning) "Datum point"} + } elseif {$tag==0x8769} { + # EXIF sub IFD + debug "==CALLING exifSubIFD==" + array set result [exifSubIFD $data $offset] + } else { + debug "Unrecognized entry: Tag=$tag, value=$value" + } + } + set offset [readLong $data [expr {$curoffset + 12 * $numEntries}]] + debug "Offset to next IFD: $offset" + array set thumb_result [exifSubIFD $data $offset] + + if {$thumbnail != {}} { + set jpg [string range $data \ + $thumb_result(JpegIFOffset) \ + [expr {$thumb_result(JpegIFOffset) + $thumb_result(JpegIFByteCount) - 1}]] + + set to [open $thumbnail w] + fconfigure $to -translation binary -encoding binary + puts $to $jpg + close $to + + #can be used (with a JPG-aware TK) to add the image to the result array + #set result(THUMB) [image create photo -file $thumbnail] + } + + return [array get result] +} + +# Extract EXIF sub IFD info +proc ::exif::exifSubIFD {data curoffset} { + debug "EXIF: offset=$curoffset" + set numEntries [readShort $data $curoffset] + incr curoffset 2 + debug "Number of directory entries: $numEntries" + for {set i 0} {$i < $numEntries} {incr i} { + set head [expr {$curoffset + 12 * $i}] + set entry [string range $data $head [expr {$head+11}]] + set tag [readShort $entry 0] + set format [readShort $entry 2] + set components [readLong $entry 4] + set offset [readLong $entry 8] + if {$tag==0x9000} { + set result(ExifVersion) [string range $entry 8 11] + } elseif {$tag==0x9101} { + set result(ComponentsConfigured) [format 0x%08x $offset] + } elseif {$tag == 0x927C} { + array set result [makerNote $data $offset] + } elseif {$tag == 0x9286} { + # Apparently, this doesn't usually work. + set result(UserComment) "$offset - [string range $data $offset [expr {$offset+8}]]" + set result(UserComment) [string trim $result(UserComment) "\0"] + } elseif {$tag==0xA000} { + set result(FlashPixVersion) [string range $entry 8 11] + } elseif {$tag==0xA300} { + # 3 means digital camera + if {$offset == 3} { + set result(FileSource) "3 - Digital camera" + } else { + set result(FileSource) $offset + } + } else { + set value [readIFDEntry $data $format $components $offset] + if {$tag==0x829A} { + if {0.3 <= $value} { + # In seconds... + set result(ExposureTime) "$value seconds" + } else { + set result(ExposureTime) "1/[expr {1.0/$value}] seconds" + } + } elseif {$tag == 0x829D} { + set result(FNumber) $value + } elseif {$tag == 0x8827} { + # D30 stores ISO here, G1 uses MakerNote Tag 1 field 16 + set result(ISOSpeedRatings) $value + } elseif {$tag == 0x9003} { + set result(DateTimeOriginal) $value + } elseif {$tag == 0x9004} { + set result(DateTimeDigitized) $value + } elseif {$tag == 0x9102} { + if {$value == 5} { + set result(ImageQuality) "super fine" + } elseif {$value == 3} { + set result(ImageQuality) "fine" + } elseif {$value == 2} { + set result(ImageQuality) "normal" + } else { + set result(CompressedBitsPerPixel) $value + } + } elseif {$tag == 0x9201} { + # Not very accurate, use Exposure time instead. + # (That's Chris' comment. I don't know what it means.) + set value [expr {pow(2,$value)}] + if {$value < 4} { + set value [expr {1.0 / $value}] + set value [expr {int($value * 10 + 0.5) / 10.0}] + } else { + set value [expr {int($value + 0.49)}] + } + set result(ShutterSpeedValue) "$value Hz" + } elseif {$tag == 0x9202} { + set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}] + set result(AperatureValue) $value + } elseif {$tag == 0x9204} { + set value [compensationFraction $value] + set result(ExposureBiasValue) $value + } elseif {$tag == 0x9205} { + set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}] + } elseif {$tag == 0x9206} { + # May need calibration + set result(SubjectDistance) "$value m" + } elseif {$tag == 0x9207} { + set result(MeteringMode) "other" + if {$value == 0} {set result(MeteringMode) "unknown"} + if {$value == 1} {set result(MeteringMode) "average"} + if {$value == 2} {set result(MeteringMode) "center weighted average"} + if {$value == 3} {set result(MeteringMode) "spot"} + if {$value == 4} {set result(MeteringMode) "multi-spot"} + if {$value == 5} {set result(MeteringMode) "multi-segment"} + if {$value == 6} {set result(MeteringMode) "partial"} + } elseif {$tag == 0x9209} { + if {$value == 0} { + set result(Flash) no + } elseif {$value == 1} { + set result(Flash) yes + } else { + set result(Flash) "unknown: $value" + } + } elseif {$tag == 0x920a} { + set result(FocalLength) "$value mm" + } elseif {$tag == 0xA001} { + set result(ColorSpace) $value + } elseif {$tag == 0xA002} { + set result(ExifImageWidth) $value + } elseif {$tag == 0xA003} { + set result(ExifImageHeight) $value + } elseif {$tag == 0xA005} { + set result(ExifInteroperabilityOffset) $value + } elseif {$tag == 0xA20E} { + set result(FocalPlaneXResolution) $value + } elseif {$tag == 0xA20F} { + set result(FocalPlaneYResolution) $value + } elseif {$tag == 0xA210} { + set result(FocalPlaneResolutionUnit) "none" + if {$value == 2} {set result(FocalPlaneResolutionUnit) "inch"} + if {$value == 3} {set result(FocalPlaneResolutionUnit) "centimeter"} + } elseif {$tag == 0xA217} { + # 2 = 1 chip color area sensor + set result(SensingMethod) $value + } elseif {$tag == 0xA401} { + #TJE + set result(SensingMethod) "normal" + if {$value == 1} {set result(SensingMethod) "custom"} + } elseif {$tag == 0xA402} { + #TJE + set result(ExposureMode) "auto" + if {$value == 1} {set result(ExposureMode) "manual"} + if {$value == 2} {set result(ExposureMode) "auto bracket"} + } elseif {$tag == 0xA403} { + #TJE + set result(WhiteBalance) "auto" + if {$value == 1} {set result(WhiteBalance) "manual"} + } elseif {$tag == 0xA404} { + # digital zoom not used if number is zero + set result(DigitalZoomRatio) "not used" + if {$value != 0} {set result(DigitalZoomRatio) $value} + } elseif {$tag == 0xA405} { + set result(FocalLengthIn35mmFilm) "unknown" + if {$value != 0} {set result(FocalLengthIn35mmFilm) $value} + } elseif {$tag == 0xA406} { + set result(SceneCaptureType) "Standard" + if {$value == 1} {set result(SceneCaptureType) "Landscape"} + if {$value == 2} {set result(SceneCaptureType) "Portrait"} + if {$value == 3} {set result(SceneCaptureType) "Night scene"} + } elseif {$tag == 0xA407} { + set result(GainControl) "none" + if {$value == 1} {set result(GainControl) "Low gain up"} + if {$value == 2} {set result(GainControl) "High gain up"} + if {$value == 3} {set result(GainControl) "Low gain down"} + if {$value == 4} {set result(GainControl) "High gain down"} + } elseif {$tag == 0x0103} { + #TJE + set result(Compression) "unknown" + if {$value == 1} {set result(Compression) "none"} + if {$value == 6} {set result(Compression) "JPEG"} + } elseif {$tag == 0x011A} { + #TJE + set result(XResolution) $value + } elseif {$tag == 0x011B} { + #TJE + set result(YResolution) $value + } elseif {$tag == 0x0128} { + #TJE + set result(ResolutionUnit) "unknown" + if {$value == 1} {set result(ResolutionUnit) "inch"} + if {$value == 6} {set result(ResolutionUnit) "cm"} + } elseif {$tag == 0x0201} { + #TJE + set result(JpegIFOffset) $value + debug "offset = $value" + } elseif {$tag == 0x0202} { + #TJE + set result(JpegIFByteCount) $value + debug "bytecount = $value" + } else { + error "Unrecognized EXIF Tag: $tag (0x[string toupper [format %x $tag]])" + } + } + } + return [array get result] +} + +# Canon proprietary data that I didn't feel like translating to Tcl yet. +proc ::exif::makerNote {data curoffset} { + variable cameraModel + debug "MakerNote: offset=$curoffset" + + array set result {} + set numEntries [readShort $data $curoffset] + incr curoffset 2 + debug "Number of directory entries: $numEntries" + for {set i 0} {$i < $numEntries} {incr i} { + set head [expr {$curoffset + 12 * $i}] + set entry [string range $data $head [expr {$head+11}]] + set tag [readShort $entry 0] + set format [readShort $entry 2] + set components [readLong $entry 4] + set offset [readLong $entry 8] + debug "$i)\tTag: $tag, format: $format, components: $components" + + if {$tag==6} { + set value [readIFDEntry $data $format $components $offset] + set result(ImageFormat) $value + } elseif {$tag==7} { + set value [readIFDEntry $data $format $components $offset] + set result(FirmwareVersion) $value + } elseif {$tag==8} { + set value [string range $offset 0 2]-[string range $offset 3 end] + set result(ImageNumber) $value + } elseif {$tag==9} { + set value [readIFDEntry $data $format $components $offset] + set result(Owner) $value + } elseif {$tag==0x0C} { + # camera serial number + set msw [expr {($offset >> 16) & 0xFFFF}] + set lsw [expr {$offset & 0xFFFF}] + set result(CameraSerialNumber) [format %04X%05d $msw $lsw] + } elseif {$tag==0x10} { + set result(UnknownTag-0x10) $offset + } else { + if {$format == 3 && 1 < $components} { + debug "MakerNote $i: TAG=$tag" + catch {unset field} + array set field {} + for {set j 0} {$j < $components} {incr j} { + set field($j) [readShort $data [expr {$offset+2*$j}]] + debug "$j : $field($j)" + } + if {$tag == 1} { + if {![string match -nocase "*Pro90*" $cameraModel]} { + if {$field(1)==1} { + set result(MacroMode) macro + } else { + set result(MacroMode) normal + } + } + if {0 < $field(2)} { + set result(SelfTimer) "[expr {$field(2)/10.0}] seconds" + } + set result(ImageQuality) [switch $field(3) { + 2 {format Normal} + 3 {format Fine} + 4 {format "CCD Raw"} + 5 {format "Super fine"} + default {format ""} + }] + set result(FlashMode) [switch $field(4) { + 0 {format off} + 1 {format auto} + 2 {format on} + 3 {format "red eye reduction"} + 4 {format "slow synchro"} + 5 {format "auto + red eye reduction"} + 6 {format "on + red eye reduction"} + default {format ""} + }] + if {$field(5)} { + set result(ShootingMode) "Continuous" + } else { + set result(ShootingMode) "Single frame" + } + # Field 6 - don't know what it is. + set result(AutoFocusMode) [switch $field(7) { + 0 {format "One-shot"} + 1 {format "AI servo"} + 2 {format "AI focus"} + 3 - 6 {format "MF"} + 5 {format "Continuous"} + 4 { + # G1: uses field 32 to store single/continuous, + # and always sets 7 to 4. + if {[info exists field(32)] && $field(32)} { + format "Continuous" + } else { + format "Single" + } + } + default {format unknown} + }] + # Field 8 and 9 are unknown + set result(ImageSize) [switch $field(10) { + 0 {format "large"} + 1 {format "medium"} + 2 {format "small"} + default {format "unknown"} + }] + # Field 11 - easy shooting - see field 20 + # Field 12 - unknown + set NHL { + 0 {format "Normal"} + 1 {format "High"} + 65536 {format "Low"} + default {format "Unknown"} + } + set result(Contrast) [switch $field(13) $NHL] + set result(Saturation) [switch $field(14) $NHL] + set result(Sharpness) [switch $field(15) $NHL] + set result(ISO) [switch $field(16) { + 15 {format Auto} + 16 {format 50} + 17 {format 100} + 18 {format 200} + 19 {format 400} + default {format "unknown"} + }] + set result(MeteringMode) [switch $field(17) { + 3 {format evaluative} + 4 {format partial} + 5 {format center-weighted} + default {format unknown} + }] + # Field 18 - unknown + if {[info exists field(19)]} { + set result(AFPoint) [switch -- [expr {$field(19)-0x3000}] { + 0 {format none} + 1 {format auto-selected} + 2 {format right} + 3 {format center} + 4 {format left} + default {format unknown} + }] ; # {} + } + if {[info exists field(20)]} { + if {$field(20) == 0} { + set result(ExposureMode) [switch $field(11) { + 0 {format auto} + 1 {format manual} + 2 {format landscape} + 3 {format "fast shutter"} + 4 {format "slow shutter"} + 5 {format "night scene"} + 6 {format "black and white"} + 7 {format sepia} + 8 {format portrait} + 9 {format sports} + 10 {format close-up} + 11 {format "pan focus"} + default {format unknown} + }] ; # {} + } elseif {$field(20) == 1} { + set result(ExposureMode) program + } elseif {$field(20) == 2} { + set result(ExposureMode) Tv + } elseif {$field(20) == 3} { + set result(ExposureMode) Av + } elseif {$field(20) == 4} { + set result(ExposureMode) manual + } elseif {$field(20) == 5} { + set result(ExposureMode) A-DEP + } else { + set result(ExposureMode) unknown + } + } + # Field 21 and 22 are unknown + # Field 23: max focal len, 24 min focal len, 25 units per mm + if {[info exists field(23)] && [info exists field(25)]} { + set result(MaxFocalLength) \ + "[expr {1.0 * $field(23) / $field(25)}] mm" + } + if {[info exists field(24)] && [info exists field(25)]} { + set result(MinFocalLength) \ + "[expr {1.0 * $field(24) / $field(25)}] mm" + } + # Field 26-28 are unknown. + if {[info exists field(29)]} { + if {$field(29) & 0x0010} { + lappend result(FlashMode) "FP_sync_enabled" + } + if {$field(29) & 0x0800} { + lappend result(FlashMode) "FP_sync_used" + } + if {$field(29) & 0x2000} { + lappend result(FlashMode) "internal_flash" + } + if {$field(29) & 0x4000} { + lappend result(FlashMode) "external_E-TTL" + } + } + if {[info exists field(34)] && \ + [string match -nocase "*pro90*" $cameraModel]} { + if {$field(34)} { + set result(ImageStabilisation) on + } else { + set result(ImageStabilisation) off + } + } + } elseif {$tag == 4} { + set result(WhiteBalance) [switch $field(7) { + 0 {format Auto} + 1 {format Daylight} + 2 {format Cloudy} + 3 {format Tungsten} + 4 {format Fluorescent} + 5 {format Flash} + 6 {format Custom} + default {format Unknown} + }] + if {$field(14) & 0x07} { + set result(AFPointsUsed) \ + [expr {($field(14)>>12) & 0x0F}] + if {$field(14)&0x04} { + append result(AFPointsUsed) " left" + } + if {$field(14)&0x02} { + append result(AFPointsUsed) " center" + } + if {$field(14)&0x01} { + append result(AFPointsUsed) " right" + } + } + if {[info exists field(15)]} { + set v $field(15) + if {32768 < $v} {incr v -65536} + set v [compensationFraction [expr {$v / 32.0}]] + set result(FlashExposureCompensation) $v + } + if {[info exists field(19)]} { + set result(SubjectDistance) "$field(19) m" + } + } elseif {$tag == 15} { + foreach k [array names field] { + set func [expr {($field($k) >> 8) & 0xFF}] + set v [expr {$field($k) & 0xFF}] + if {$func==1 && $v} { + set result(LongExposureNoiseReduction) on + } elseif {$func==1 && !$v} { + set result(LongExposureNoiseReduction) off + } elseif {$func==2} { + set result(Shutter/AE-Lock) [switch $v { + 0 {format "AF/AE lock"} + 1 {format "AE lock/AF"} + 2 {format "AF/AF lock"} + 3 {format "AE+release/AE+AF"} + default {format "Unknown"} + }] + } elseif {$func==3} { + if {$v} { + set result(MirrorLockup) enable + } else { + set result(MirrorLockup) disable + } + } elseif {$func==4} { + if {$v} { + set result(Tv/AvExposureLevel) "1/3 stop" + } else { + set result(Tv/AvExposureLevel) "1/2 stop" + } + } elseif {$func==5} { + if {$v} { + set result(AFAssistLight) off + } else { + set result(AFAssistLight) on + } + } elseif {$func==6} { + if {$v} { + set result(ShutterSpeedInAVMode) "Fixed 1/200" + } else { + set result(ShutterSpeedInAVMode) "Auto" + } + } elseif {$func==7} { + set result(AEBSeq/AutoCancel) [switch $v { + 0 {format "0, -, + enabled"} + 1 {format "0, -, + disabled"} + 2 {format "-, 0, + enabled"} + 3 {format "-, 0, + disabled"} + default {format unknown} + }] + } elseif {$func==8} { + if {$v} { + set result(ShutterCurtainSync) "2nd curtain sync" + } else { + set result(ShutterCurtainSync) "1st curtain sync" + } + } elseif {$func==9} { + set result(LensAFStopButtonFnSwitch) [switch $v { + 0 {format "AF stop"} + 1 {format "operate AF"} + 2 {format "lock AE and start timer"} + default {format unknown} + }] + } elseif {$func==10} { + if {$v} { + set result(AutoReductionOfFillFlash) disable + } else { + set result(AutoReductionOfFillFlash) enable + } + } elseif {$func==11} { + if {$v} { + set result(MenuButtonReturnPosition) previous + } else { + set result(MenuButtonReturnPosition) top + } + } elseif {$func==12} { + set result(SetButtonFuncWhenShooting) [switch $v { + 0 {format "not assigned"} + 1 {format "change quality"} + 2 {format "change ISO speed"} + 3 {format "select parameters"} + default {format unknown} + }] + } elseif {$func==13} { + if {$v} { + set result(SensorCleaning) enable + } else { + set result(SensorCleaning) disable + } + } elseif {$func==0} { + # Discovered by DNew? + set result(CameraOwner) $v + } else { + append result(UnknownCustomFunc) "$func=$v " + } + } + } + } else { + debug [format "makerNote: Unrecognized TAG: 0x%x" $tag] + } + } + } + return [array get result] +} + +proc ::exif::readShort {data offset} { + variable intel + if {[string length $data] < [expr {$offset+2}]} { + error "readShort: end of string reached" + } + set ch1 [string index $data $offset] + set ch2 [string index $data [expr {$offset+1}]] + scan $ch1 %c ch1 ; scan $ch2 %c ch2 + if {$intel} { + return [expr {$ch1 + 256 * $ch2}] + } else { + return [expr {$ch2 + 256 * $ch1}] + } +} + +proc ::exif::readLong {data offset} { + variable intel + if {[string length $data] < [expr {$offset+4}]} { + error "readLong: end of string reached" + } + set ch1 [string index $data $offset] + set ch2 [string index $data [expr {$offset+1}]] + set ch3 [string index $data [expr {$offset+2}]] + set ch4 [string index $data [expr {$offset+3}]] + scan $ch1 %c ch1 ; scan $ch2 %c ch2 + scan $ch3 %c ch3 ; scan $ch4 %c ch4 + if {$intel} { + return [expr {(((($ch4 * 256) + $ch3) * 256) + $ch2) * 256 + $ch1}] + } else { + return [expr {(((($ch1 * 256) + $ch2) * 256) + $ch3) * 256 + $ch4}] + } +} + +proc ::exif::readIFDEntry {data format components offset} { + variable intel + if {$format == 2} { + # ASCII string + set value [string range $data $offset [expr {$offset+$components-1}]] + return [string trimright $value "\0"] + } elseif {$format == 3} { + # unsigned short + if {!$intel} { + set offset [expr {0xFFFF & ($offset >> 16)}] + } + return $offset + } elseif {$format == 4} { + # unsigned long + return $offset + } elseif {$format == 5} { + # unsigned rational + # This could be messy, if either is >2**31 + set numerator [readLong $data $offset] + set denominator [readLong $data [expr {$offset + 4}]] + return [expr {(1.0*$numerator)/$denominator}] + } elseif {$format == 10} { + # signed rational + # Should work normally, since everything in Tcl is signed + set numerator [readLong $data $offset] + set denominator [readLong $data [expr {$offset + 4}]] + return [expr {(1.0*$numerator)/$denominator}] + } else { + set x [format %08x $format] + error "Invalid IFD entry format: $x" + } +} + +proc ::exif::compensationFraction {value} { + if {$value==0} {return 0} + if {$value < 0} { + set result "-" + set value [expr {0-$value}] + } else { + set result "+" + } + set value [expr {int(0.5 + $value * 6)}] + set integer [expr {int($value / 6)}] + set sixths [expr {$value % 6}] + if {$integer != 0} { + append result $integer + if {$sixths != 0} { + append result " " + } + } + if {$sixths == 2} { + append result "1/3" + } elseif {$sixths == 3} { + append result "1/2" + } elseif {$sixths == 4} { + append result "2/3" + } else { + # Added by DNew + append result "$sixths/6" + } + return $result +} + +# This returns the list of all possible fieldnames +# that analyze might return. +proc ::exif::fieldnames {} { + variable cached_fieldnames + if {[info exists cached_fieldnames]} { + return $cached_fieldnames + } + # Otherwise, parse the source to find the fieldnames. + # Cool, huh? Don'tcha just love Tcl? + # Because of this, "result(...)" should only appear + # in these functions when "..." is the literal name + # of a field to be returned. + array set namelist {} + foreach proc {analyze app1 exifSubIFD makerNote} { + set body [info body ::exif::$proc] + foreach line [split $body \n] { + if {[regexp {result\(([^)]+)\)} $line junk name]} { + set namelist($name) {} + } + } + } + set cached_fieldnames [lsort -dictionary [array names namelist]] + return $cached_fieldnames +} + + + +# # # # # # # # # # # # # # +# What follows is the original header comments +# from the Perl code from which this is +# translated. Any changes I made directly +# are marked by "DNew". + +# PERL script to extract EXIF information from JPEGs generated by Canon +# digital cameras. +# This software is free and you may do anything like with it except sell it. +# +# Current version: 1.3 +# Author: Chris Breeze +# email: chris@breezesys.com +# Web: http://www.breezesys.com +# +# Based on experimenting with my G1 and information from: +# http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html +# +# Also Canon MakerNote from David Burren's page: +# http://www.burren.cx/david/canon.html +# +# More EXIF info and specs: +# http://exif.org +# +# Warnings: +# 1) The Subject distance is unreliable. It seems reasonably accurate +# for the G1 but on the D30 it is highly dependent on the lens fitted. +# +# Perl for Windows is available for free from: +# http://www.activestate.com +# +# History +# 11 Jan 2001 +# v0.1: Initial version +# +# 14 Jan 2001 +# v0.2: Updated with data from David Burren's page +# +# 15 Jan 2001 +# v0.3: Added more info for D30 (supplied by David Burren) +# 1) D30 stores ISO in EXIF tag 0x8827, G1 uses MakerNote 0x1/16 +# 2) MakerNote 0x1/10, ImageSize appears to be large, medium, small +# 3) D30 allows 1/2 or 1/3 stop exposure compensation +# 4) Added D30 custom function details, but can't test them +# +# 17 Jan 2001 +# v1.0 Tidied up AutoFocusMode for G1 vs D30 + added manual auto focus point (D30) +# +# 18 Jan 2001 +# v1.1 Removed some debug code left in by mistake +# +# 29 Jan 2001 +# v1.2 Added flash mode (MakerNote Tag 1, field 4) +# +# 7 Mar 2001 +# v1.3 Added ImageQuality (MakerNote Tag 1, field 3) +# +# 21 Apr 2001 +# v1.4 added ImageStabilisation for Pro90 IS +# +# 17 Sep 2001 +# v1.5 Incorporated D30 improvements from Jim Leonard + +if {0} { + # Trivial usage example + set x [exif::fieldnames] + puts "fieldnames = $x" + set f [open [lindex $argv 0]] + array set v [exif::analyze $f] + close $f + parray v +} + diff --git a/tcllib/modules/exif/exif.test b/tcllib/modules/exif/exif.test new file mode 100644 index 0000000..05e72fa --- /dev/null +++ b/tcllib/modules/exif/exif.test @@ -0,0 +1,42 @@ +# -*- tcl -*- +# exif.test: tests for the exif structure. +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 2001-2006 by Andreas Kupries <a.kupries@westend.com> +# All rights reserved. +# +# RCS: @(#) $Id: exif.test,v 1.6 2006/10/09 21:41:40 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.3 +testsNeedTcltest 1.0 + +testing { + useLocal exif.tcl exif +} + +# ------------------------------------------------------------------------- + +test exif-makernote-19.0 {makernote field 19 (afpoint) is optional} { + # AFPoint == AutoFocus Point + + set f [open [file join $::tcltest::testsDirectory noafpoint.jpg] r] + fconfigure $f -translation binary + array set resa [exif::analyze $f] + close $f + set resa(FocalPlaneXResolution) [format %13.8f $resa(FocalPlaneXResolution)] + set resa(FocalPlaneYResolution) [format %13.8f $resa(FocalPlaneYResolution)] + set res [dictsort [array get resa]] + unset resa + set res +} {AFPointsUsed {3 right} AperatureValue 7.1 AutoFocusMode {AI servo} CameraMake Canon CameraModel {Canon PowerShot S100} ColorSpace 1 ComponentsConfigured 0x00030201 Contrast Normal DateTime {2004:09:06 05:22:56} DateTimeDigitized {2004:09:06 05:22:56} DateTimeOriginal {2004:09:06 05:22:56} ExifImageHeight 1200 ExifImageWidth 1600 ExifInteroperabilityOffset 1088 ExifVersion 0210 ExposureBiasValue 0 ExposureTime {1/250.0 seconds} FNumber 7.1 FileSource {3 - Digital camera} FirmwareVersion {Firmware Version 1.0} Flash no FlashMode auto FlashPixVersion 0100 FocalLength {5.40625 mm} FocalPlaneResolutionUnit inch FocalPlaneXResolution 7766.99029126 FocalPlaneYResolution 7741.93548387 ISO unknown ImageFormat {IMG:JPEG file} ImageNumber 140-4060 ImageQuality Fine ImageSize large MacroMode normal MeteringMode unknown Orientation 1 Owner Irochka ResolutionUnit inch Saturation Normal SensingMethod 2 Sharpness Normal ShootingMode {Single frame} ShutterSpeedValue {250 Hz} SubjectDistance {3.358 m} UnknownTag-0x10 100925440 UserComment {554 - } WhiteBalance Auto XResolution 180.0 YCbCrPositioning {Center of pixel array} YResolution 180.0} + +testsuiteCleanup diff --git a/tcllib/modules/exif/exif.txt b/tcllib/modules/exif/exif.txt new file mode 100644 index 0000000..33b8961 --- /dev/null +++ b/tcllib/modules/exif/exif.txt @@ -0,0 +1,280 @@ + + +The EXIF documentation file D. New + February 12, 2002 + + + The EXIF Package + + +Abstract + + Tcl EXIF extracts and parses EXIF fields from digital images. + +Table of Contents + + 1. Synopsis . . . . . . . . . . . . . . . . . . . . . . . . . . . . 2 + 2. Details . . . . . . . . . . . . . . . . . . . . . . . . . . . . 3 + 3. Copyrights . . . . . . . . . . . . . . . . . . . . . . . . . . . 4 + 4. Acknowledgements . . . . . . . . . . . . . . . . . . . . . . . . 5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +New [Page 1] + +EXIF The EXIF Package February 2002 + + +1. Synopsis + + package provide exif 1.0 + + The EXIF package is a recoding of Chris Breeze's Perl package to do + the same thing. This version accepts a channel as input and returns + a serialized array with all the recognised fields parsed out. + + There is also a function to obtain a list of all possible field names + that might be present, which is useful in building GUIs that present + such information. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +New [Page 2] + +EXIF The EXIF Package February 2002 + + +2. Details + + array set answer [exif::analyze $channel] + + $channel should be an open file handle rewound to the start. It does + not need to be seekable. $channel will be set to binary mode and is + left wherever it happens to stop being parsed, usually at the end of + the file or the start of the image data. You must open and close the + stream yourself. If no error is thrown, the return value is a + serialized array with informative English text about what was found + in the EXIF block. Failure during parsing or I/O throw errors. + + set names [exif::fieldnames] + + This returns a list of all possible field names. That is, the array + returned by exif::analyze will not contain keys that are not listed + in the return from exif::fieldnames. Of course, if information is + missing in the image file, exif::analyze may not return all the + fields listed in the return from exif::fieldnames. This function is + expected to be primarily useful for building GUIs to display results. + N.B.: Read the implementation of exif::fieldnames before modifying + the implementation of exif::analyze. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +New [Page 3] + +EXIF The EXIF Package February 2002 + + +3. Copyrights + + (c) 2002 Darren New + + Hold harmless the author, and any lawful use is allowed. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +New [Page 4] + +EXIF The EXIF Package February 2002 + + +4. Acknowledgements + + This code is a direct translation of version 1.3 of exif.pl by Chris + Breeze. See the source for full headers, references, etc. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +New [Page 5] + diff --git a/tcllib/modules/exif/exif.xml b/tcllib/modules/exif/exif.xml new file mode 100644 index 0000000..5d960ac --- /dev/null +++ b/tcllib/modules/exif/exif.xml @@ -0,0 +1,100 @@ +<?xml version="1.0"?> +<!DOCTYPE rfc SYSTEM "rfc2629.dtd"> + +<?rfc compact="no"?> +<?rfc toc="yes"?> +<?rfc private="The EXIF documentation file"?> +<?rfc header="EXIF"?> + +<rfc> +<front> +<title>The EXIF Package</title> + +<author initials="D." surname="New" fullname="Darren New"> +<organization/> +<address> +<postal> +<street>5390 Caminito Exquisito</street> +<city>San Diego</city> <region>CA</region> <code>92130</code> +<country>US</country> +</postal> +<email>dnew@san.rr.com</email> +</address> +</author> + +<date month="February" year="2002" /> + +<abstract><t> + Tcl EXIF extracts and parses EXIF fields from digital images. +</t></abstract> +</front> + +<middle> + +<section title="Synopsis"> +<figure><artwork><![CDATA[ + package provide exif 1.0 +]]></artwork></figure> + +<t>The EXIF package is a recoding of Chris Breeze's Perl package to do the same + thing. This version accepts a channel as input and returns a serialized + array with all the recognised fields parsed out. </t> + +<t> There is also a function to obtain a list of all possible field names that + might be present, which is useful in building GUIs that present such + information. </t> + +</section> + +<section title="Details"> + +<figure><artwork><![CDATA[ + array set answer [exif::analyze $channel] +]]></artwork></figure> + +<t> $channel should be an open file handle rewound + to the start. It does not need to be seekable. + $channel will be set to binary mode and is left + wherever it happens to stop being parsed, usually + at the end of the file or the start of the image + data. You must open and close the stream yourself. + If no error is thrown, the return value is a + serialized array with informative English text + about what was found in the EXIF block. Failure + during parsing or I/O throw errors. </t> + +<figure><artwork><![CDATA[ + set names [exif::fieldnames] +]]></artwork></figure> + +<t> This returns a list of all possible field names. + That is, the array returned by exif::analyze will + not contain keys that are not listed in the return + from exif::fieldnames. Of course, if information is + missing in the image file, exif::analyze may not + return all the fields listed in the return from + exif::fieldnames. This function is expected to be + primarily useful for building GUIs to display results. + N.B.: Read the implementation of exif::fieldnames + before modifying the implementation of exif::analyze. +</t> + +</section> + +<section title="Copyrights"> +<t>(c) 2002 Darren New</t> + +<t>Hold harmless the author, and any lawful use is allowed.</t> +</section> + +<section title="Acknowledgements"> + +<t> This code is a direct translation of version 1.3 of exif.pl by Chris + Breeze. See the source for full headers, references, etc. </t> + +</section> + +</middle> + +</rfc> + diff --git a/tcllib/modules/exif/noafpoint.jpg b/tcllib/modules/exif/noafpoint.jpg Binary files differnew file mode 100644 index 0000000..106c73c --- /dev/null +++ b/tcllib/modules/exif/noafpoint.jpg diff --git a/tcllib/modules/exif/pkgIndex.tcl b/tcllib/modules/exif/pkgIndex.tcl new file mode 100644 index 0000000..dc87584 --- /dev/null +++ b/tcllib/modules/exif/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.3]} {return} +package ifneeded exif 1.1.2 [list source [file join $dir exif.tcl]] |