source: tol/tolsh/tolsh.vfs/lib/tcllib1.10/jpeg/jpeg.tcl @ 8597867d

1941-docker-image-to-testdevel
Last change on this file since 8597867d was 8597867d, checked in by Jorge Pérez <josp.jorge@…>, 16 years ago

closes #976, se incluye tcllib1.10, base64 debe eliminarse del raiz de lib ya que esta incluido en tcllib

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@2556 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 29.2 KB
RevLine 
[8597867d]1# jpeg.tcl --
2#
3#       Querying and modifying JPEG image files.
4#
5# Copyright (c) 2004    Aaron Faupell <afaupell@users.sourceforge.net>
6#
7# See the file "license.terms" for information on usage and redistribution
8# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9#
10# RCS: @(#) $Id: jpeg.tcl,v 1.12 2006/09/19 23:36:17 andreas_kupries Exp $
11
12package provide jpeg 0.3
13
14namespace eval ::jpeg {}
15
16# open a file, check jpeg signature, and a return a file handle
17# at the start of the first marker
18proc ::jpeg::openJFIF {file {mode r}} {
19    set fh [open $file $mode]
20    fconfigure $fh -encoding binary -translation binary -eofchar {}
21    # jpeg sig is FFD8, FF is start of first marker
22    if {[read $fh 3] != "\xFF\xD8\xFF"} { close $fh; return -code error "not a jpg file" }
23    # rewind to first marker
24    seek $fh -1 current
25    return $fh
26}
27
28# return a boolean indicating if a file starts with the jpeg sig
29proc ::jpeg::isJPEG {file} {
30    set is [catch {openJFIF $file} fh]
31    catch {close $fh}
32    return [expr {!$is}]
33}
34
35# takes an open filehandle at the start of a jpeg marker, and returns a list
36# containing information about the file markers in the jpeg file. each list
37# element itself a list of the marker type, offset of the start of its data,
38# and the length of its data.
39proc ::jpeg::markers {fh} {
40    set chunks [list]
41    while {[read $fh 1] == "\xFF"} {
42        binary scan [read $fh 3] H2S type len
43        # convert to unsigned
44        set len [expr {$len & 0x0000FFFF}]
45        # decrement len to account for marker bytes
46        incr len -2
47        lappend chunks [list $type [tell $fh] $len]
48        seek $fh $len current
49    }
50    return $chunks
51}
52
53proc ::jpeg::imageInfo {file} {
54    set fh [openJFIF $file r+]
55    set data {}
56    if {[set app0 [lsearch -inline [markers $fh] "e0 *"]] != ""} {
57        seek $fh [lindex $app0 1] start
58        set id [read $fh 5]
59        if {$id == "JFIF\x00"} {
60            binary scan [read $fh 9] cccSScc ver1 ver2 units xr yr xt yt
61            set data [list version $ver1.$ver2 units $units xdensity $xr ydensity $yr xthumb $xt ythumb $yt]
62        }
63    }
64    close $fh
65    return $data
66}
67
68# return an images dimensions by reading the Start Of Frame marker
69proc ::jpeg::dimensions {file} {
70    set fh [openJFIF $file]
71    set sof [lsearch -inline [markers $fh] {c[0-3] *}]
72    seek $fh [lindex $sof 1] start
73    binary scan [read $fh 5] cSS precision height width
74    close $fh
75    return [list $width $height]
76}
77
78# returns a list of all comments (FE segments) in the file
79proc ::jpeg::getComments {file} {
80    set fh [openJFIF $file]
81    set comments {}
82    foreach x [lsearch -all -inline [markers $fh] "fe *"] {
83        seek $fh [lindex $x 1] start
84        lappend comments [read $fh [lindex $x 2]]
85    }
86    close $fh
87    return $comments
88}
89
90# add a new comment to the file
91proc ::jpeg::addComment {file comment args} {
92    set fh [openJFIF $file r+]
93    # find the SoF and save all data after it
94    set sof [lsearch -inline [markers $fh] {c[0-3] *}]
95    seek $fh [expr {[lindex $sof 1] - 4}] start
96    set data2 [read $fh]
97    # seek back to the SoF and write comment(s) segment
98    seek $fh [expr {[lindex $sof 1] - 4}] start
99    foreach x [linsert $args 0 $comment] {
100        if {$x == ""} continue
101        puts -nonewline $fh [binary format a2Sa* "\xFF\xFE" [expr {[string length $x] + 2}] $x]
102    }
103    # write the saved data bac
104    puts -nonewline $fh $data2
105    close $fh
106}
107
108proc ::jpeg::replaceComment {file comment} {
109    set com [getComments $file]
110    removeComments $file
111    eval [list addComment $file] [lreplace $com 0 0 $comment]
112}
113
114# removes all comment segments from the file
115proc ::jpeg::removeComments {file} {
116    set fh [openJFIF $file]
117    set data "\xFF\xD8"
118    foreach marker [markers $fh] {
119        if {[lindex $marker 0] != "fe"} {
120            # seek back 4 bytes to include the marker and length bytes
121            seek $fh [expr {[lindex $marker 1] - 4}] start
122            append data [read $fh [expr {[lindex $marker 2] + 4}]]
123        }
124    }
125    append data [read $fh]
126    close $fh
127    set fh [open $file w]
128    fconfigure $fh -encoding binary -translation binary -eofchar {}
129    puts -nonewline $fh $data
130    close $fh
131}
132
133# rewrites a jpeg file and removes all metadata (comments, exif, photoshop)
134proc ::jpeg::stripJPEG {file} {
135    set fh [openJFIF $file]
136    set data {}
137   
138    set markers [markers $fh]
139    # look for a jfif header segment and save it
140    if {[lindex $markers 0 0] == "e0"} {
141        seek $fh [lindex $markers 0 1] start
142        if {[read $fh 5] == "JFIF\x00"} {
143            seek $fh -9 current
144            set jfif [read $fh [expr {[lindex $markers 0 2] + 4}]]
145        }
146    }
147    # if we dont have a jfif header (exif files), create a fake one
148    if {![info exists jfif]} {
149        set jfif [binary format a2Sa5cccSScc "\xFF\xE0" 16 "JFIF\x00" 1 2 1 72 72 0 0]
150    }
151
152    # remove all the e* and f* markers (metadata)
153    foreach marker $markers {
154        if {![string match {[ef]*} [lindex $marker 0]]} {
155            seek $fh [expr {[lindex $marker 1] - 4}] start
156            append data [read $fh [expr {[lindex $marker 2] + 4}]]
157        }
158    }
159    append data [read $fh]
160
161    close $fh
162    set fh [open $file w+]
163    # write a jpeg file sig, a jfif header, and all the remaining data
164    puts -nonewline $fh \xFF\xD8$jfif$data
165    close $fh
166}
167
168# if file contains a jpeg thumbnail return it. the returned data is the actual
169# jpeg data, it can be written directly to a file
170proc ::jpeg::getThumbnail {file} {
171    # check if the exif information contains a thumbnail
172    array set exif [getExif $file thumbnail]
173    if {[info exists exif(Compression)] && \
174             $exif(Compression) == 6 && \
175             [info exists exif(JPEGInterchangeFormat)] && \
176             [info exists exif(JPEGInterchangeFormatLength)]} {
177        set fh [openJFIF $file]
178        seek $fh [expr {$exif(ExifOffset) + $exif(JPEGInterchangeFormat)}] start
179        set thumb [read $fh $exif(JPEGInterchangeFormatLength)]
180        close $fh
181        return $thumb
182    }
183    # check for a JFXX segment which contains a thumbnail
184    set fh [openJFIF $file]
185    foreach x [lsearch -inline -all [markers $fh] "e0 *"] {
186        seek $fh [lindex $x 1] start
187        binary scan [read $fh 6] a5H2 id excode
188        # excode 10 is jpeg encoding, we cant interpret the other types
189        if {$id == "JFXX\x00" && $excode == "10"} {
190            set thumb [read $fh [expr {[lindex $x 2] - 6}]]
191            close $fh
192            return $thumb
193        }
194    }
195    close $fh
196}
197
198
199# takes key-value pairs returned by getExif and converts their values into
200# human readable format
201proc ::jpeg::formatExif {exif} {
202    variable exif_values
203    set out {}
204    foreach {tag val} $exif {
205        if {[info exists exif_values($tag,$val)]} {
206            set val $exif_values($tag,$val)
207        } elseif {[info exists exif_values($tag,)]} {
208            set val $exif_values($tag,)
209        } else {
210            switch -exact -- $tag {
211                UserComment {set val [string trim [string range $val 8 end] \x00]}
212                ComponentsConfiguration {binary scan $val cccc a b c d; set val $a,$b,$c,$d}
213                ExifVersion {set val [expr [string range $val 0 1].[string range $val 2 3]]}
214                FNumber {set val [format %2.1f $val]}
215                MaxApertureValue -
216                ApertureValue {
217                    set val [format %2.1f [expr {2 * (log($val) / log(2))}]]
218                }
219                ShutterSpeedValue {
220                    set val [expr {pow(2, $val)}]
221                    if {abs(round($val) - $val) < 0.2} {set val [expr {round($val)}]}
222                    set val 1/[string trimright [string trimright [format %.2f $val] 0] .]
223                }
224                ExposureTime {
225                    set val 1/[string trimright [string trimright [format %.4f [expr {1 / $val}]] 0] .]
226                }
227            }
228        }
229        lappend out $tag $val
230    }
231    return $out
232}
233
234# returns a list of all known exif keys
235proc ::jpeg::exifKeys {} {
236    variable exif_tags
237    set ret {}
238    foreach {x y} [array get exif_tags] {lappend ret $y}
239    return $ret
240}
241
242proc ::jpeg::getExif {file {type main}} {
243    set fh [openJFIF $file]
244    # foreach because file may have multiple e1 markers
245    foreach app1 [lsearch -inline -all [markers $fh] "e1 *"] {
246        seek $fh [lindex $app1 1] start
247        # check that this e1 is really an Exif segment
248        if {[read $fh 6] != "Exif\x00\x00"} continue
249        # save offset because exif offsets are relative to this
250        set start [tell $fh]
251        # next 2 bytes determine byte order
252        binary scan [read $fh 2] H4 byteOrder
253        if {$byteOrder == "4d4d"} {
254            set byteOrder big
255        } elseif {$byteOrder == "4949"} {
256            set byteOrder little
257        } else {
258            close $fh
259            return
260        }
261        # the answer is 42, if we have our byte order correct
262        _scan $byteOrder [read $fh 6] si magic next
263        if {$magic != 42} { close $fh; return }
264        seek $fh [expr {$start + $next}] start
265        if {$type != "thumbnail"} {
266            set data [_exif $fh $byteOrder $start]
267        } else {
268            # number of entries in this exif block
269            _scan $byteOrder [read $fh 2] s num
270            # each entry is 12 bytes
271            seek $fh [expr {$num * 12}] current
272            # offset of next exif block (for thumbnail)
273            _scan $byteOrder [read $fh 4] i next
274            if {$next <= 0} { close $fh; return }
275            # but its relative to start
276            seek $fh [expr {$start + $next}] start
277            set data [_exif $fh $byteOrder $start]
278        }
279        close $fh
280        lappend data ExifOffset $start ExifByteOrder $byteOrder
281        return $data
282    }
283    close $fh
284}
285
286proc ::jpeg::removeExif {file} {
287    set fh [openJFIF $file]
288    set data {}
289    set markers [markers $fh]
290    if {[lsearch $markers "e1 *"] < 0} { close $fh; return }
291    foreach marker $markers {
292        if {[lindex $marker 0] != "e1"} {
293            seek $fh [expr {[lindex $marker 1] - 4}] start
294            append data [read $fh [expr {[lindex $marker 2] + 4}]]
295        } else {
296            seek $fh [lindex $marker 1] start
297            if {[read $fh 6] == "Exif\x00\x00"} continue
298            seek $fh -10 current
299            append data [read $fh [expr {[lindex $marker 2] + 4}]]
300        }
301    }
302    append data [read $fh]
303    close $fh
304    set fh [open $file w]
305    fconfigure $fh -encoding binary -translation binary -eofchar {}
306    puts -nonewline $fh "\xFF\xD8"
307    if {[lindex $markers 0 0] != "e0"} {
308        puts -nonewline $fh [binary format a2Sa5cccSScc "\xFF\xE0" 16 "JFIF\x00" 1 2 1 72 72 0 0]
309    }
310    puts -nonewline $fh $data
311    close $fh
312}
313
314proc ::jpeg::_exif2 {data} {
315    variable exif_tags
316    set byteOrder little
317    set start 0
318    set i 2
319    for {_scan $byteOrder $data @0s num} {$num > 0} {incr num -1} {
320        binary scan $data @${i}H2H2 t1 t2
321        if {$byteOrder == "big"} {
322            set tag $t1$t2
323        } else {
324            set tag $t2$t1
325        }
326        incr i 2
327        _scan $byteOrder $data @${i}si format components
328        incr i 6
329        set value [string range $data $i [expr {$i + 3}]]
330        if {$tag == "8769" || $tag == "a005"} {
331            _scan $byteOrder $value i next
332            #set pos [tell $fh]
333            #seek $fh [expr {$offset + $next}] start
334            #eval lappend return [_exif $fh $byteOrder $offset]
335            #seek $fh $pos start
336            continue
337        }
338        if {![info exists exif_formats($format)]} continue
339        if {[info exists exif_tags($tag)]} { set tag $exif_tags($tag) }
340        set size [expr {$exif_formats($format) * $components}]
341        if {$size > 4} {
342            _scan $byteOrder $value i value
343            #puts "$value"
344            #set value [string range $data [expr {$i + $offset + $value}] [expr {$size - 1}]]
345        }
346        lappend ret $tag [_format $byteOrder $value $format $components]
347    }
348}
349
350# reads an exif block and returns key-value pairs
351proc ::jpeg::_exif {fh byteOrder offset} {
352    variable exif_formats
353    variable exif_tags
354    set return {}
355    for {_scan $byteOrder [read $fh 2] s num} {$num > 0} {incr num -1} {
356        binary scan [read $fh 2] H2H2 t1 t2
357        _scan $byteOrder [read $fh 6] si format components
358        if {$byteOrder == "big"} {
359            set tag $t1$t2
360        } else {
361            set tag $t2$t1
362        }
363        set value [read $fh 4]
364        # special tags, they point to more exif blocks
365        if {$tag == "8769" || $tag == "a005"} {
366            _scan $byteOrder $value i next
367            set pos [tell $fh]
368            seek $fh [expr {$offset + $next}] start
369            eval lappend return [_exif $fh $byteOrder $offset]
370            seek $fh $pos start
371            continue
372        }
373        if {![info exists exif_formats($format)]} continue
374        if {[info exists exif_tags($tag)]} { set tag $exif_tags($tag) }
375        set size [expr {$exif_formats($format) * $components}]
376        # if the data is over 4 bytes, its stored later in the file, with the
377        # data being the offset relative to the exif header
378        if {$size > 4} {
379            set pos [tell $fh]
380            _scan $byteOrder $value i value
381            seek $fh [expr {$offset + $value}] start
382            set value [read $fh $size]
383            seek $fh $pos start
384        }
385        lappend return $tag [_format $byteOrder $value $format $components]
386    }
387    return $return
388}
389
390proc ::jpeg::MakerNote {offset byteOrder Make data} {
391    if {$Make == "Canon"} {
392        set data [MakerNoteCanon $offset $byteOrder $data]
393    } elseif {[string match Nikon* $data] || $Make == "NIKON"} {
394        set data [MakerNoteNikon $offset $byteOrder $data]
395    } elseif {[string match FUJIFILM* $data]} {
396        set data [MakerNoteFuji $offset $byteOrder $data]
397    } elseif {[string match OLYMP* $data]} {
398        set data [MakerNoteOlympus $offset $byteOrder $data]
399    }
400    return $data
401}
402
403proc ::jpeg::MakerNoteNikon {offset byteOrder data} {
404    variable exif_formats
405    set return {}
406    if {[string match Nikon* $data]} {
407        set i 8
408    } else {
409        set i 0
410    }
411    binary scan $data @8s num
412    incr i 2
413    puts [expr {($num * 12) + $i}]
414    puts [string range $data 142 150]
415    #exit
416    for {} {$num > 0} {incr num -1} {
417        binary scan $data @${i}H2H2 t1 t2
418        if {$byteOrder == "big"} {
419            set tag $t1$t2
420        } else {
421            set tag $t2$t1
422        }
423        incr i 2
424        _scan $byteOrder $data @${i}si format components
425        incr i 6
426        set value [string range $data $i [expr {$i + 3}]]
427        if {![info exists exif_formats($format)]} continue
428        #if {[info exists exif_tags($tag)]} { set tag $exif_tags($tag) }
429        set size [expr {$exif_formats($format) * $components}]
430        if {$size > 4} {
431            _scan $byteOrder $value i value
432            puts "$value"
433            set value 1
434            #set value [string range $data [expr {$i + $offset + $value}] [expr {$size - 1}]]
435        } else {
436       
437        lappend ret $tag [_format $byteOrder $value $format $components]
438        }
439        puts "$tag $format $components $value"
440    }
441    return $return
442}
443
444proc ::jpeg::debug {file} {
445    set fh [openJFIF $file]
446
447    puts "marker: d8 length: 0"
448    puts "  SOI (Start Of Image)"
449
450    foreach marker [markers $fh] {
451        seek $fh [lindex $marker 1]
452        puts "marker: [lindex $marker 0] length: [lindex $marker 2]"
453        switch -glob -- [lindex $marker 0] {
454            c[0-3] {
455                binary scan [read $fh 6] cSSc precision height width color
456                puts "  SOF (Start Of Frame) [string map {c0 "Baseline" c1 "Non-baseline" c2 "Progressive" c3 "Lossless"} [lindex $marker 0]]"
457                puts "    Image dimensions: $width $height"
458                puts "    Precision: $precision"
459                puts "    Color Components: $color"
460            }
461            c4 {
462                puts "  DHT (Define Huffman Table)"
463                binary scan [read $fh 17] cS bits symbols
464                puts "    $symbols symbols"
465            }
466            da {
467                puts "  SOS (Start Of Scan)"
468                binary scan [read $fh 2] c num
469                puts "    Components: $num"
470            }
471            db {
472                puts "  DQT (Define Quantization Table)"
473            }
474            dd {
475                puts "  DRI (Define Restart Interval)"
476                binary scan [read $fh 2] S num
477                puts "    Interval: $num blocks"
478            }
479            e0 {
480                set id [read $fh 5]
481                if {$id == "JFIF\x00"} {
482                    puts "  JFIF"
483                    binary scan [read $fh 9] cccSScc ver1 ver2 units xr vr xt yt
484                    puts "    Header: $ver1.$ver2 $units $xr $vr $xt $yt"
485                } elseif {$id == "JFXX\x00"} {
486                    puts "  JFXX (JFIF Extension)"
487                    binary scan [read $fh 1] H2 excode
488                    if {$excode == "10"} { set excode "10 (JPEG thumbnail)" }
489                    if {$excode == "11"} { set excode "11 (Palletized thumbnail)" }
490                    if {$excode == "13"} { set excode "13 (RGB thumbnail)" }
491                    puts "    Extension code: 0x$excode"
492                } else {
493                    puts "  Unknown APP0 segment: $id"
494                }
495            }
496            e1 {
497                if {[read $fh 6] == "Exif\x00\x00"} {
498                    puts "  EXIF data"
499                    puts "    MAIN EXIF"
500                    foreach {x y} [getExif $file] {
501                        puts "    $x $y"
502                    }
503                    puts "    THUMBNAIL EXIF"
504                    foreach {x y} [getExif $file thumbnail] {
505                        puts "    $x $y"
506                    }
507                } else {
508                    puts "  APP1 (unknown)"
509                }
510            }
511            e2 {
512                if {[read $fh 12] == "ICC_PROFILE\x00"} {
513                    puts "  ICC profile"
514                } else {
515                    puts "  APP2 (unknown)"
516                }
517            }
518            ed {
519                if {[read $fh 18] == "Photoshop 3.0\0008BIM"} {
520                    puts "  Photoshop 8BIM data"
521                } else {
522                    puts "  APP13 (unknown)"
523                }
524            }
525            ee {
526                if {[read $fh 5] == "Adobe"} {
527                    puts "  Adobe metadata"
528                } else {
529                    puts "  APP14 (unknown)"
530                }
531            }
532            e[3456789abcf] {
533                puts [format "  %s%d %s" APP 0x[string index [lindex $marker 0] 1] (unknown)]
534            }
535            fe {
536                puts "  Comment: [read $fh [lindex $marker 2]]"
537            }
538            default {
539                puts "  Unknown"
540            }
541        }
542    }
543}
544
545# for mapping the exif format types to byte lengths
546array 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]
547
548# list of recognized exif tags. if a tag is not listed here it will show up as its raw hex value
549array set ::jpeg::exif_tags {
550    0100 ImageWidth
551    0101 ImageLength
552    0102 BitsPerSample
553    0103 Compression
554    0106 PhotometricInterpretation
555    0112 Orientation
556    0115 SamplesPerPixel
557    011c PlanarConfiguration
558    0212 YCbCrSubSampling
559    0213 YCbCrPositioning
560    011a XResolution
561    011b YResolution
562    0128 ResolutionUnit
563
564    0111 StripOffsets
565    0116 RowsPerStrip
566    0117 StripByteCounts
567    0201 JPEGInterchangeFormat
568    0202 JPEGInterchangeFormatLength
569
570    012d TransferFunction
571    013e WhitePoint
572    013f PrimaryChromaticities
573    0211 YCbCrCoefficients
574    0213 YCbCrPositioning
575    0214 ReferenceBlackWhite
576
577    0132 DateTime
578    010e ImageDescription
579    010f Make
580    0110 Model
581    0131 Software 
582    013b Artist
583    8298 Copyright
584   
585    9000 ExifVersion 
586    a000 FlashpixVersion
587
588    a001 ColorSpace
589
590    9101 ComponentsConfiguration
591    9102 CompressedBitsPerPixel
592    a002 ExifImageWidth
593    a003 ExifImageHeight
594
595    927c MakerNote
596    9286 UserComment
597
598    a004 RelatedSoundFile
599
600    9003 DateTimeOriginal
601    9004 DateTimeDigitized
602    9290 SubsecTime
603    9291 SubsecTimeOriginal
604    9292 SubsecTimeDigitized
605
606    829a ExposureTime
607    829d FNumber
608    8822 ExposureProgram
609    8824 SpectralSensitivity
610    8827 ISOSpeedRatings
611    8828 OECF
612    9201 ShutterSpeedValue
613    9202 ApertureValue
614    9203 BrightnessValue
615    9204 ExposureBiasValue
616    9205 MaxApertureValue
617    9206 SubjectDistance
618    9207 MeteringMode
619    9208 LightSource
620    9209 Flash
621    920a FocalLength
622    9214 SubjectArea
623    a20b FlashEnergy
624    a20c SpatialFrequencyResponse
625    a20e FocalPlaneXResolution
626    a20f FocalPlaneYResolution
627    a210 FocalPlaneResolutionUnit
628    a214 SubjectLocation
629    a215 ExposureIndex
630    a217 SensingMethod
631    a300 FileSource
632    a301 SceneType
633    a302 CFAPattern
634    a401 CustomRendered
635    a402 ExposureMode
636    a403 WhiteBalance
637    a404 DigitalZoomRatio
638    a405 FocalLengthIn35mmFilm
639    a406 SceneCaptureType
640    a407 GainControl
641    a408 Contrast
642    a409 Saturation
643    a40a Sharpness
644    a40b DeviceSettingDescription
645    a40c SubjectDistanceRange
646    a420 ImageUniqueID
647
648   
649    0001 InteroperabilityIndex
650    0002 InteroperabilityVersion
651    1000 RelatedImageFileFormat
652    1001 RelatedImageWidth
653    1002 RelatedImageLength
654   
655    00fe NewSubfileType
656    00ff SubfileType
657    013d Predictor
658    0142 TileWidth
659    0143 TileLength
660    0144 TileOffsets
661    0145 TileByteCounts
662    014a SubIFDs
663    015b JPEGTables
664    828d CFARepeatPatternDim
665    828e CFAPattern
666    828f BatteryLevel
667    83bb IPTC/NAA
668    8773 InterColorProfile
669    8825 GPSInfo
670    8829 Interlace
671    882a TimeZoneOffset
672    882b SelfTimerMode
673    920c SpatialFrequencyResponse
674    920d Noise
675    9211 ImageNumber
676    9212 SecurityClassification
677    9213 ImageHistory
678    9215 ExposureIndex
679    9216 TIFF/EPStandardID
680}
681
682# for mapping exif values to plain english by [formatExif]
683array set ::jpeg::exif_values {
684    Compression,1 none
685    Compression,6 JPEG
686    Compression,  unknown
687
688    PhotometricInterpretation,2 RGB
689    PhotometricInterpretation,6 YCbCr
690    PhotometricInterpretation,  unknown
691
692    Orientation,1 normal
693    Orientation,2 mirrored
694    Orientation,3 "180 degrees"
695    Orientation,4 "180 degrees, mirrored"
696    Orientation,5 "90 degrees ccw, mirrored"
697    Orientation,6 "90 degrees cw"
698    Orientation,7 "90 degrees cw, mirrored"
699    Orientation,8 "90 degrees ccw"
700    Orientation,  unknown
701
702    PlanarConfiguration,1 chunky
703    PlanarConfiguration,2 planar
704    PlanarConfiguration,  unknown
705
706    YCbCrSubSampling,2,1 YCbCr4:2:2
707    YCbCrSubSampling,2,2 YCbCr4:2:0
708    YCbCrSubSampling,    unknown
709
710    YCbCrPositioning,1 centered
711    YCbCrPositioning,2 co-sited
712    YCbCrPositioning,  unknown
713
714    FlashpixVersion,0100 "Flashpix Format Version 1.0"
715    FlashpixVersion,     unknown
716
717    ColorSpace,1     sRGB
718    ColorSpace,32768 uncalibrated
719    ColorSpace,      unknown
720
721    ExposureProgram,0 undefined
722    ExposureProgram,1 manual
723    ExposureProgram,2 normal
724    ExposureProgram,3 "aperture priority"
725    ExposureProgram,4 "shutter priority"
726    ExposureProgram,5 creative
727    ExposureProgram,6 action
728    ExposureProgram,7 portrait
729    ExposureProgram,8 landscape
730    ExposureProgram,  unknown
731
732    LightSource,0   unknown
733    LightSource,1   daylight
734    LightSource,2   flourescent
735    LightSource,3   tungsten
736    LightSource,4   flash
737    LightSource,9   "fine weather"
738    LightSource,10  "cloudy weather"
739    LightSource,11  shade
740    LightSource,12  "daylight flourescent"
741    LightSource,13  "day white flourescent"
742    LightSource,14  "cool white flourescent"
743    LightSource,15  "white flourescent"
744    LightSource,17  "standard light A"
745    LightSource,18  "standard light B"
746    LightSource,19  "standard light C"
747    LightSource,20  D55
748    LightSource,21  D65
749    LightSource,22  D75
750    LightSource,23  D50
751    LightSource,24  "ISO studio tungsten"
752    LightSource,255 other
753    LightSource,    unknown
754
755    Flash,0  "no flash"
756    Flash,1  "flash fired"
757    Flash,5  "strobe return light not detected"
758    Flash,7  "strobe return light detected"
759    Flash,9  "flash fired, compulsory flash mode"
760    Flash,13 "flash fired, compulsory flash mode, return light not detected"
761    Flash,15 "flash fired, compulsory flash mode, return light detected"
762    Flash,16 "flash did not fire, compulsory flash mode"
763    Flash,24 "flash did not fire, auto mode"
764    Flash,25 "flash fired, auto mode"
765    Flash,29 "flash fired, auto mode, return light not detected"
766    Flash,31 "flash fired, auto mode, return light detected"
767    Flash,32 "no flash function"
768    Flash,65 "flash fired, red-eye reduction mode"
769    Flash,69 "flash fired, red-eye reduction mode, return light not detected"
770    Flash,71 "flash fired, red-eye reduction mode, return light detected"
771    Flash,73 "flash fired, compulsory mode, red-eye reduction mode"
772    Flash,77 "flash fired, compulsory mode, red-eye reduction mode, return light not detected"
773    Flash,79 "flash fired, compulsory mode, red-eye reduction mode, return light detected"
774    Flash,89 "flash fired, auto mode, red-eye reduction mode"
775    Flash,93 "flash fired, auto mode, return light not detected, red-eye reduction mode"
776    Flash,95 "flash fired, auto mode, return light detected, red-eye reduction mode"
777    Flash,   unknown
778
779    ResolutionUnit,2 inch
780    ResolutionUnit,3 centimeter
781    ResolutionUnit,  unknown
782
783    SensingMethod,1 undefined
784    SensingMethod,2 "one chip color area sensor"
785    SensingMethod,3 "two chip color area sensor"
786    SensingMethod,4 "three chip color area sensor"
787    SensingMethod,5 "color sequential area sensor"
788    SensingMethod,7 "trilinear sensor"
789    SensingMethod,8 "color sequential linear sensor"
790    SensingMethod,  unknown
791
792    SceneType,\x01\x00\x00\x00 "directly photographed image"
793    SceneType,                 unknown
794
795    CustomRendered,0 normal
796    CustomRendered,1 custom
797
798    ExposureMode,0 auto
799    ExposureMode,1 manual
800    ExposureMode,2 "auto bracket"
801    ExposureMode,  unknown
802
803    WhiteBalance,0 auto
804    WhiteBlanace,1 manual
805    WhiteBlanace,  unknown
806
807    SceneCaptureType,0 standard
808    SceneCaptureType,1 landscape
809    SceneCaptureType,2 portrait
810    SceneCaptureType,3 night
811    SceneCaptureType,  unknown
812
813    GainControl,0 none
814    GainControl,1 "low gain up"
815    GainControl,2 "high gain up"
816    GainControl,3 "low gain down"
817    GainControl,4 "high gain down"
818    GainControl,  unknown
819
820    Contrast,0 normal
821    Contrast,1 soft
822    Contrast,2 hard
823    Contrast,  unknown
824
825    Saturation,0 normal
826    Saturation,1 low
827    Saturation,2 high
828    Saturation,  unknown
829
830    Sharpness,0 normal
831    Sharpness,1 soft
832    Sharpness,2 hard
833    Sharpness,  unknown
834
835    SubjectDistanceRange,0 unknown
836    SubjectDistanceRange,1 macro
837    SubjectDistanceRange,2 close
838    SubjectDistanceRange,3 distant
839    SubjectDistanceRange,  unknown
840   
841    MeteringMode,0   unknown
842    MeteringMode,1   average
843    MeteringMode,2   "center weighted average"
844    MeteringMode,3   spot
845    MeteringMode,4   multi-spot
846    MeteringMode,5   multi-segment
847    MeteringMode,6   partial
848    MeteringMode,255 other
849    MeteringMode,    unknown
850   
851    FocalPlaneResolutionUnit,2 inch
852    FocalPlaneResolutionUnit,3 centimeter
853    FocalPlaneResolutionUnit,  none
854   
855    DigitalZoomRatio,0 "not used"
856   
857    FileSource,\x03\x00\x00\x00 "digital still camera"
858    FileSource,                 unknown
859}
860
861# [binary scan], in the byte order indicated by $e
862proc ::jpeg::_scan {e v f args} {
863     foreach x $args { upvar 1 $x $x }
864     if {$e == "big"} {
865         eval [list binary scan $v [string map {b B h H s S i I} $f]] $args
866     } else {
867         eval [list binary scan $v $f] $args
868     }
869}
870
871
872# formats exif values, the numbers correspond to data types
873# values may be either byte order, as indicated by $end
874# see the exif spec for more info
875proc ::jpeg::_format {end value type num} {
876    if {$num > 1 && $type != 2 && $type != 7} {
877        variable exif_formats
878        set r {}
879        for {set i 0} {$i < $num} {incr i} {
880            set len $exif_formats($type)
881            lappend r [_format $end [string range $value [expr {$len * $i}] [expr {($len * $i) + $len - 1}]] $type 1]
882        }
883        return [join $r ,]
884    }
885    switch -exact -- $type {
886        1 { _scan $end $value c value }
887        2 { set value [string trimright $value \x00] }
888        3 {
889            _scan $end $value s value
890            set value [format %u $value]
891        }
892        4 {
893            _scan $end $value i value
894            set value [format %u $value]
895        }
896        5 {
897            _scan $end $value ii n d
898            set n [format %u $n]
899            set d [format %u $d]
900            if {$d == 0} {set d 1}
901            #set value [string trimright [string trimright [format %5.4f [expr {double($n) / $d}]] 0] .]
902            set value [string trimright [string trimright [expr {double($n) / $d}] 0] .]
903            #set value "$n/$d"
904        }
905        6 { _scan $end $value c value }
906        8 { _scan $end $value s value }
907        9 { _scan $end $value i value }
908        10 {
909            _scan $end $value ii n d
910            if {$d == 0} {set d 1}
911            #set value [string trimright [string trimright [format %5.4f [expr {double($n) / $d}]] 0] .]
912            set value [string trimright [string trimright [expr {double($n) / $d}] 0] .]
913            #set value "$n/$d"
914        }
915        11 { _scan $end $value i value }
916        12 { _scan $end $value w value }
917    }
918    return $value
919}
920
Note: See TracBrowser for help on using the repository browser.