# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*- # -- Tcl Module # @@ Meta Begin # Package jpeg 0.4.0 # Meta as::build::date 2013-10-29 # Meta as::origin http://sourceforge.net/projects/tcllib # Meta category JPEG image manipulation # Meta description JPEG querying and manipulation of meta data # Meta license BSD # Meta platform tcl # Meta require {Tcl 8.2} # Meta subject thumbnail exif jpeg jfif image comment # Meta summary jpeg # @@ Meta End # ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS package require Tcl 8.2 # ACTIVESTATE TEAPOT-PKG END REQUIREMENTS # ACTIVESTATE TEAPOT-PKG BEGIN DECLARE package provide jpeg 0.4.0 # ACTIVESTATE TEAPOT-PKG END DECLARE # ACTIVESTATE TEAPOT-PKG END TM # jpeg.tcl -- # # Querying and modifying JPEG image files. # # Copyright (c) 2004 Aaron Faupell # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: jpeg.tcl,v 1.19 2011/05/06 13:39:27 patthoyts Exp $ # ### ### ### ######### ######### ######### ## Requisites namespace eval ::jpeg {} # ### ### ### ######### ######### ######### ## Notes :: Structure of jpeg files. # Base types # # BYTE = 1 byte # SHORT = 2 bytes, endianess determined by context. # BESHORT = 2 bytes, big endian # INT = 4 bytes, endianess determined by context. # JPEG types # # JPEG = < # BYTE [2] == 0xFF 0xD8 (SOI (Start Of Image)) # JSEGMENT [.] 1 or more jpeg segments, variadic size # BYTE [2] == 0xFF 0xD9 (EOI (End Of Image)) # > # # JSEGMENT = < # BYTE [1] == 0xFF # BYTE [1] Segment Tag, type marker # BESHORT [1] Segment Length N # BYTE [N-2] Segment Data, interpreted dependent on tag. # > # # Notable segments, and their structure. # # Comment = JSEGMENT (Tag = 0xFE, Data = < # # >) # Type 0xFE (Comment) # Data BYTE [ ] # Note: Multiple comment segments are allowed. # Type 0xC0/0xC1/0xC2/0xC3 (Start of Frame) # Data BYTE [1] Precision # BESHORT [1] Height # BESHORT [1] Width # BYTE [1] Number of color components # ... # Type 0xEx (x=0-9A-F) (App0 - App15) # Data It is expected that the data starts with a checkable marker, as # the app segments can be used by multiple applications for # different purposes. I.e. a sub-type is needed before the # segment data can be processed. # App0/JFIF image info # Type 0xE0 # Data BYTE [5] 'JFIF\0' JFIF sub-type marker # BYTE [1] Version1 (major) # BYTE [1] Version2 (minor) # BYTE [1] Units # BESHORT [1] X-density (dots per inch ?) # BESHORT [1] Y-density # BYTE [1] X-thumb (Width of thumbnail, if any, or zero) # BYTE [1] Y-thumb (Height of thumbnail, if any, or zero) # App0/JFXX extended image information # Type 0xE0 # Data BYTE [5] 'JFXX\0' JFXX sub-type marker # BYTE [1] Extension code 10 -> JPEG thumbnail # 11 -> Palletized thumbnail # 13 -> RGB thumbnail # BYTE [ ] Data per the extension code. # App1/EXIF # Type 0xE1 # Data BYTE [6] 'Exif\0\0' EXIF sub-type marker. (1) # BYTE [2] Byte Order 0x4d 0x4d = big endian # or 0x49 0x49 = small endian # SHORT [1] Magic == 42 under the specified byteorder. # INT [1] Next == Offset to the first actual EXIF data block. # # EXIF data block structure (IFD = Image File Directory) # # 1. SHORT [1] Number N of exif entries # 2. ENTRY [N] Array of exif entries # 3. INT [1] Offset to the next EXIF data block, or <0 for the last block. # # exif ENTRY structure # # 1. SHORT [1] num # 2. SHORT [1] tag = exif key # 3. SHORT [1] format # 4. INT [1] component # 5. INT [1] value # The 'value is interpreted dependent on the values of tag, format, # and component. # # A. Tag in ( 0x8769, 0xA005 ) # Value is offset to a subordinate exif data block, process recursively. # B. Size = components * sizeof(format) # B1. Size > 4 # Value is offset to the actual value. # B2. Size <= 4 # Value is the actual value. # Usually a jpeg with exif information has two exif data blocks. The # first is the main block, the second the thumbnail block. # # Note that all the exif data structures are within the app1/exif # segment. # # (1) The offset of the first byte after the exif marker is what all # the offsets in exif are relative to. # Type 0xDA (SOS, Start of Stream/Scan) # Followed by the JPEG data. Last segment before EOI # ### ### ### ######### ######### ######### # open a file, check jpeg signature, and a return a file handle # at the start of the first marker proc ::jpeg::openJFIF {file {mode r}} { set fh [open $file $mode] fconfigure $fh -encoding binary -translation binary -eofchar {} # jpeg sig is FFD8, FF is start of first marker if {[read $fh 3] != "\xFF\xD8\xFF"} { close $fh; return -code error "not a jpg file" } # rewind to first marker seek $fh -1 current return $fh } # return a boolean indicating if a file starts with the jpeg sig proc ::jpeg::isJPEG {file} { set is [catch {openJFIF $file} fh] catch {close $fh} return [expr {!$is}] } # takes an open filehandle at the start of a jpeg marker, and returns a list # containing information about the file markers in the jpeg file. each list # element itself a list of the marker type, offset of the start of its data, # and the length of its data. proc ::jpeg::markers {fh} { set chunks [list] while {[read $fh 1] == "\xFF"} { binary scan [read $fh 3] H2S type len # convert to unsigned set len [expr {$len & 0x0000FFFF}] # decrement len to account for marker bytes incr len -2 lappend chunks [list $type [tell $fh] $len] seek $fh $len current } # chunks = list (list (type offset length) ...) return $chunks } proc ::jpeg::imageInfo {file} { set fh [openJFIF $file r] set data {} if {[set app0 [lsearch -inline [markers $fh] "e0 *"]] != ""} { seek $fh [lindex $app0 1] start set id [read $fh 5] if {$id == "JFIF\x00"} { binary scan [read $fh 9] cccSScc ver1 ver2 units xr yr xt yt set data [list version $ver1.$ver2 units $units xdensity $xr ydensity $yr xthumb $xt ythumb $yt] } } close $fh return $data } # return an images dimensions by reading the Start Of Frame marker proc ::jpeg::dimensions {file} { set fh [openJFIF $file] set sof [lsearch -inline [markers $fh] {c[0-3] *}] seek $fh [lindex $sof 1] start binary scan [read $fh 5] cSS precision height width close $fh return [list $width $height] } # returns a list of all comments (FE segments) in the file proc ::jpeg::getComments {file} { set fh [openJFIF $file] set comments {} foreach x [lsearch -all -inline [markers $fh] "fe *"] { seek $fh [lindex $x 1] start lappend comments [read $fh [lindex $x 2]] } close $fh return $comments } # add a new comment to the file proc ::jpeg::addComment {file comment args} { set fh [openJFIF $file r+] # find the SoF and save all data after it set sof [lsearch -inline [markers $fh] {c[0-3] *}] seek $fh [expr {[lindex $sof 1] - 4}] start set data2 [read $fh] # seek back to the SoF and write comment(s) segment seek $fh [expr {[lindex $sof 1] - 4}] start foreach x [linsert $args 0 $comment] { if {$x == ""} continue puts -nonewline $fh [binary format a2Sa* "\xFF\xFE" [expr {[string length $x] + 2}] $x] } # write the saved data bac puts -nonewline $fh $data2 close $fh } proc ::jpeg::replaceComment {file comment} { set com [getComments $file] removeComments $file eval [list addComment $file] [lreplace $com 0 0 $comment] } # removes all comment segments from the file proc ::jpeg::removeComments {file} { set fh [openJFIF $file] set data "\xFF\xD8" foreach marker [markers $fh] { if {[lindex $marker 0] != "fe"} { # seek back 4 bytes to include the marker and length bytes seek $fh [expr {[lindex $marker 1] - 4}] start append data [read $fh [expr {[lindex $marker 2] + 4}]] } } append data [read $fh] close $fh set fh [open $file w] fconfigure $fh -encoding binary -translation binary -eofchar {} puts -nonewline $fh $data close $fh } # rewrites a jpeg file and removes all metadata (comments, exif, photoshop) proc ::jpeg::stripJPEG {file} { set fh [openJFIF $file] set data {} set markers [markers $fh] # look for a jfif header segment and save it if {[lindex $markers 0 0] == "e0"} { seek $fh [lindex $markers 0 1] start if {[read $fh 5] == "JFIF\x00"} { seek $fh -9 current set jfif [read $fh [expr {[lindex $markers 0 2] + 4}]] } } # if we dont have a jfif header (exif files), create a fake one if {![info exists jfif]} { set jfif [binary format a2Sa5cccSScc "\xFF\xE0" 16 "JFIF\x00" 1 2 1 72 72 0 0] } # remove all the e* and f* markers (metadata) foreach marker $markers { if {![string match {[ef]*} [lindex $marker 0]]} { seek $fh [expr {[lindex $marker 1] - 4}] start append data [read $fh [expr {[lindex $marker 2] + 4}]] } } append data [read $fh] close $fh set fh [open $file w+] fconfigure $fh -encoding binary -translation binary -eofchar {} # write a jpeg file sig, a jfif header, and all the remaining data puts -nonewline $fh \xFF\xD8$jfif$data close $fh } # if file contains a jpeg thumbnail return it. the returned data is the actual # jpeg data, it can be written directly to a file proc ::jpeg::getThumbnail {file} { # check if the exif information contains a thumbnail array set exif [getExif $file thumbnail] if {[info exists exif(Compression)] && \ $exif(Compression) == 6 && \ [info exists exif(JPEGInterchangeFormat)] && \ [info exists exif(JPEGInterchangeFormatLength)]} { set fh [openJFIF $file] seek $fh [expr {$exif(ExifOffset) + $exif(JPEGInterchangeFormat)}] start set thumb [read $fh $exif(JPEGInterchangeFormatLength)] close $fh return $thumb } # check for a JFXX segment which contains a thumbnail set fh [openJFIF $file] foreach x [lsearch -inline -all [markers $fh] "e0 *"] { seek $fh [lindex $x 1] start binary scan [read $fh 6] a5H2 id excode # excode 10 is jpeg encoding, we cant interpret the other types if {$id == "JFXX\x00" && $excode == "10"} { set thumb [read $fh [expr {[lindex $x 2] - 6}]] close $fh return $thumb } } close $fh } # takes key-value pairs returned by getExif and converts their values into # human readable format proc ::jpeg::formatExif {exif} { variable exif_values set out {} foreach {tag val} $exif { if {[info exists exif_values($tag,$val)]} { set val $exif_values($tag,$val) } elseif {[info exists exif_values($tag,)]} { set val $exif_values($tag,) } else { switch -exact -- $tag { UserComment {set val [string trim [string range $val 8 end] \x00]} ComponentsConfiguration {binary scan $val cccc a b c d; set val $a,$b,$c,$d} ExifVersion {set val [expr [string range $val 0 1].[string range $val 2 3]]} FNumber {set val [format %2.1f $val]} MaxApertureValue - ApertureValue { if {$val > 0} { set val [format %2.1f [expr {2 * (log($val) / log(2))}]] } } ShutterSpeedValue { set val [expr {pow(2, $val)}] if {abs(round($val) - $val) < 0.2} {set val [expr {round($val)}]} set val 1/[string trimright [string trimright [format %.2f $val] 0] .] } ExposureTime { set val 1/[string trimright [string trimright [format %.4f [expr {1 / $val}]] 0] .] } } } lappend out $tag $val } return $out } # returns a list of all known exif keys proc ::jpeg::exifKeys {} { variable exif_tags set ret {} foreach {x y} [array get exif_tags] {lappend ret $y} return $ret } proc ::jpeg::getExif {file {type main}} { set fh [openJFIF $file] set r [catch {getExifFromChannel $fh $type} err] close $fh return -code $r $err } proc ::jpeg::getExifFromChannel {chan {type main}} { # foreach because file may have multiple e1 markers foreach app1 [lsearch -inline -all [markers $chan] "e1 *"] { seek $chan [lindex $app1 1] start # check that this e1 is really an Exif segment if {[read $chan 6] != "Exif\x00\x00"} continue # save offset because exif offsets are relative to this set start [tell $chan] # next 2 bytes determine byte order binary scan [read $chan 2] H4 byteOrder if {$byteOrder == "4d4d"} { set byteOrder big } elseif {$byteOrder == "4949"} { set byteOrder little } else { return -code error "invalid byte order magic" } # the answer is 42, if we have our byte order correct _scan $byteOrder [read $chan 6] si magic next if {$magic != 42} { return -code error "invalid byte order"} seek $chan [expr {$start + $next}] start if {$type != "thumbnail"} { if {$type != "main"} { return -code error "Bad type \"$type\", expected one of \"main\", or \"thumbnail\"" } set data [_exif $chan $byteOrder $start] } else { # number of entries in this exif block _scan $byteOrder [read $chan 2] s num # each entry is 12 bytes seek $chan [expr {$num * 12}] current # offset of next exif block (for thumbnail) _scan $byteOrder [read $chan 4] i next if {$next <= 0} { close $chan; return } # but its relative to start seek $chan [expr {$start + $next}] start set data [_exif $chan $byteOrder $start] } lappend data ExifOffset $start ExifByteOrder $byteOrder return $data } return } proc ::jpeg::removeExif {file} { set fh [openJFIF $file] set data {} set markers [markers $fh] if {[lsearch $markers "e1 *"] < 0} { close $fh; return } foreach marker $markers { if {[lindex $marker 0] != "e1"} { seek $fh [expr {[lindex $marker 1] - 4}] start append data [read $fh [expr {[lindex $marker 2] + 4}]] } else { seek $fh [lindex $marker 1] start if {[read $fh 6] == "Exif\x00\x00"} continue seek $fh -10 current append data [read $fh [expr {[lindex $marker 2] + 4}]] } } append data [read $fh] close $fh set fh [open $file w] fconfigure $fh -encoding binary -translation binary -eofchar {} puts -nonewline $fh "\xFF\xD8" if {[lindex $markers 0 0] != "e0"} { puts -nonewline $fh [binary format a2Sa5cccSScc "\xFF\xE0" 16 "JFIF\x00" 1 2 1 72 72 0 0] } puts -nonewline $fh $data close $fh } proc ::jpeg::_exif2 {data} { variable exif_tags set byteOrder little set start 0 set i 2 for {_scan $byteOrder $data @0s num} {$num > 0} {incr num -1} { binary scan $data @${i}H2H2 t1 t2 if {$byteOrder == "big"} { set tag $t1$t2 } else { set tag $t2$t1 } incr i 2 _scan $byteOrder $data @${i}si format components incr i 6 set value [string range $data $i [expr {$i + 3}]] if {$tag == "8769" || $tag == "a005"} { _scan $byteOrder $value i next #set pos [tell $fh] #seek $fh [expr {$offset + $next}] start #eval lappend return [_exif $fh $byteOrder $offset] #seek $fh $pos start continue } if {![info exists exif_formats($format)]} continue if {[info exists exif_tags($tag)]} { set tag $exif_tags($tag) } set size [expr {$exif_formats($format) * $components}] if {$size > 4} { _scan $byteOrder $value i value #puts "$value" #set value [string range $data [expr {$i + $offset + $value}] [expr {$size - 1}]] } lappend ret $tag [_format $byteOrder $value $format $components] } } # reads an exif block and returns key-value pairs proc ::jpeg::_exif {fh byteOrder offset {tag_info exif_tags}} { variable exif_formats variable exif_tags variable gps_tags set return {} for {_scan $byteOrder [read $fh 2] s num} {$num > 0} {incr num -1} { binary scan [read $fh 2] H2H2 t1 t2 _scan $byteOrder [read $fh 6] si format components if {$byteOrder == "big"} { set tag $t1$t2 } else { set tag $t2$t1 } set value [read $fh 4] # special tags, they point to more exif blocks if {$tag == "8769" || $tag == "a005"} { _scan $byteOrder $value i next set pos [tell $fh] seek $fh [expr {$offset + $next}] start eval lappend return [_exif $fh $byteOrder $offset] seek $fh $pos start continue } # special tag, another exif block holding GPS/location information. if {$tag == "8825"} { _scan $byteOrder $value i next set pos [tell $fh] seek $fh [expr {$offset + $next}] start eval lappend return [_exif $fh $byteOrder $offset gps_tags] seek $fh $pos start continue } if {![info exists exif_formats($format)]} continue upvar 0 $tag_info thetags if {[info exists thetags($tag)]} { set tag $thetags($tag) } set size [expr {$exif_formats($format) * $components}] # if the data is over 4 bytes, its stored later in the file, with the # data being the offset relative to the exif header if {$size > 4} { set pos [tell $fh] _scan $byteOrder $value i value seek $fh [expr {$offset + $value}] start set value [read $fh $size] seek $fh $pos start } lappend return $tag [_format $byteOrder $value $format $components] } return $return } proc ::jpeg::MakerNote {offset byteOrder Make data} { if {$Make == "Canon"} { set data [MakerNoteCanon $offset $byteOrder $data] } elseif {[string match Nikon* $data] || $Make == "NIKON"} { set data [MakerNoteNikon $offset $byteOrder $data] } elseif {[string match FUJIFILM* $data]} { set data [MakerNoteFuji $offset $byteOrder $data] } elseif {[string match OLYMP* $data]} { set data [MakerNoteOlympus $offset $byteOrder $data] } return $data } proc ::jpeg::MakerNoteNikon {offset byteOrder data} { variable exif_formats set return {} if {[string match Nikon* $data]} { set i 8 } else { set i 0 } binary scan $data @8s num incr i 2 puts [expr {($num * 12) + $i}] puts [string range $data 142 150] #exit for {} {$num > 0} {incr num -1} { binary scan $data @${i}H2H2 t1 t2 if {$byteOrder == "big"} { set tag $t1$t2 } else { set tag $t2$t1 } incr i 2 _scan $byteOrder $data @${i}si format components incr i 6 set value [string range $data $i [expr {$i + 3}]] if {![info exists exif_formats($format)]} continue #if {[info exists exif_tags($tag)]} { set tag $exif_tags($tag) } set size [expr {$exif_formats($format) * $components}] if {$size > 4} { _scan $byteOrder $value i value puts "$value" set value 1 #set value [string range $data [expr {$i + $offset + $value}] [expr {$size - 1}]] } else { lappend ret $tag [_format $byteOrder $value $format $components] } puts "$tag $format $components $value" } return $return } proc ::jpeg::debug {file} { set fh [openJFIF $file] puts "marker: d8 length: 0" puts " SOI (Start Of Image)" foreach marker [markers $fh] { seek $fh [lindex $marker 1] puts "marker: [lindex $marker 0] length: [lindex $marker 2]" switch -glob -- [lindex $marker 0] { c[0-3] { binary scan [read $fh 6] cSSc precision height width color puts " SOF (Start Of Frame) [string map {c0 "Baseline" c1 "Non-baseline" c2 "Progressive" c3 "Lossless"} [lindex $marker 0]]" puts " Image dimensions: $width $height" puts " Precision: $precision" puts " Color Components: $color" } c4 { puts " DHT (Define Huffman Table)" binary scan [read $fh 17] cS bits symbols puts " $symbols symbols" } da { puts " SOS (Start Of Scan)" binary scan [read $fh 2] c num puts " Components: $num" } db { puts " DQT (Define Quantization Table)" } dd { puts " DRI (Define Restart Interval)" binary scan [read $fh 2] S num puts " Interval: $num blocks" } e0 { set id [read $fh 5] if {$id == "JFIF\x00"} { puts " JFIF" binary scan [read $fh 9] cccSScc ver1 ver2 units xr vr xt yt puts " Header: $ver1.$ver2 $units $xr $vr $xt $yt" } elseif {$id == "JFXX\x00"} { puts " JFXX (JFIF Extension)" binary scan [read $fh 1] H2 excode if {$excode == "10"} { set excode "10 (JPEG thumbnail)" } if {$excode == "11"} { set excode "11 (Palletized thumbnail)" } if {$excode == "13"} { set excode "13 (RGB thumbnail)" } puts " Extension code: 0x$excode" } else { puts " Unknown APP0 segment: $id" } } e1 { if {[read $fh 6] == "Exif\x00\x00"} { puts " EXIF data" puts " MAIN EXIF" foreach {x y} [getExif $file] { puts " $x $y" } puts " THUMBNAIL EXIF" foreach {x y} [getExif $file thumbnail] { puts " $x $y" } } else { puts " APP1 (unknown)" } } e2 { if {[read $fh 12] == "ICC_PROFILE\x00"} { puts " ICC profile" } else { puts " APP2 (unknown)" } } ed { if {[read $fh 18] == "Photoshop 3.0\0008BIM"} { puts " Photoshop 8BIM data" } else { puts " APP13 (unknown)" } } ee { if {[read $fh 5] == "Adobe"} { puts " Adobe metadata" } else { puts " APP14 (unknown)" } } e[3456789abcf] { puts [format " %s%d %s" APP 0x[string index [lindex $marker 0] 1] (unknown)] } fe { puts " Comment: [read $fh [lindex $marker 2]]" } default { puts " Unknown" } } } } # for mapping the exif format types to byte lengths array set ::jpeg::exif_formats [list 1 1 2 1 3 2 4 4 5 8 6 1 7 1 8 2 9 4 10 8 11 4 12 8] # list of recognized exif tags. if a tag is not listed here it will show up as its raw hex value array set ::jpeg::exif_tags { 0100 ImageWidth 0101 ImageLength 0102 BitsPerSample 0103 Compression 0106 PhotometricInterpretation 0112 Orientation 0115 SamplesPerPixel 011c PlanarConfiguration 0212 YCbCrSubSampling 0213 YCbCrPositioning 011a XResolution 011b YResolution 0128 ResolutionUnit 0111 StripOffsets 0116 RowsPerStrip 0117 StripByteCounts 0201 JPEGInterchangeFormat 0202 JPEGInterchangeFormatLength 012d TransferFunction 013e WhitePoint 013f PrimaryChromaticities 0211 YCbCrCoefficients 0213 YCbCrPositioning 0214 ReferenceBlackWhite 0132 DateTime 010e ImageDescription 010f Make 0110 Model 0131 Software 013b Artist 8298 Copyright 9000 ExifVersion a000 FlashpixVersion a001 ColorSpace 9101 ComponentsConfiguration 9102 CompressedBitsPerPixel a002 ExifImageWidth a003 ExifImageHeight 927c MakerNote 9286 UserComment a004 RelatedSoundFile 9003 DateTimeOriginal 9004 DateTimeDigitized 9290 SubsecTime 9291 SubsecTimeOriginal 9292 SubsecTimeDigitized 829a ExposureTime 829d FNumber 8822 ExposureProgram 8824 SpectralSensitivity 8827 ISOSpeedRatings 8828 OECF 9201 ShutterSpeedValue 9202 ApertureValue 9203 BrightnessValue 9204 ExposureBiasValue 9205 MaxApertureValue 9206 SubjectDistance 9207 MeteringMode 9208 LightSource 9209 Flash 920a FocalLength 9214 SubjectArea a20b FlashEnergy a20c SpatialFrequencyResponse a20e FocalPlaneXResolution a20f FocalPlaneYResolution a210 FocalPlaneResolutionUnit a214 SubjectLocation a215 ExposureIndex a217 SensingMethod a300 FileSource a301 SceneType a302 CFAPattern a401 CustomRendered a402 ExposureMode a403 WhiteBalance a404 DigitalZoomRatio a405 FocalLengthIn35mmFilm a406 SceneCaptureType a407 GainControl a408 Contrast a409 Saturation a40a Sharpness a40b DeviceSettingDescription a40c SubjectDistanceRange a420 ImageUniqueID 0001 InteroperabilityIndex 0002 InteroperabilityVersion 1000 RelatedImageFileFormat 1001 RelatedImageWidth 1002 RelatedImageLength 00fe NewSubfileType 00ff SubfileType 013d Predictor 0142 TileWidth 0143 TileLength 0144 TileOffsets 0145 TileByteCounts 014a SubIFDs 015b JPEGTables 828d CFARepeatPatternDim 828e CFAPattern 828f BatteryLevel 83bb IPTC/NAA 8773 InterColorProfile 8825 GPSInfo 8829 Interlace 882a TimeZoneOffset 882b SelfTimerMode 920c SpatialFrequencyResponse 920d Noise 9211 ImageNumber 9212 SecurityClassification 9213 ImageHistory 9215 ExposureIndex 9216 TIFF/EPStandardID } # list of recognized exif tags for the GPSInfo section--added by mdp 6/5/2009 array set ::jpeg::gps_tags { 0000 GPSVersionID 0001 GPSLatitudeRef 0002 GPSLatitude 0003 GPSLongitudeRef 0004 GPSLongitude 0005 GPSAltitudeRef 0006 GPSAltitude 0007 GPSTimeStamp 0008 GPSSatellites 0009 GPSStatus 000a GPSMeasureMode 000b GPSDOP 000c GPSSpeedRef 000d GPSSpeed 000e GPSTrackRef 000f GPSTrack 0010 GPSImgDirectionRef 0011 GPSImgDirection 0012 GPSMapDatum 0013 GPSDestLatitudeRef 0014 GPSDestLatitude 0015 GPSDestLongitudeRef 0016 GPSDestLongitude 0017 GPSDestBearingRef 0018 GPSDestBearing 0019 GPSDestDistanceRef 001a GPSDestDistance 001b GPSProcessingMethod 001c GPSAreaInformation 001d GPSDateStamp 001e GPSDifferential } # for mapping exif values to plain english by [formatExif] array set ::jpeg::exif_values { Compression,1 none Compression,6 JPEG Compression, unknown PhotometricInterpretation,2 RGB PhotometricInterpretation,6 YCbCr PhotometricInterpretation, unknown Orientation,1 normal Orientation,2 mirrored Orientation,3 "180 degrees" Orientation,4 "180 degrees, mirrored" Orientation,5 "90 degrees ccw, mirrored" Orientation,6 "90 degrees cw" Orientation,7 "90 degrees cw, mirrored" Orientation,8 "90 degrees ccw" Orientation, unknown PlanarConfiguration,1 chunky PlanarConfiguration,2 planar PlanarConfiguration, unknown YCbCrSubSampling,2,1 YCbCr4:2:2 YCbCrSubSampling,2,2 YCbCr4:2:0 YCbCrSubSampling, unknown YCbCrPositioning,1 centered YCbCrPositioning,2 co-sited YCbCrPositioning, unknown FlashpixVersion,0100 "Flashpix Format Version 1.0" FlashpixVersion, unknown ColorSpace,1 sRGB ColorSpace,32768 uncalibrated ColorSpace, unknown ExposureProgram,0 undefined ExposureProgram,1 manual ExposureProgram,2 normal ExposureProgram,3 "aperture priority" ExposureProgram,4 "shutter priority" ExposureProgram,5 creative ExposureProgram,6 action ExposureProgram,7 portrait ExposureProgram,8 landscape ExposureProgram, unknown LightSource,0 unknown LightSource,1 daylight LightSource,2 flourescent LightSource,3 tungsten LightSource,4 flash LightSource,9 "fine weather" LightSource,10 "cloudy weather" LightSource,11 shade LightSource,12 "daylight flourescent" LightSource,13 "day white flourescent" LightSource,14 "cool white flourescent" LightSource,15 "white flourescent" LightSource,17 "standard light A" LightSource,18 "standard light B" LightSource,19 "standard light C" LightSource,20 D55 LightSource,21 D65 LightSource,22 D75 LightSource,23 D50 LightSource,24 "ISO studio tungsten" LightSource,255 other LightSource, unknown Flash,0 "no flash" Flash,1 "flash fired" Flash,5 "strobe return light not detected" Flash,7 "strobe return light detected" Flash,9 "flash fired, compulsory flash mode" Flash,13 "flash fired, compulsory flash mode, return light not detected" Flash,15 "flash fired, compulsory flash mode, return light detected" Flash,16 "flash did not fire, compulsory flash mode" Flash,24 "flash did not fire, auto mode" Flash,25 "flash fired, auto mode" Flash,29 "flash fired, auto mode, return light not detected" Flash,31 "flash fired, auto mode, return light detected" Flash,32 "no flash function" Flash,65 "flash fired, red-eye reduction mode" Flash,69 "flash fired, red-eye reduction mode, return light not detected" Flash,71 "flash fired, red-eye reduction mode, return light detected" Flash,73 "flash fired, compulsory mode, red-eye reduction mode" Flash,77 "flash fired, compulsory mode, red-eye reduction mode, return light not detected" Flash,79 "flash fired, compulsory mode, red-eye reduction mode, return light detected" Flash,89 "flash fired, auto mode, red-eye reduction mode" Flash,93 "flash fired, auto mode, return light not detected, red-eye reduction mode" Flash,95 "flash fired, auto mode, return light detected, red-eye reduction mode" Flash, unknown ResolutionUnit,2 inch ResolutionUnit,3 centimeter ResolutionUnit, unknown SensingMethod,1 undefined SensingMethod,2 "one chip color area sensor" SensingMethod,3 "two chip color area sensor" SensingMethod,4 "three chip color area sensor" SensingMethod,5 "color sequential area sensor" SensingMethod,7 "trilinear sensor" SensingMethod,8 "color sequential linear sensor" SensingMethod, unknown SceneType,\x01\x00\x00\x00 "directly photographed image" SceneType, unknown CustomRendered,0 normal CustomRendered,1 custom ExposureMode,0 auto ExposureMode,1 manual ExposureMode,2 "auto bracket" ExposureMode, unknown WhiteBalance,0 auto WhiteBlanace,1 manual WhiteBlanace, unknown SceneCaptureType,0 standard SceneCaptureType,1 landscape SceneCaptureType,2 portrait SceneCaptureType,3 night SceneCaptureType, unknown GainControl,0 none GainControl,1 "low gain up" GainControl,2 "high gain up" GainControl,3 "low gain down" GainControl,4 "high gain down" GainControl, unknown Contrast,0 normal Contrast,1 soft Contrast,2 hard Contrast, unknown Saturation,0 normal Saturation,1 low Saturation,2 high Saturation, unknown Sharpness,0 normal Sharpness,1 soft Sharpness,2 hard Sharpness, unknown SubjectDistanceRange,0 unknown SubjectDistanceRange,1 macro SubjectDistanceRange,2 close SubjectDistanceRange,3 distant SubjectDistanceRange, unknown MeteringMode,0 unknown MeteringMode,1 average MeteringMode,2 "center weighted average" MeteringMode,3 spot MeteringMode,4 multi-spot MeteringMode,5 multi-segment MeteringMode,6 partial MeteringMode,255 other MeteringMode, unknown FocalPlaneResolutionUnit,2 inch FocalPlaneResolutionUnit,3 centimeter FocalPlaneResolutionUnit, none DigitalZoomRatio,0 "not used" FileSource,\x03\x00\x00\x00 "digital still camera" FileSource, unknown } # [binary scan], in the byte order indicated by $e proc ::jpeg::_scan {e v f args} { foreach x $args { upvar 1 $x $x } if {$e == "big"} { eval [list binary scan $v [string map {b B h H s S i I} $f]] $args } else { eval [list binary scan $v $f] $args } } # formats exif values, the numbers correspond to data types # values may be either byte order, as indicated by $end # see the exif spec for more info proc ::jpeg::_format {end value type num} { if {$num > 1 && $type != 2 && $type != 7} { variable exif_formats set r {} for {set i 0} {$i < $num} {incr i} { set len $exif_formats($type) lappend r [_format $end [string range $value [expr {$len * $i}] [expr {($len * $i) + $len - 1}]] $type 1] } return [join $r ,] } switch -exact -- $type { 1 { _scan $end $value c value } 2 { set value [string trimright $value \x00] } 3 { _scan $end $value s value set value [format %u $value] } 4 { _scan $end $value i value set value [format %u $value] } 5 { _scan $end $value ii n d set n [format %u $n] set d [format %u $d] if {$d == 0} {set d 1} #set value [string trimright [string trimright [format %5.4f [expr {double($n) / $d}]] 0] .] set value [string trimright [string trimright [expr {double($n) / $d}] 0] .] #set value "$n/$d" } 6 { _scan $end $value c value } 8 { _scan $end $value s value } 9 { _scan $end $value i value } 10 { _scan $end $value ii n d if {$d == 0} {set d 1} #set value [string trimright [string trimright [format %5.4f [expr {double($n) / $d}]] 0] .] set value [string trimright [string trimright [expr {double($n) / $d}] 0] .] #set value "$n/$d" } 11 { _scan $end $value i value } 12 { _scan $end $value w value } } return $value } # Do a compatibility version of [lassign] for versions of Tcl without # that command. Not using a version check as special builds may have # the command even if they are a version which nominally would not. if {![llength [info commands lassign]]} { proc ::jpeg::lassign {sequence v args} { set args [linsert $args 0 $v] set a [::llength $args] # Nothing to assign. #if {$a == 0} {return $sequence} # Perform assignments set i 0 foreach v $args { upvar 1 $v var set var [::lindex $sequence $i] incr i } # Return remainder, if there is any. return [::lrange $sequence $a end] } } # ### ### ### ######### ######### ######### ## Ready package provide jpeg 0.4.0