--- tcllib.orig/modules/exif/exif.tcl 2005-01-27 10:23:02.000000000 -0800 +++ tcllib/modules/exif/exif.tcl 2005-09-06 12:44:59.000000000 -0700 @@ -45,12 +45,13 @@ # There's probably something here I'm using without knowing it. package require Tcl 8.3 -package provide exif 1.1.2 ; # first release +package provide exif 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 cameraMake ; # 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 @@ -132,6 +133,7 @@ proc ::exif::app1 {data thumbnail} { variable intel variable cameraModel + variable cameraMake array set result {} if {![string equal [string range $data 0 5] "Exif\0\0"]} { error "APP1 does not contain EXIF" @@ -166,6 +168,7 @@ set result(ImageDescription) $value } elseif {$tag==0x010f} { set result(CameraMake) $value + set cameraMake $value } elseif {$tag==0x0110} { set result(CameraModel) $value set cameraModel $value @@ -218,6 +221,7 @@ # Extract EXIF sub IFD info proc ::exif::exifSubIFD {data curoffset} { + variable cameraMake debug "EXIF: offset=$curoffset" set numEntries [readShort $data $curoffset] incr curoffset 2 @@ -234,11 +238,27 @@ } elseif {$tag==0x9101} { set result(ComponentsConfigured) [format 0x%08x $offset] } elseif {$tag == 0x927C} { - array set result [makerNote $data $offset] + #ML + # Catch error if vendor specific makerNote is not available or fails + catch {array set result [makerNote_[string toupper [string range $cameraMake 0 3]] $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"] + #ML + # The first 8Bytes specify the type. If all zero the type is undefined. + set type [string range $data $offset [expr {$offset + 7}]] + set type [string trim $type "\0"] + debug "UserComment type: '$type'" + set result(UserComment) "" + if {$type != ""} { + set value [string range $data [expr {$offset + 8}] [expr {$offset + 8 + $components - 1}]] + set value [string trim $value] + # normal string trim does not seem to work right here + for {set i 0} {$i < [string length $value]} {incr i 1} { + set a [string index $value $i] + if {![string is print $a]} { break } + append result(UserComment) $a + } + } + set result(UserComment) [string trim $result(UserComment)] } elseif {$tag==0xA000} { set result(FlashPixVersion) [string range $entry 8 11] } elseif {$tag==0xA300} { @@ -249,16 +269,30 @@ set result(FileSource) $offset } } else { - set value [readIFDEntry $data $format $components $offset] + set value [readIFDEntry $data $format $components $offset] if {$tag==0x829A} { if {0.3 <= $value} { # In seconds... - set result(ExposureTime) "$value seconds" + set result(ExposureTime) "$value s" } else { - set result(ExposureTime) "1/[expr {1.0/$value}] seconds" + set result(ExposureTime) "1/[format %.0f [expr {1.0/$value}]] s" } } elseif {$tag == 0x829D} { set result(FNumber) $value + } elseif {$tag == 0x8822} { + #ML + set result(ExposureProgram) [switch $value { + 0 {format "not defined"} + 1 {format "manual"} + 2 {format "normal program"} + 3 {format "aperture priority"} + 4 {format "shutter priority"} + 5 {format "creative program"} + 6 {format "action program"} + 7 {format "portrait mode"} + 8 {format "landscape mode"} + default {format unknown} + }] } elseif {$tag == 0x8827} { # D30 stores ISO here, G1 uses MakerNote Tag 1 field 16 set result(ISOSpeedRatings) $value @@ -307,6 +341,31 @@ 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 == 0x9208} { + #ML + set result(LightSource) [switch $value { + 1 {format "daylight"} + 2 {format "fluorescent"} + 3 {format "tungsten"} + 4 {format "flash"} + 9 {format "fine weather"} + 10 {format "cloudy weather"} + 11 {format "shade"} + 12 {format "daylight fluorescent"} + 13 {format "day white fluorescent"} + 14 {format "cool white fluorescent"} + 15 {format "white fluorescent"} + 17 {format "standard light A"} + 18 {format "standard light B"} + 19 {format "standard light C"} + 20 {format "D55"} + 21 {format "D65"} + 22 {format "D75"} + 23 {format "D50"} + 24 {format "ISO studio tungsten"} + 255 {format "other light source"} + default {format unknown} + }] } elseif {$tag == 0x9209} { if {$value == 0} { set result(Flash) no @@ -333,9 +392,24 @@ set result(FocalPlaneResolutionUnit) "none" if {$value == 2} {set result(FocalPlaneResolutionUnit) "inch"} if {$value == 3} {set result(FocalPlaneResolutionUnit) "centimeter"} + } elseif {$tag == 0xA215} { + #ML + set result(ExposureIndex) $value } elseif {$tag == 0xA217} { - # 2 = 1 chip color area sensor - set result(SensingMethod) $value + #ML + set result(SensingMethod) [switch $value { + 1 {format "not defined"} + 2 {format "one-chip color area sensor"} + 3 {format "two-chip color area sensor"} + 4 {format "three-chip color area sensor"} + 5 {format "color sequential area sensor"} + 7 {format "trilinear sensor"} + 7 {format "color sequential linear sensor"} + default {format unknown} + }] + } elseif {$tag == 0xA301} { + #ML + set result(SceneType) "directly photographed image" } elseif {$tag == 0xA401} { #TJE set result(SensingMethod) "normal" @@ -367,6 +441,38 @@ 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 == 0xA408} { + #ML + set result(Contrast) [switch $value { + 0 {format "normal"} + 1 {format "soft"} + 2 {format "hard"} + default {format unknown} + }] + } elseif {$tag == 0xA409} { + #ML + set result(Saturation) [switch $value { + 0 {format "normal"} + 1 {format "low saturation"} + 2 {format "high saturation"} + default {format unknown} + }] + } elseif {$tag == 0xA40A} { + #ML + set result(Sharpness) [switch $value { + 0 {format "normal"} + 1 {format "soft"} + 2 {format "hard"} + default {format unknown} + }] + } elseif {$tag == 0xA40C} { + #ML + set result(SubjectDistanceRange) [switch $value { + 1 {format "macro"} + 2 {format "close view"} + 3 {format "distant view"} + default {format unknown} + }] } elseif {$tag == 0x0103} { #TJE set result(Compression) "unknown" @@ -392,17 +498,84 @@ set result(JpegIFByteCount) $value debug "bytecount = $value" } else { - error "Unrecognized EXIF Tag: $tag (0x[string toupper [format %x $tag]])" + #ML + debug "Unrecognized EXIF Tag: $tag (0x[format %X $tag])" + lappend result(UnrcognizedTags) "0x[format %X $tag]" } } } return [array get result] } +#ML +# makerNote for OLYMPUS cameras +proc ::exif::makerNote_OLYM {data curoffset} { + variable cameraModel + debug "MakerNote_OLYM: offset=$curoffset" + array set result {} + + set value [readIFDEntry $data 2 5 $curoffset] + if {$value == "OLYMP"} { + incr curoffset 8 + } + set numEntries [readShort $data $curoffset] + debug "Number of directory entries: $numEntries" + incr curoffset 2 + 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] + debug "$i)\tTag: 0x[string toupper [format %x $tag]]" + + if {$tag == 0x0200} { + set value [readLong $data [expr {$offset + 0}]] + set result(OlympusShootingMode) [switch $value { + 0 {format "single"} + 2 {format "sequential"} + 3 {format "panoramic"} + default {format unknown} + }] + + set value [readLong $data [expr {$offset + 4}]] + set result(OlympusSequenceNumber) $value + + set value [readLong $data [expr {$offset + 8}]] + set result(OlympusPanoramicDirection) $value + + } elseif {$tag == 0x0201} { + set result(OlympusImageQuality) [switch $value { + 1 {format "SQ"} + 2 {format "HQ"} + 3 {format "SHQ"} + default {format unknown} + }] + } elseif {$tag == 0x0202} { + set result(OlympusMacroMode) [switch $value { + 0 {format "normal"} + 1 {format "macro"} + default {format unknown} + }] + } elseif {$tag == 0x0204} { + set result(OlympusDigitalZoomRatio) $value + } elseif {$tag == 0x0207} { + set result(OlympusFirmwareVersion) $value + } elseif {$tag == 0x0208} { + set result(OlympusPictureInfo) $value + } elseif {$tag == 0x0209} { + set result(OlympusCameraID) $value + } + } + return [array get result] +} + # Canon proprietary data that I didn't feel like translating to Tcl yet. -proc ::exif::makerNote {data curoffset} { +proc ::exif::makerNote_CANO {data curoffset} { variable cameraModel - debug "MakerNote: offset=$curoffset" + debug "MakerNote_CANO: offset=$curoffset" array set result {} set numEntries [readShort $data $curoffset] @@ -786,22 +959,38 @@ return $offset } elseif {$format == 4} { # unsigned long - return $offset + 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}] + #ML This should not happen + if {$denominator == 0} {return 0} + return [expr {(1.0*$numerator)/$denominator}] + } elseif {$format == 7} { + #ML + # undefined 8Bit + set value "" + if {$components < 4} { + set value [string range $offset 0 [expr {$components - 1}]] + } else { + set value [string range $data $offset [expr {$offset + $components - 1}]] + } + return $value } 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}]] + #ML This should not happen + if {$denominator == 0} {return 0} return [expr {(1.0*$numerator)/$denominator}] } else { set x [format %08x $format] - error "Invalid IFD entry format: $x" + #ML Return empty string is better than raising an error + debug "Invalid IFD entry format: $x" + return "" } } @@ -848,7 +1037,7 @@ # in these functions when "..." is the literal name # of a field to be returned. array set namelist {} - foreach proc {analyze app1 exifSubIFD makerNote} { + foreach proc {analyze app1 exifSubIFD makerNote_CANO makerNote_OLYM} { set body [info body ::exif::$proc] foreach line [split $body \n] { if {[regexp {result\(([^)]+)\)} $line junk name]} {