1# EXIF parser in Tcl 2# Author: Darren New <dnew@san.rr.com> 3# Translated directly from the Perl version 4# by Chris Breeze <chris@breezesys.com> 5# http://www.breezesys.com 6# See the original comment block, reproduced 7# at the bottom. 8# Most of the inline comments about the meanings of fields 9# are copied verbatim and without understanding from the 10# original, unless "DNew" is there. 11# Much of the structure is preserved, except in 12# makerNote, where I got tired of typing as verbosely 13# as the original Perl. But thanks for making it so 14# readable that even someone who doesn't know Perl 15# could translate it, Chris! ;-) 16# PLEASE read and understand exif::fieldnames 17# BEFORE making any changes here! Thanks! 18 19# Usage of this version: 20# exif::analyze $stream ?$thumbnail? 21# Stream should be an open file handle 22# rewound to the start. It gets set to 23# binary mode and is left at EOF or 24# possibly pointing at image data. 25# You have to open and close the 26# stream yourself. 27# The return is a serialized array 28# (a la [array get]) with informative 29# english text about what was found. 30# Errors in parsing or I/O or whatever 31# throw errors. 32# exif::allfields 33# returns a list of all possible field names. 34# Added by DNew. Funky implementation. 35# 36# New 37# exif::analyzeFile $filename ?$thumbnail? 38# 39# If you find any mistakes here, feel free to correct them 40# and/or send them to me. I just cribbed this - I don't even 41# have a camera that puts this kind of info into the file. 42 43# LICENSE: Standard BSD License. 44 45# There's probably something here I'm using without knowing it. 46package require Tcl 8.3 47 48package provide exif 1.1.2 ; # first release 49 50namespace eval ::exif { 51 namespace export analyze analyzeFile fieldnames 52 variable debug 0 ; # set to 1 for puts of debug trace 53 variable cameraModel ; # used internally to understand options 54 variable jpeg_markers ; # so we only have to do it once 55 variable intel ; # byte order - so we don't have to pass to every read 56 variable cached_fieldnames ; # just what it says 57 array set jpeg_markers { 58 SOF0 \xC0 59 DHT \xC4 60 SOI \xD8 61 EOI \xD9 62 SOS \xDA 63 DQT \xDB 64 DRI \xDD 65 APP1 \xE1 66 } 67} 68 69proc ::exif::debug {str} { 70 variable debug 71 if {$debug} {puts $str} 72} 73 74proc ::exif::streq {s1 s2} { 75 return [string equal $s1 $s2] 76} 77 78proc ::exif::analyzeFile {file {thumbnail {}}} { 79 set stream [open $file] 80 set res [analyze $stream $thumbnail] 81 close $stream 82 return $res 83} 84 85proc ::exif::analyze {stream {thumbnail {}}} { 86 variable jpeg_markers 87 array set result {} 88 fconfigure $stream -translation binary -encoding binary 89 while {![eof $stream]} { 90 set ch [read $stream 1] 91 if {1 != [string length $ch]} {error "End of file reached @1"} 92 if {![streq "\xFF" $ch]} {break} ; # skip image data 93 set marker [read $stream 1] 94 if {1 != [string length $marker]} {error "End of file reached @2"} 95 if {[streq $marker $jpeg_markers(SOI)]} { 96 debug "SOI" 97 } elseif {[streq $marker $jpeg_markers(EOI)]} { 98 debug "EOI" 99 } else { 100 set msb [read $stream 1] 101 set lsb [read $stream 1] 102 if {1 != [string length $msb] || 1 != [string length $lsb]} { 103 error "File truncated @1" 104 } 105 scan $msb %c msb ; scan $lsb %c lsb 106 set size [expr {256 * $msb + $lsb}] 107 set data [read $stream [expr {$size-2}]] 108 debug "read [expr {$size - 2}] bytes of data" 109 if {[expr {$size-2}] != [string length $data]} { 110 error "File truncated @2" 111 } 112 if {[streq $marker $jpeg_markers(APP1)]} { 113 debug "APP1\t$size" 114 array set result [app1 $data $thumbnail] 115 } elseif {[streq $marker $jpeg_markers(DQT)]} { 116 debug "DQT\t$size" 117 } elseif {[streq $marker $jpeg_markers(SOF0)]} { 118 debug "SOF0\t$size" 119 } elseif {[streq $marker $jpeg_markers(DHT)]} { 120 debug "DHT\t$size" 121 } elseif {[streq $marker $jpeg_markers(SOS)]} { 122 debug "SOS\t$size" 123 } else { 124 binary scan $marker H* x 125 debug "UNKNOWN MARKER $x" 126 } 127 } 128 } 129 return [array get result] 130} 131 132proc ::exif::app1 {data thumbnail} { 133 variable intel 134 variable cameraModel 135 array set result {} 136 if {![string equal [string range $data 0 5] "Exif\0\0"]} { 137 error "APP1 does not contain EXIF" 138 } 139 debug "Reading EXIF data" 140 set data [string range $data 6 end] 141 set t [string range $data 0 1] 142 if {[streq $t "II"]} { 143 set intel 1 144 debug "Intel byte alignment" 145 } elseif {[streq $t "MM"]} { 146 set intel 0 147 debug "Motorola byte alignment" 148 } else { 149 error "Invalid byte alignment: $t" 150 } 151 if {[readShort $data 2]!=0x002A} {error "Invalid tag mark"} 152 set curoffset [readLong $data 4] ; # just called "offset" in the Perl - DNew 153 debug "Offset to first IFD: $curoffset" 154 set numEntries [readShort $data $curoffset] 155 incr curoffset 2 156 debug "Number of directory entries: $numEntries" 157 for {set i 0} {$i < $numEntries} {incr i} { 158 set head [expr {$curoffset + 12 * $i}] 159 set entry [string range $data $head [expr {$head+11}]] 160 set tag [readShort $entry 0] 161 set format [readShort $entry 2] 162 set components [readLong $entry 4] 163 set offset [readLong $entry 8] 164 set value [readIFDEntry $data $format $components $offset] 165 if {$tag==0x010e} { 166 set result(ImageDescription) $value 167 } elseif {$tag==0x010f} { 168 set result(CameraMake) $value 169 } elseif {$tag==0x0110} { 170 set result(CameraModel) $value 171 set cameraModel $value 172 } elseif {$tag==0x0112} { 173 set result(Orientation) $value 174 } elseif {$tag == 0x011A} { 175 set result(XResolution) $value 176 } elseif {$tag == 0x011B} { 177 set result(YResolution) $value 178 } elseif {$tag == 0x0128} { 179 set result(ResolutionUnit) "unknown" 180 if {$value==2} {set result(ResolutionUnit) "inch"} 181 if {$value==3} {set result(ResolutionUnit) "centimeter"} 182 } elseif {$tag==0x0131} { 183 set result(Software) $value 184 } elseif {$tag==0x0132} { 185 set result(DateTime) $value 186 } elseif {$tag==0x0213} { 187 set result(YCbCrPositioning) "unknown" 188 if {$value==1} {set result(YCbCrPositioning) "Center of pixel array"} 189 if {$value==2} {set result(YCbCrPositioning) "Datum point"} 190 } elseif {$tag==0x8769} { 191 # EXIF sub IFD 192 debug "==CALLING exifSubIFD==" 193 array set result [exifSubIFD $data $offset] 194 } else { 195 debug "Unrecognized entry: Tag=$tag, value=$value" 196 } 197 } 198 set offset [readLong $data [expr {$curoffset + 12 * $numEntries}]] 199 debug "Offset to next IFD: $offset" 200 array set thumb_result [exifSubIFD $data $offset] 201 202 if {$thumbnail != {}} { 203 set jpg [string range $data \ 204 $thumb_result(JpegIFOffset) \ 205 [expr {$thumb_result(JpegIFOffset) + $thumb_result(JpegIFByteCount) - 1}]] 206 207 set to [open $thumbnail w] 208 fconfigure $to -translation binary -encoding binary 209 puts $to $jpg 210 close $to 211 212 #can be used (with a JPG-aware TK) to add the image to the result array 213 #set result(THUMB) [image create photo -file $thumbnail] 214 } 215 216 return [array get result] 217} 218 219# Extract EXIF sub IFD info 220proc ::exif::exifSubIFD {data curoffset} { 221 debug "EXIF: offset=$curoffset" 222 set numEntries [readShort $data $curoffset] 223 incr curoffset 2 224 debug "Number of directory entries: $numEntries" 225 for {set i 0} {$i < $numEntries} {incr i} { 226 set head [expr {$curoffset + 12 * $i}] 227 set entry [string range $data $head [expr {$head+11}]] 228 set tag [readShort $entry 0] 229 set format [readShort $entry 2] 230 set components [readLong $entry 4] 231 set offset [readLong $entry 8] 232 if {$tag==0x9000} { 233 set result(ExifVersion) [string range $entry 8 11] 234 } elseif {$tag==0x9101} { 235 set result(ComponentsConfigured) [format 0x%08x $offset] 236 } elseif {$tag == 0x927C} { 237 array set result [makerNote $data $offset] 238 } elseif {$tag == 0x9286} { 239 # Apparently, this doesn't usually work. 240 set result(UserComment) "$offset - [string range $data $offset [expr {$offset+8}]]" 241 set result(UserComment) [string trim $result(UserComment) "\0"] 242 } elseif {$tag==0xA000} { 243 set result(FlashPixVersion) [string range $entry 8 11] 244 } elseif {$tag==0xA300} { 245 # 3 means digital camera 246 if {$offset == 3} { 247 set result(FileSource) "3 - Digital camera" 248 } else { 249 set result(FileSource) $offset 250 } 251 } else { 252 set value [readIFDEntry $data $format $components $offset] 253 if {$tag==0x829A} { 254 if {0.3 <= $value} { 255 # In seconds... 256 set result(ExposureTime) "$value seconds" 257 } else { 258 set result(ExposureTime) "1/[expr {1.0/$value}] seconds" 259 } 260 } elseif {$tag == 0x829D} { 261 set result(FNumber) $value 262 } elseif {$tag == 0x8827} { 263 # D30 stores ISO here, G1 uses MakerNote Tag 1 field 16 264 set result(ISOSpeedRatings) $value 265 } elseif {$tag == 0x9003} { 266 set result(DateTimeOriginal) $value 267 } elseif {$tag == 0x9004} { 268 set result(DateTimeDigitized) $value 269 } elseif {$tag == 0x9102} { 270 if {$value == 5} { 271 set result(ImageQuality) "super fine" 272 } elseif {$value == 3} { 273 set result(ImageQuality) "fine" 274 } elseif {$value == 2} { 275 set result(ImageQuality) "normal" 276 } else { 277 set result(CompressedBitsPerPixel) $value 278 } 279 } elseif {$tag == 0x9201} { 280 # Not very accurate, use Exposure time instead. 281 # (That's Chris' comment. I don't know what it means.) 282 set value [expr {pow(2,$value)}] 283 if {$value < 4} { 284 set value [expr {1.0 / $value}] 285 set value [expr {int($value * 10 + 0.5) / 10.0}] 286 } else { 287 set value [expr {int($value + 0.49)}] 288 } 289 set result(ShutterSpeedValue) "$value Hz" 290 } elseif {$tag == 0x9202} { 291 set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}] 292 set result(AperatureValue) $value 293 } elseif {$tag == 0x9204} { 294 set value [compensationFraction $value] 295 set result(ExposureBiasValue) $value 296 } elseif {$tag == 0x9205} { 297 set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}] 298 } elseif {$tag == 0x9206} { 299 # May need calibration 300 set result(SubjectDistance) "$value m" 301 } elseif {$tag == 0x9207} { 302 set result(MeteringMode) "other" 303 if {$value == 0} {set result(MeteringMode) "unknown"} 304 if {$value == 1} {set result(MeteringMode) "average"} 305 if {$value == 2} {set result(MeteringMode) "center weighted average"} 306 if {$value == 3} {set result(MeteringMode) "spot"} 307 if {$value == 4} {set result(MeteringMode) "multi-spot"} 308 if {$value == 5} {set result(MeteringMode) "multi-segment"} 309 if {$value == 6} {set result(MeteringMode) "partial"} 310 } elseif {$tag == 0x9209} { 311 if {$value == 0} { 312 set result(Flash) no 313 } elseif {$value == 1} { 314 set result(Flash) yes 315 } else { 316 set result(Flash) "unknown: $value" 317 } 318 } elseif {$tag == 0x920a} { 319 set result(FocalLength) "$value mm" 320 } elseif {$tag == 0xA001} { 321 set result(ColorSpace) $value 322 } elseif {$tag == 0xA002} { 323 set result(ExifImageWidth) $value 324 } elseif {$tag == 0xA003} { 325 set result(ExifImageHeight) $value 326 } elseif {$tag == 0xA005} { 327 set result(ExifInteroperabilityOffset) $value 328 } elseif {$tag == 0xA20E} { 329 set result(FocalPlaneXResolution) $value 330 } elseif {$tag == 0xA20F} { 331 set result(FocalPlaneYResolution) $value 332 } elseif {$tag == 0xA210} { 333 set result(FocalPlaneResolutionUnit) "none" 334 if {$value == 2} {set result(FocalPlaneResolutionUnit) "inch"} 335 if {$value == 3} {set result(FocalPlaneResolutionUnit) "centimeter"} 336 } elseif {$tag == 0xA217} { 337 # 2 = 1 chip color area sensor 338 set result(SensingMethod) $value 339 } elseif {$tag == 0xA401} { 340 #TJE 341 set result(SensingMethod) "normal" 342 if {$value == 1} {set result(SensingMethod) "custom"} 343 } elseif {$tag == 0xA402} { 344 #TJE 345 set result(ExposureMode) "auto" 346 if {$value == 1} {set result(ExposureMode) "manual"} 347 if {$value == 2} {set result(ExposureMode) "auto bracket"} 348 } elseif {$tag == 0xA403} { 349 #TJE 350 set result(WhiteBalance) "auto" 351 if {$value == 1} {set result(WhiteBalance) "manual"} 352 } elseif {$tag == 0xA404} { 353 # digital zoom not used if number is zero 354 set result(DigitalZoomRatio) "not used" 355 if {$value != 0} {set result(DigitalZoomRatio) $value} 356 } elseif {$tag == 0xA405} { 357 set result(FocalLengthIn35mmFilm) "unknown" 358 if {$value != 0} {set result(FocalLengthIn35mmFilm) $value} 359 } elseif {$tag == 0xA406} { 360 set result(SceneCaptureType) "Standard" 361 if {$value == 1} {set result(SceneCaptureType) "Landscape"} 362 if {$value == 2} {set result(SceneCaptureType) "Portrait"} 363 if {$value == 3} {set result(SceneCaptureType) "Night scene"} 364 } elseif {$tag == 0xA407} { 365 set result(GainControl) "none" 366 if {$value == 1} {set result(GainControl) "Low gain up"} 367 if {$value == 2} {set result(GainControl) "High gain up"} 368 if {$value == 3} {set result(GainControl) "Low gain down"} 369 if {$value == 4} {set result(GainControl) "High gain down"} 370 } elseif {$tag == 0x0103} { 371 #TJE 372 set result(Compression) "unknown" 373 if {$value == 1} {set result(Compression) "none"} 374 if {$value == 6} {set result(Compression) "JPEG"} 375 } elseif {$tag == 0x011A} { 376 #TJE 377 set result(XResolution) $value 378 } elseif {$tag == 0x011B} { 379 #TJE 380 set result(YResolution) $value 381 } elseif {$tag == 0x0128} { 382 #TJE 383 set result(ResolutionUnit) "unknown" 384 if {$value == 1} {set result(ResolutionUnit) "inch"} 385 if {$value == 6} {set result(ResolutionUnit) "cm"} 386 } elseif {$tag == 0x0201} { 387 #TJE 388 set result(JpegIFOffset) $value 389 debug "offset = $value" 390 } elseif {$tag == 0x0202} { 391 #TJE 392 set result(JpegIFByteCount) $value 393 debug "bytecount = $value" 394 } else { 395 error "Unrecognized EXIF Tag: $tag (0x[string toupper [format %x $tag]])" 396 } 397 } 398 } 399 return [array get result] 400} 401 402# Canon proprietary data that I didn't feel like translating to Tcl yet. 403proc ::exif::makerNote {data curoffset} { 404 variable cameraModel 405 debug "MakerNote: offset=$curoffset" 406 407 array set result {} 408 set numEntries [readShort $data $curoffset] 409 incr curoffset 2 410 debug "Number of directory entries: $numEntries" 411 for {set i 0} {$i < $numEntries} {incr i} { 412 set head [expr {$curoffset + 12 * $i}] 413 set entry [string range $data $head [expr {$head+11}]] 414 set tag [readShort $entry 0] 415 set format [readShort $entry 2] 416 set components [readLong $entry 4] 417 set offset [readLong $entry 8] 418 debug "$i)\tTag: $tag, format: $format, components: $components" 419 420 if {$tag==6} { 421 set value [readIFDEntry $data $format $components $offset] 422 set result(ImageFormat) $value 423 } elseif {$tag==7} { 424 set value [readIFDEntry $data $format $components $offset] 425 set result(FirmwareVersion) $value 426 } elseif {$tag==8} { 427 set value [string range $offset 0 2]-[string range $offset 3 end] 428 set result(ImageNumber) $value 429 } elseif {$tag==9} { 430 set value [readIFDEntry $data $format $components $offset] 431 set result(Owner) $value 432 } elseif {$tag==0x0C} { 433 # camera serial number 434 set msw [expr {($offset >> 16) & 0xFFFF}] 435 set lsw [expr {$offset & 0xFFFF}] 436 set result(CameraSerialNumber) [format %04X%05d $msw $lsw] 437 } elseif {$tag==0x10} { 438 set result(UnknownTag-0x10) $offset 439 } else { 440 if {$format == 3 && 1 < $components} { 441 debug "MakerNote $i: TAG=$tag" 442 catch {unset field} 443 array set field {} 444 for {set j 0} {$j < $components} {incr j} { 445 set field($j) [readShort $data [expr {$offset+2*$j}]] 446 debug "$j : $field($j)" 447 } 448 if {$tag == 1} { 449 if {![string match -nocase "*Pro90*" $cameraModel]} { 450 if {$field(1)==1} { 451 set result(MacroMode) macro 452 } else { 453 set result(MacroMode) normal 454 } 455 } 456 if {0 < $field(2)} { 457 set result(SelfTimer) "[expr {$field(2)/10.0}] seconds" 458 } 459 set result(ImageQuality) [switch $field(3) { 460 2 {format Normal} 461 3 {format Fine} 462 4 {format "CCD Raw"} 463 5 {format "Super fine"} 464 default {format ""} 465 }] 466 set result(FlashMode) [switch $field(4) { 467 0 {format off} 468 1 {format auto} 469 2 {format on} 470 3 {format "red eye reduction"} 471 4 {format "slow synchro"} 472 5 {format "auto + red eye reduction"} 473 6 {format "on + red eye reduction"} 474 default {format ""} 475 }] 476 if {$field(5)} { 477 set result(ShootingMode) "Continuous" 478 } else { 479 set result(ShootingMode) "Single frame" 480 } 481 # Field 6 - don't know what it is. 482 set result(AutoFocusMode) [switch $field(7) { 483 0 {format "One-shot"} 484 1 {format "AI servo"} 485 2 {format "AI focus"} 486 3 - 6 {format "MF"} 487 5 {format "Continuous"} 488 4 { 489 # G1: uses field 32 to store single/continuous, 490 # and always sets 7 to 4. 491 if {[info exists field(32)] && $field(32)} { 492 format "Continuous" 493 } else { 494 format "Single" 495 } 496 } 497 default {format unknown} 498 }] 499 # Field 8 and 9 are unknown 500 set result(ImageSize) [switch $field(10) { 501 0 {format "large"} 502 1 {format "medium"} 503 2 {format "small"} 504 default {format "unknown"} 505 }] 506 # Field 11 - easy shooting - see field 20 507 # Field 12 - unknown 508 set NHL { 509 0 {format "Normal"} 510 1 {format "High"} 511 65536 {format "Low"} 512 default {format "Unknown"} 513 } 514 set result(Contrast) [switch $field(13) $NHL] 515 set result(Saturation) [switch $field(14) $NHL] 516 set result(Sharpness) [switch $field(15) $NHL] 517 set result(ISO) [switch $field(16) { 518 15 {format Auto} 519 16 {format 50} 520 17 {format 100} 521 18 {format 200} 522 19 {format 400} 523 default {format "unknown"} 524 }] 525 set result(MeteringMode) [switch $field(17) { 526 3 {format evaluative} 527 4 {format partial} 528 5 {format center-weighted} 529 default {format unknown} 530 }] 531 # Field 18 - unknown 532 if {[info exists field(19)]} { 533 set result(AFPoint) [switch -- [expr {$field(19)-0x3000}] { 534 0 {format none} 535 1 {format auto-selected} 536 2 {format right} 537 3 {format center} 538 4 {format left} 539 default {format unknown} 540 }] ; # {} 541 } 542 if {[info exists field(20)]} { 543 if {$field(20) == 0} { 544 set result(ExposureMode) [switch $field(11) { 545 0 {format auto} 546 1 {format manual} 547 2 {format landscape} 548 3 {format "fast shutter"} 549 4 {format "slow shutter"} 550 5 {format "night scene"} 551 6 {format "black and white"} 552 7 {format sepia} 553 8 {format portrait} 554 9 {format sports} 555 10 {format close-up} 556 11 {format "pan focus"} 557 default {format unknown} 558 }] ; # {} 559 } elseif {$field(20) == 1} { 560 set result(ExposureMode) program 561 } elseif {$field(20) == 2} { 562 set result(ExposureMode) Tv 563 } elseif {$field(20) == 3} { 564 set result(ExposureMode) Av 565 } elseif {$field(20) == 4} { 566 set result(ExposureMode) manual 567 } elseif {$field(20) == 5} { 568 set result(ExposureMode) A-DEP 569 } else { 570 set result(ExposureMode) unknown 571 } 572 } 573 # Field 21 and 22 are unknown 574 # Field 23: max focal len, 24 min focal len, 25 units per mm 575 if {[info exists field(23)] && [info exists field(25)]} { 576 set result(MaxFocalLength) \ 577 "[expr {1.0 * $field(23) / $field(25)}] mm" 578 } 579 if {[info exists field(24)] && [info exists field(25)]} { 580 set result(MinFocalLength) \ 581 "[expr {1.0 * $field(24) / $field(25)}] mm" 582 } 583 # Field 26-28 are unknown. 584 if {[info exists field(29)]} { 585 if {$field(29) & 0x0010} { 586 lappend result(FlashMode) "FP_sync_enabled" 587 } 588 if {$field(29) & 0x0800} { 589 lappend result(FlashMode) "FP_sync_used" 590 } 591 if {$field(29) & 0x2000} { 592 lappend result(FlashMode) "internal_flash" 593 } 594 if {$field(29) & 0x4000} { 595 lappend result(FlashMode) "external_E-TTL" 596 } 597 } 598 if {[info exists field(34)] && \ 599 [string match -nocase "*pro90*" $cameraModel]} { 600 if {$field(34)} { 601 set result(ImageStabilisation) on 602 } else { 603 set result(ImageStabilisation) off 604 } 605 } 606 } elseif {$tag == 4} { 607 set result(WhiteBalance) [switch $field(7) { 608 0 {format Auto} 609 1 {format Daylight} 610 2 {format Cloudy} 611 3 {format Tungsten} 612 4 {format Fluorescent} 613 5 {format Flash} 614 6 {format Custom} 615 default {format Unknown} 616 }] 617 if {$field(14) & 0x07} { 618 set result(AFPointsUsed) \ 619 [expr {($field(14)>>12) & 0x0F}] 620 if {$field(14)&0x04} { 621 append result(AFPointsUsed) " left" 622 } 623 if {$field(14)&0x02} { 624 append result(AFPointsUsed) " center" 625 } 626 if {$field(14)&0x01} { 627 append result(AFPointsUsed) " right" 628 } 629 } 630 if {[info exists field(15)]} { 631 set v $field(15) 632 if {32768 < $v} {incr v -65536} 633 set v [compensationFraction [expr {$v / 32.0}]] 634 set result(FlashExposureCompensation) $v 635 } 636 if {[info exists field(19)]} { 637 set result(SubjectDistance) "$field(19) m" 638 } 639 } elseif {$tag == 15} { 640 foreach k [array names field] { 641 set func [expr {($field($k) >> 8) & 0xFF}] 642 set v [expr {$field($k) & 0xFF}] 643 if {$func==1 && $v} { 644 set result(LongExposureNoiseReduction) on 645 } elseif {$func==1 && !$v} { 646 set result(LongExposureNoiseReduction) off 647 } elseif {$func==2} { 648 set result(Shutter/AE-Lock) [switch $v { 649 0 {format "AF/AE lock"} 650 1 {format "AE lock/AF"} 651 2 {format "AF/AF lock"} 652 3 {format "AE+release/AE+AF"} 653 default {format "Unknown"} 654 }] 655 } elseif {$func==3} { 656 if {$v} { 657 set result(MirrorLockup) enable 658 } else { 659 set result(MirrorLockup) disable 660 } 661 } elseif {$func==4} { 662 if {$v} { 663 set result(Tv/AvExposureLevel) "1/3 stop" 664 } else { 665 set result(Tv/AvExposureLevel) "1/2 stop" 666 } 667 } elseif {$func==5} { 668 if {$v} { 669 set result(AFAssistLight) off 670 } else { 671 set result(AFAssistLight) on 672 } 673 } elseif {$func==6} { 674 if {$v} { 675 set result(ShutterSpeedInAVMode) "Fixed 1/200" 676 } else { 677 set result(ShutterSpeedInAVMode) "Auto" 678 } 679 } elseif {$func==7} { 680 set result(AEBSeq/AutoCancel) [switch $v { 681 0 {format "0, -, + enabled"} 682 1 {format "0, -, + disabled"} 683 2 {format "-, 0, + enabled"} 684 3 {format "-, 0, + disabled"} 685 default {format unknown} 686 }] 687 } elseif {$func==8} { 688 if {$v} { 689 set result(ShutterCurtainSync) "2nd curtain sync" 690 } else { 691 set result(ShutterCurtainSync) "1st curtain sync" 692 } 693 } elseif {$func==9} { 694 set result(LensAFStopButtonFnSwitch) [switch $v { 695 0 {format "AF stop"} 696 1 {format "operate AF"} 697 2 {format "lock AE and start timer"} 698 default {format unknown} 699 }] 700 } elseif {$func==10} { 701 if {$v} { 702 set result(AutoReductionOfFillFlash) disable 703 } else { 704 set result(AutoReductionOfFillFlash) enable 705 } 706 } elseif {$func==11} { 707 if {$v} { 708 set result(MenuButtonReturnPosition) previous 709 } else { 710 set result(MenuButtonReturnPosition) top 711 } 712 } elseif {$func==12} { 713 set result(SetButtonFuncWhenShooting) [switch $v { 714 0 {format "not assigned"} 715 1 {format "change quality"} 716 2 {format "change ISO speed"} 717 3 {format "select parameters"} 718 default {format unknown} 719 }] 720 } elseif {$func==13} { 721 if {$v} { 722 set result(SensorCleaning) enable 723 } else { 724 set result(SensorCleaning) disable 725 } 726 } elseif {$func==0} { 727 # Discovered by DNew? 728 set result(CameraOwner) $v 729 } else { 730 append result(UnknownCustomFunc) "$func=$v " 731 } 732 } 733 } 734 } else { 735 debug [format "makerNote: Unrecognized TAG: 0x%x" $tag] 736 } 737 } 738 } 739 return [array get result] 740} 741 742proc ::exif::readShort {data offset} { 743 variable intel 744 if {[string length $data] < [expr {$offset+2}]} { 745 error "readShort: end of string reached" 746 } 747 set ch1 [string index $data $offset] 748 set ch2 [string index $data [expr {$offset+1}]] 749 scan $ch1 %c ch1 ; scan $ch2 %c ch2 750 if {$intel} { 751 return [expr {$ch1 + 256 * $ch2}] 752 } else { 753 return [expr {$ch2 + 256 * $ch1}] 754 } 755} 756 757proc ::exif::readLong {data offset} { 758 variable intel 759 if {[string length $data] < [expr {$offset+4}]} { 760 error "readLong: end of string reached" 761 } 762 set ch1 [string index $data $offset] 763 set ch2 [string index $data [expr {$offset+1}]] 764 set ch3 [string index $data [expr {$offset+2}]] 765 set ch4 [string index $data [expr {$offset+3}]] 766 scan $ch1 %c ch1 ; scan $ch2 %c ch2 767 scan $ch3 %c ch3 ; scan $ch4 %c ch4 768 if {$intel} { 769 return [expr {(((($ch4 * 256) + $ch3) * 256) + $ch2) * 256 + $ch1}] 770 } else { 771 return [expr {(((($ch1 * 256) + $ch2) * 256) + $ch3) * 256 + $ch4}] 772 } 773} 774 775proc ::exif::readIFDEntry {data format components offset} { 776 variable intel 777 if {$format == 2} { 778 # ASCII string 779 set value [string range $data $offset [expr {$offset+$components-1}]] 780 return [string trimright $value "\0"] 781 } elseif {$format == 3} { 782 # unsigned short 783 if {!$intel} { 784 set offset [expr {0xFFFF & ($offset >> 16)}] 785 } 786 return $offset 787 } elseif {$format == 4} { 788 # unsigned long 789 return $offset 790 } elseif {$format == 5} { 791 # unsigned rational 792 # This could be messy, if either is >2**31 793 set numerator [readLong $data $offset] 794 set denominator [readLong $data [expr {$offset + 4}]] 795 return [expr {(1.0*$numerator)/$denominator}] 796 } elseif {$format == 10} { 797 # signed rational 798 # Should work normally, since everything in Tcl is signed 799 set numerator [readLong $data $offset] 800 set denominator [readLong $data [expr {$offset + 4}]] 801 return [expr {(1.0*$numerator)/$denominator}] 802 } else { 803 set x [format %08x $format] 804 error "Invalid IFD entry format: $x" 805 } 806} 807 808proc ::exif::compensationFraction {value} { 809 if {$value==0} {return 0} 810 if {$value < 0} { 811 set result "-" 812 set value [expr {0-$value}] 813 } else { 814 set result "+" 815 } 816 set value [expr {int(0.5 + $value * 6)}] 817 set integer [expr {int($value / 6)}] 818 set sixths [expr {$value % 6}] 819 if {$integer != 0} { 820 append result $integer 821 if {$sixths != 0} { 822 append result " " 823 } 824 } 825 if {$sixths == 2} { 826 append result "1/3" 827 } elseif {$sixths == 3} { 828 append result "1/2" 829 } elseif {$sixths == 4} { 830 append result "2/3" 831 } else { 832 # Added by DNew 833 append result "$sixths/6" 834 } 835 return $result 836} 837 838# This returns the list of all possible fieldnames 839# that analyze might return. 840proc ::exif::fieldnames {} { 841 variable cached_fieldnames 842 if {[info exists cached_fieldnames]} { 843 return $cached_fieldnames 844 } 845 # Otherwise, parse the source to find the fieldnames. 846 # Cool, huh? Don'tcha just love Tcl? 847 # Because of this, "result(...)" should only appear 848 # in these functions when "..." is the literal name 849 # of a field to be returned. 850 array set namelist {} 851 foreach proc {analyze app1 exifSubIFD makerNote} { 852 set body [info body ::exif::$proc] 853 foreach line [split $body \n] { 854 if {[regexp {result\(([^)]+)\)} $line junk name]} { 855 set namelist($name) {} 856 } 857 } 858 } 859 set cached_fieldnames [lsort -dictionary [array names namelist]] 860 return $cached_fieldnames 861} 862 863 864 865# # # # # # # # # # # # # # 866# What follows is the original header comments 867# from the Perl code from which this is 868# translated. Any changes I made directly 869# are marked by "DNew". 870 871# PERL script to extract EXIF information from JPEGs generated by Canon 872# digital cameras. 873# This software is free and you may do anything like with it except sell it. 874# 875# Current version: 1.3 876# Author: Chris Breeze 877# email: chris@breezesys.com 878# Web: http://www.breezesys.com 879# 880# Based on experimenting with my G1 and information from: 881# http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html 882# 883# Also Canon MakerNote from David Burren's page: 884# http://www.burren.cx/david/canon.html 885# 886# More EXIF info and specs: 887# http://exif.org 888# 889# Warnings: 890# 1) The Subject distance is unreliable. It seems reasonably accurate 891# for the G1 but on the D30 it is highly dependent on the lens fitted. 892# 893# Perl for Windows is available for free from: 894# http://www.activestate.com 895# 896# History 897# 11 Jan 2001 898# v0.1: Initial version 899# 900# 14 Jan 2001 901# v0.2: Updated with data from David Burren's page 902# 903# 15 Jan 2001 904# v0.3: Added more info for D30 (supplied by David Burren) 905# 1) D30 stores ISO in EXIF tag 0x8827, G1 uses MakerNote 0x1/16 906# 2) MakerNote 0x1/10, ImageSize appears to be large, medium, small 907# 3) D30 allows 1/2 or 1/3 stop exposure compensation 908# 4) Added D30 custom function details, but can't test them 909# 910# 17 Jan 2001 911# v1.0 Tidied up AutoFocusMode for G1 vs D30 + added manual auto focus point (D30) 912# 913# 18 Jan 2001 914# v1.1 Removed some debug code left in by mistake 915# 916# 29 Jan 2001 917# v1.2 Added flash mode (MakerNote Tag 1, field 4) 918# 919# 7 Mar 2001 920# v1.3 Added ImageQuality (MakerNote Tag 1, field 3) 921# 922# 21 Apr 2001 923# v1.4 added ImageStabilisation for Pro90 IS 924# 925# 17 Sep 2001 926# v1.5 Incorporated D30 improvements from Jim Leonard 927 928if {0} { 929 # Trivial usage example 930 set x [exif::fieldnames] 931 puts "fieldnames = $x" 932 set f [open [lindex $argv 0]] 933 array set v [exif::analyze $f] 934 close $f 935 parray v 936} 937 938