Tk Library Source Code

Artifact [1d90dd77ed]
Login

Artifact 1d90dd77ed2997d3c915f5d9f129a53dff47cbb0:

Attachment "exif-patch-unidiff.txt" to ticket [1161942fff] added by andreas_kupries 2005-09-07 02:56:02.
--- 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]} {