#lang racket/base
;; Copyright Neil Van Dyke.  See file "info.rkt".

(require racket/match
         racket/promise
         "mediafile-misc.rkt")

(module+ test
  (require "planet-overeasy.rkt"))

(define (%mediafile:read-tiff-byte-order-be in)
  (let ((byte-order-marker (read-bytes 2 in)))
    (cond ((equal? #"II" byte-order-marker) #false)
          ((equal? #"MM" byte-order-marker) #true)
          (error '%mediafile:read-tiff-byte-order-be
                 "invalid byte order marker ~S"
                 byte-order-marker))))

(define (%mediafile:bytes->tiff-uint16 bstr be? (offset 0))
  (if be?
      (+ (arithmetic-shift (bytes-ref bstr      offset) 8)
         (bytes-ref bstr                   (+ 1 offset)))
      (+ (arithmetic-shift (bytes-ref bstr (+ 1 offset)) 8)
         (bytes-ref bstr                        offset))))

(define (%mediafile:bytes->tiff-uint32 bstr be? (offset 0))
  (if be?
      (+ (arithmetic-shift (bytes-ref bstr      offset) 24)
         (arithmetic-shift (bytes-ref bstr (+ 1 offset)) 16)
         (arithmetic-shift (bytes-ref bstr (+ 2 offset)) 8)
         (bytes-ref bstr (+ 3 offset)))
      (+ (arithmetic-shift (bytes-ref bstr (+ 3 offset)) 24)
         (arithmetic-shift (bytes-ref bstr (+ 2 offset)) 16)
         (arithmetic-shift (bytes-ref bstr (+ 1 offset)) 8)
         (bytes-ref bstr                        offset))))

(define (%mediafile:bytes->tiff-sint16 bstr be? (offset 0))
  ;; TODO: Use fixnums?
  (let ((uint16 (%mediafile:bytes->tiff-uint16 bstr be? offset)))
    (if (> uint16 32767)
        (if (= 32768 uint16)
            -32768
            (- (add1 (bitwise-and 65535 (bitwise-not uint16)))))
        uint16)))

(module+ test
  (test (%mediafile:bytes->tiff-sint16 (bytes #b11111111 #b11111111) #t)
        -1)
  (test (%mediafile:bytes->tiff-sint16 (bytes #b00000000 #b00000001) #t)
        1)
  ;; TODO: More test cases.
  )

(define (%mediafile:bytes->tiff-sint32 bstr be? (offset 0))
  ;; TODO: Use fixnums?
  (let ((uint32 (%mediafile:bytes->tiff-uint32 bstr be? offset)))
    (if (> uint32 2147483647)
        (if (= 2147483648 uint32)
            -2147483648
            (- (add1 (bitwise-and 4294967295 (bitwise-not uint32)))))
        uint32)))

(module+ test
  (test (%mediafile:bytes->tiff-sint32
         (bytes #b11111111 #b11111111 #b11111111 #b11100010)
         #t)
        -30)
  (test (%mediafile:bytes->tiff-sint32
         (bytes #b11111111 #b11111111 #b11111111 #b11110100)
         #t)
        -12)
  ;; TODO: More test cases.
  )

(define (%mediafile:bytes->tiff-float bstr be? (offset 0))
  (floating-point-bytes->real bstr
                              be?
                              offset
                              (+ 4 offset)))

(module+ test
  (test (round (* 1e3 (%mediafile:bytes->tiff-float (bytes #x41 #x89 #x33 #x33) #true)))
        17150.0))

(define (%mediafile:bytes->tiff-double bstr be? (offset 0))
  (floating-point-bytes->real bstr
                              be?
                              offset
                              (+ 8 offset)))

(define (%mediafile:read-tiff-uint16 in be?)
  (%mediafile:bytes->tiff-uint16 (read-bytes 2 in) be? 0))

(define (%mediafile:read-tiff-uint32 in be?)
  (%mediafile:bytes->tiff-uint32 (read-bytes 4 in) be? 0))

(define (%mediafile:byte->tiff-sbyte byt)
  ;; TODO: Use fixnums?
  (if (> byt 127)
      (if (= 128 byt)
          -128
          (- (add1 (bitwise-and 255 (bitwise-not byt)))))
      byt))

;; (bitwise-and 255 (add1 (bitwise-not byt))))

(module+ test
  (test (%mediafile:byte->tiff-sbyte #b00000000) 0)
  (test (%mediafile:byte->tiff-sbyte #b00000001) 1)
  (test (%mediafile:byte->tiff-sbyte #b00000010) 2)
  (test (%mediafile:byte->tiff-sbyte #b01111110) 126)
  (test (%mediafile:byte->tiff-sbyte #b01111111) 127)
  (test (%mediafile:byte->tiff-sbyte #b10000000) -128)
  (test (%mediafile:byte->tiff-sbyte #b10000001) -127)
  (test (%mediafile:byte->tiff-sbyte #b10000010) -126)
  (test (%mediafile:byte->tiff-sbyte #b11111110) -2)
  (test (%mediafile:byte->tiff-sbyte #b11111111) -1))

(define (%mediafile:tiff-seek-relative-to-header in offset)
  (let ((header-pos (%mediafile:current-tiff-header-pos)))
    (log-mediafile-debug "%mediafile:tiff-seek-relative-to-header :header-pos ~S :offset ~S"
                         header-pos
                         offset)
    (file-position in (+ header-pos offset))))

(define (%mediafile:tiff-entry-val/single in be? four-bytes required-byte-count proc)
  (if (> required-byte-count 4)
      (let ((offset (%mediafile:bytes->tiff-uint32 four-bytes be?)))
        (delay (%mediafile:tiff-seek-relative-to-header in offset)
               (proc (read-bytes required-byte-count in))))
      (proc four-bytes)))

(define (%mediafile:tiff-entry-val-many-proc-call be? bstr required-bytes-per-item item-count proc)
  (if (= 1 item-count)
      (proc bstr 0)
      (let loop ((item-count item-count)
                 (offset     0))
        (if (zero? item-count)
            '()
            (cons (proc bstr offset)
                  (loop (sub1 item-count)
                        (+ offset required-bytes-per-item)))))))

(define (%mediafile:tiff-entry-val/many in be? four-bytes required-bytes-per-item item-count proc)
  (log-mediafile-debug "%mediafile:tiff-entry-val/many: :four-bytes ~S :required-bytes-per-item ~S :item-count ~S"
                       four-bytes
                       required-bytes-per-item
                       item-count)
  (cond ((zero? item-count)
         '())
        ((exact-nonnegative-integer? item-count)
         (let ((required-byte-count (* required-bytes-per-item item-count)))
           (if (> required-byte-count 4)
               (let ((offset (%mediafile:bytes->tiff-uint32 four-bytes be?)))
                 (delay (%mediafile:tiff-seek-relative-to-header in offset)
                        (%mediafile:tiff-entry-val-many-proc-call be?
                                                                  (read-bytes required-byte-count in)
                                                                  required-bytes-per-item
                                                                  item-count
                                                                  proc)))
               (%mediafile:tiff-entry-val-many-proc-call be?
                                                         four-bytes
                                                         required-bytes-per-item
                                                         item-count
                                                         proc))))
        (else (raise-type-error '%mediafile:tiff-entry-val/many
                                "exact-nonnegative-integer?"
                                item-count))))

(define (%mediafile:read-tiff-entry in be?)
  (let* ((tag        (%mediafile:read-tiff-uint16 in be?))
         (type       (%mediafile:read-tiff-uint16 in be?))
         (count      (%mediafile:read-tiff-uint32 in be?))
         (four-bytes (read-bytes 4 in)))
    (log-mediafile-debug "%mediafile:read-tiff-entry :tag ~S :type ~S :count ~S :four-bytes ~S"
                         tag
                         type
                         count
                         four-bytes)
    (cons tag
          (if (zero? count)
              '()
              (case type
                ((1) ; BYTE = 8-bit unsigned integer
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 1
                                                 count
                                                 (lambda (bstr offset)
                                                   (bytes-ref bstr offset))))
                ((2) ; ASCII = ASCIIZ strings
                 (%mediafile:tiff-entry-val/single
                  in
                  be?
                  four-bytes
                  count
                  (lambda (bstr)
                    (let loop-strings ((start 0)
                                       (reverse-strings '()))
                      (cond ((= start count)
                             (cond ((null? reverse-strings)
                                    '(""))
                                   ((null? (cdr reverse-strings))
                                    (car reverse-strings))
                                   (else
                                    (reverse reverse-strings))))
                            ((> start count)
                             (error '%mediafile:read-tiff-entry
                                    "internal error: start ~S too big for tag ~S type ~S count ~S four-bytes ~S bstr ~S start"
                                    start
                                    tag
                                    type
                                    count
                                    four-bytes
                                    bstr))
                            (else
                             (let loop-find-nul ((end start))
                               (cond ((= end count)
                                      (error '%mediafile:read-tiff-entry
                                             "non-terminated string for tag ~S type ~S count ~S four-bytes ~S bstr ~S"
                                             tag
                                             type
                                             count
                                             four-bytes
                                             bstr))
                                     ((zero? (bytes-ref bstr end))
                                      (loop-strings (add1 end)
                                                    ;; Note: We don't enforce 7-bit ASCII.
                                                    (if (= start end)
                                                        reverse-strings
                                                        (cons (bytes->string/latin-1 bstr #f start end)
                                                              reverse-strings))))
                                     (else (loop-find-nul (add1 end)))))))))))
                ((3) ; SHORT = 16-bit (2-byte) unsigned integer
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 2
                                                 count
                                                 (lambda (bstr offset)
                                                   (%mediafile:bytes->tiff-uint16 bstr be? offset))))
                ((4) ; LONG = 32-bit (4-byte) unsigned integer
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 4
                                                 count
                                                 (lambda (bstr offset)
                                                   (%mediafile:bytes->tiff-uint32 bstr be? offset))))
                ((5) ; RATIONAL = numerator LONG followed by denominator LONG
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 8
                                                 count
                                                 (lambda (bstr offset)
                                                   (vector 'rational
                                                           (%mediafile:bytes->tiff-uint32 bstr be? offset)
                                                           (%mediafile:bytes->tiff-uint32 bstr be? (+ 4 offset))))))
                ((6) ; SBYTE = 8-bit signed (twos-complement) integer
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 1
                                                 count
                                                 (lambda (bstr offset)
                                                   (%mediafile:byte->tiff-sbyte (bytes-ref bstr offset)))))
                ((7) ; UNDEFINED = byte
                 (log-mediafile-debug "%mediafile:read-tiff-entry undefined-type :four-bytes ~S :four-bytes-as-uint32 ~S"
                                      four-bytes
                                      (%mediafile:bytes->tiff-uint32 four-bytes be?))
                 (delay (vector 'undefined-type
                                count
                                four-bytes)))
                ((8) ; SSHORT = 16-bit (2-byte) signed (twos-complement) integer
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 2
                                                 count
                                                 (lambda (bstr offset)
                                                   (%mediafile:bytes->tiff-sint16 bstr be? offset))))
                ((9) ; SLONG = 32-bit (4-byte) signed (twos-complement) integer
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 4
                                                 count
                                                 (lambda (bstr offset)
                                                   (%mediafile:bytes->tiff-sint32 bstr be? offset))))
                ((10) ; SRATIONAL = numerator SLONG followed by denominator SLONG
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 8
                                                 count
                                                 (lambda (bstr offset)
                                                   (vector 'rational
                                                           (%mediafile:bytes->tiff-sint32 bstr be? offset)
                                                           (%mediafile:bytes->tiff-sint32 bstr be? (+ 4 offset))))))
                ((11) ; FLOAT = single precision (4-byte) IEEE float
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 2
                                                 count
                                                 (lambda (bstr offset)
                                                   (%mediafile:bytes->tiff-float bstr be? offset))))
                ((12) ; DOUBLE = double precision (8-byte) IEEE float
                 (%mediafile:tiff-entry-val/many in
                                                 be?
                                                 four-bytes
                                                 2
                                                 count
                                                 (lambda (bstr offset)
                                                   (%mediafile:bytes->tiff-double bstr be? offset))))
                (else
                 (delay (vector 'unknown-type
                                type
                                count
                                four-bytes))
                 ;; (error '%mediafile:read-tiff-entry
                 ;;        "invalid type ~S in ~S before ~S (tag ~S, count ~S, four-bytes ~S)"
                 ;;        type
                 ;;        in
                 ;;        (file-position in)
                 ;;        tag
                 ;;        count
                 ;;        four-bytes)
                 ))))))

(define %mediafile:current-tiff-header-pos (make-parameter #f))
(define %mediafile:current-tiff-make       (make-parameter #f))
(define %mediafile:current-tiff-model      (make-parameter #f))

(define (%mediafile:read-tiff-ifd/no-chain in be? reverse-entries offset)
  (log-mediafile-debug "%mediafile:read-tiff-ifd/no-chain :offset ~S :reverse-entries ~S"
                       offset
                       reverse-entries)
  (%mediafile:tiff-seek-relative-to-header in offset)
  (let ((entry-count (%mediafile:read-tiff-uint16 in be?)))
    (log-mediafile-debug "%mediafile:read-tiff-ifd: :entry-count ~S"
                         entry-count)
    (let loop ((entry-count     entry-count)
               (reverse-entries reverse-entries))
      (if (zero? entry-count)
          reverse-entries
          (loop (sub1 entry-count)
                (cons (%mediafile:read-tiff-entry in be?)
                      reverse-entries))))))

(define (%mediafile:read-tiff-ifd in be? reverse-entries offset)
  (log-mediafile-debug "%mediafile:read-tiff-ifd :offset ~S :reverse-entries ~S"
                       offset
                       reverse-entries)
  (let* ((reverse-entries (%mediafile:read-tiff-ifd/no-chain in be? reverse-entries offset))
         (next-ifd-offset (%mediafile:read-tiff-uint32 in be?)))
    (values reverse-entries
            next-ifd-offset)))

(define (%mediafile:decode-tiff-entries in be? entry-decoder-hash entries unknown-prefix)
  (map (lambda (pair)
         (let ((val (cdr pair)))
           (%mediafile:tiff-entry-decode in
                                         be?
                                         entry-decoder-hash
                                         unknown-prefix
                                         (car pair)
                                         (if (promise? val)
                                             (force val)
                                             val))))
       entries))

(define (%mediafile:read-tiff-ifd-chain-as-parts in be? offset entry-decoder-hash unknown-prefix)
  (let loop-ifds ((ifd-number     0)
                  (reverse-parts '())
                  (offset          offset))
    (log-mediafile-debug "%mediafile:read-tiff-ifd-chain-as-part: :ifd-number ~S :reverse-parts ~S"
                         ifd-number
                         reverse-parts)
    (let-values (((reverse-entries next-ifd-offset)
                  (%mediafile:read-tiff-ifd in
                                            be?
                                            '()
                                            offset)))
      (let ((reverse-parts (cons (cons ifd-number
                                       (%mediafile:decode-tiff-entries in
                                                                       be?
                                                                       entry-decoder-hash
                                                                       (reverse reverse-entries)
                                                                       unknown-prefix))
                                 reverse-parts)))
        (if (zero? next-ifd-offset)
            (reverse reverse-parts)
            (loop-ifds (add1 ifd-number)
                       ;; Note: We do the reverse on reverse-entries before
                       ;; building a new list because we would like to do the
                       ;; seeks in order, in case that helps any file cache,
                       ;; just on principle.
                       reverse-parts
                       next-ifd-offset))))))

(define (%mediafile:read-tiff-ifd-chain-as-flat in be? offset entry-decoder-hash unknown-prefix)
  (let loop-ifds ((reverse-entries '())
                  (offset          offset))
    (let-values (((reverse-entries next-ifd-offset)
                  (%mediafile:read-tiff-ifd in
                                            be?
                                            reverse-entries
                                            offset)))
      (if (zero? next-ifd-offset)
          ;; Note: We do the reverse on reverse-entries before building a new
          ;; list because we would like to do the seeks in order, in case that
          ;; helps any file cache, just on principle.
          (%mediafile:decode-tiff-entries in
                                          be?
                                          entry-decoder-hash
                                          (reverse reverse-entries)
                                          unknown-prefix)
          (loop-ifds reverse-entries
                     next-ifd-offset)))))

(define (%mediafile:tiff-resolution-unit-value-decode val)
  (case val
    ((1) 'none)
    ((2) 'inch)
    ((3) 'centimeter)
    (else val)))

(define %mediafile:canon-makernote-camera-settings-canonlist-decoder-hash
  (make-hasheqv
   `((1 . (exif:canon:camera-settings:macro
           . ,(lambda (val)
                (case val
                  ((1) 'macro)
                  ((2) 'normal)
                  (else val)))))
     (2 . exif:canon:camera-settings:self-timer)
     (3 . (exif:canon:camera-settings:quality
           . ,(lambda (val)
                (case val
                  ((2) 'normal)
                  ((3) 'fine)
                  ((5) 'superfine)
                  (else val)))))
     (4 . (exif:canon:camera-settings:flash-mode
           . ,(lambda (val)
                (case val
                  ((0) 'flash-not-fired)
                  ((1) 'auto)
                  ((2) 'on)
                  ((3) 'red-eye-reduction)
                  ((4) 'slow-sync)
                  ((5) 'auto-and-red-eye-reduction)
                  ((6) 'on-and-red-eye-reduction)
                  ((16) 'external-flash)
                  (else val)))))
     (5 . (exif:canon:camera-settings:drive-mode
           . ,(lambda (val)
                (case val
                  ((0) 'single-or-timer)
                  ((1) 'continuous)
                  (else val)))))
     (7 . (exif:canon:camera-settings:focus-mode
           . ,(lambda (val)
                (case val
                  ((0) 'one-shot)
                  ((1) 'ai-servo)
                  ((2) 'ai-focus)
                  ((3) 'manual-3)
                  ((4) 'single)
                  ((5) 'continuous)
                  ((6) 'manual-6)
                  (else val)))))
     (10 . (exif:canon:camera-settings:image-size
            . ,(lambda (val)
                 (case val
                   ((0) 'large)
                   ((1) 'medium)
                   ((2) 'small)
                   (else val)))))
     (11 . (exif:canon:camera-settings:easy-mode
            . ,(lambda (val)
                 (case val
                   ((0) 'full-auto)
                   ((1) 'manual)
                   ((2) 'landscape)
                   ((3) 'fast-shutter)
                   ((4) 'slow-shutter)
                   ((5) 'night)
                   ((6) 'black-and-white)
                   ((7) 'sepia)
                   ((8) 'portrait)
                   ((9) 'sports)
                   ((10) 'macro-close-up)
                   ((11) 'pan-focus)
                   (else val)))))
     (12 . (exif:canon:camera-settings:digital-zoom
            . ,(lambda (val)
                 (case val
                   ((0) 'none)
                   ((1) 'x2)
                   ((2) 'x4)
                   (else val)))))
     (13 . (exif:canon:camera-settings:contrast
            . ,(lambda (val)
                 (case val
                   ((0)      'normal)
                   ((1)      'high)
                   ((#xffff) 'low)
                   (else val)))))
     (14 . (exif:canon:camera-settings:saturation
            . ,(lambda (val)
                 (case val
                   ((0)      'normal)
                   ((1)      'high)
                   ((#xffff) 'low)
                   (else val)))))
     (15 . (exif:canon:camera-settings:sharpness
            . ,(lambda (val)
                 (case val
                   ((0)      'normal)
                   ((1)      'high)
                   ((#xffff) 'low)
                   (else val)))))
     (16 . (exif:canon:camera-settings:iso-speed
            . ,(lambda (val)
                 (case val
                   ((15) 'auto)
                   ((16) #(decoded 50))
                   ((17) #(decoded 100))
                   ((18) #(decoded 200))
                   ((19) #(decoded 400))
                   (else val)))))
     (17 . (exif:canon:camera-settings:metering-mode
            . ,(lambda (val)
                 (case val
                   ((3) 'evaluative)
                   ((4) 'partial)
                   ((5) 'center-weighted)
                   (else val)))))
     (18 . (exif:canon:camera-settings:focus-type
            . ,(lambda (val)
                 (case val
                   ((0) 'manual)
                   ((1) 'auto)
                   ((3) 'close-up)
                   ((4) 'locked)
                   (else val)))))
     (19 . (exif:canon:camera-settings:af-point
            . ,(lambda (val)
                 (case val
                   ((#x3000) 'none)
                   ((#x3001) 'auto-selected)
                   ((#x3002) 'right)
                   ((#x3003) 'center)
                   ((#x3004) 'left)
                   (else val)))))
     (20 . (exif:canon:camera-settings:exposure-program
            . ,(lambda (val)
                 (case val
                   ((0) 'easy-shooting)
                   ((1) 'program)
                   ((2) 'tv-priority)
                   ((3) 'av-priority)
                   ((4) 'manual)
                   ((5) 'a-dep)
                   (else val)))))
     (22 . exif:canon:camera-settings:lens-type)
     (23 . exif:canon:camera-settings:lens)
     (24 . exif:canon:camera-settings:short-focal)
     (25 . exif:canon:camera-settings:focal-units)
     (26 . exif:canon:camera-settings:max-aperture)
     (27 . exif:canon:camera-settings:min-aperture)
     (28 . (exif:canon:camera-settings:flash-activity
            . ,(lambda (val)
                 (case val
                   ((0) 'did-not-fire)
                   ((1) 'fired)
                   (else val)))))
     (29 . exif:canon:camera-settings:flash-details) ;; TODO: Decode flash-details bits per http://www.burren.cx/david/canon.html
     (32 . (exif:canon:camera-settings:focus-continuous
            . ,(lambda (val)
                 (case val
                   ((0) 'single)
                   ((1) 'continuous)
                   (else val)))))
     (33 . exif:canon:camera-settings:ae-setting)
     (34 . exif:canon:camera-settings:image-stabilization)
     (35 . exif:canon:camera-settings:display-aperture)
     (36 . exif:canon:camera-settings:zoom-source-width)
     (37 . exif:canon:camera-settings:zoom-target-width)
     (39 . exif:canon:camera-settings:spot-metering-mode)
     (40 . exif:canon:camera-settings:photo-effect)
     (41 . exif:canon:camera-settings:manual-flash-output)
     (42 . exif:canon:camera-settings:color-tone)
     (46 . exif:canon:camera-settings:sraw-quality))))

(define %mediafile:canon-makernote-shot-info-canonlist-decoder-hash
  (make-hasheqv
   `((2 . exif:canon:shot-info:iso-speed)
     (3 . exif:canon:shot-info:measure-dev)
     (4 . exif:canon:shot-info:target-aperture)
     (5 . exif:canon:shot-info:target-shutter-speed)
     (7 . (exif:canon:shot-info:white-balance . ,(lambda (val)
                                                   (case val
                                                     ((0) 'auto)
                                                     ((1) 'sunny)
                                                     ((2) 'cloudy)
                                                     ((3) 'tungsten)
                                                     ((4) 'fluorescent)
                                                     ((5) 'flash)
                                                     ((6) 'custom)
                                                     (else val)))))
     (9 . exif:canon:shot-info:sequence)
     (14 . exif:canon:shot-info:af-point-used) ; TODO: Decode bits per http://www.burren.cx/david/canon.html
     (15 . (exif:canon:shot-info:flash-bias
            . ,(lambda (val)
                 (case val
                   ((#xffc0) #(decoded -2.0))
                   ((#xffcc) #(decoded -1.67))
                   ((#xffd0) #(decoded -1.50))
                   ((#xffd4) #(decoded -1.33))
                   ((#xffe0) #(decoded -1.0))
                   ((#xffec) #(decoded -0.67))
                   ((#xfff0) #(decoded -0.50))
                   ((#xfff4) #(decoded -0.33))
                   ((#x0000) #(decoded 0.0))
                   ((#x000c) #(decoded 0.33))
                   ((#x0010) #(decoded 0.50))
                   ((#x0014) #(decoded 0.67))
                   ((#x0020) #(decoded 1.0))
                   ((#x002c) #(decoded 1.33))
                   ((#x0030) #(decoded 1.50))
                   ((#x0034) #(decoded 1.67))
                   ((#x0040) #(decoded 2.0))
                   (else val)))))
     (19 . exif:canon:shot-info:subject-distance)
     (21 . exif:canon:shot-info:aperture-value)
     (22 . exif:canon:shot-info:shutter-speed-value)
     (23 . exif:canon:shot-info:measure-dev-2))))

(define %mediafile:canon-makernote-panorama-canonlist-decoder-hash
  (make-hasheqv
   `((2 . exif:canon:panorama:panorama-frame)
     (5 . exif:canon:panorama:panorama-direction))))

;; (define %mediafile:canon-makernote-custom-functions-canonlist-decoder-hash
;;   (make-hasheqv
;;    `((1 . noise-reduction)
;;      (2 . shutter-ae-lock)
;;      (3 . mirror-lockup)
;;      (4 . exposure-level-increments)
;;      (5 . af-assist)
;;      (6 . flash-sync-speed-av)
;;      (7 . aeb-sequence)
;;      (8 . shutter-curtain-sync)
;;      (9 . lens-af-stop-button)
;;      (10 . fill-flash-auto-reduction)
;;      (11 . menu-button-return)
;;      (12 . set-button-function)
;;      (13 . sensor-cleaning)
;;      (14 . super-imposed-display)
;;      (15 . shutter-release-no-cf-card))))

(define %mediafile:canon-makernote-picture-info-canonlist-decoder-hash
  (make-hasheqv
   '((2 . exif:canon:picture-info:image-width)
     (3 . exif:canon:picture-info:image-height)
     (4 . exif:canon:picture-info:image-width-as-shot)
     (5 . exif:canon:picture-info:image-height-as-shot)
     (22 . exif:canon:picture-info:af-points-used)
     (26 . exif:canon:picture-info:af-points-used-20d))))

;; (define %mediafile:canon-makernote-fi-ifd-entry-decoder-hash
;;   ;; TODO: !!! where is this used?!  is it camera-info?  what has lots of numbers?
;;   (make-hasheqv
;;    `((1 . file-number)
;;      (3 . bracket-mode)
;;      (4 . bracket-value)
;;      (5 . bracket-shot-number)
;;      (6 . raw-jpg-quality)
;;      (7 . raw-jpg-size)
;;      (8 . noise-reduction)
;;      (9 . wb-bracket-mode)
;;      (12 . wb-bracket-value-ab)
;;      (13 . wb-bracket-value-gm)
;;      (14 . filter-effect)
;;      (15 . toning-effect)
;;      (16 . macro-magnification)
;;      (19 . live-view-shooting)
;;      (25 . flash-exposure-lock))))

(define %mediafile:canon-makernote-ifd-entry-decoder-hash
  (make-hasheqv
   `((1 . #(exif:canon:camera-settings
            ,(lambda (in be? val)
               (%mediafile:decode-as-canonlist-or-val
                in
                be?
                val
                %mediafile:canon-makernote-camera-settings-canonlist-decoder-hash
                "exif:canon:camera-settings"))))
     (2 . exif:canon:focal-length)
     (4 . #(exif:canon:shot-info
            ,(lambda (in be? val)
               (%mediafile:decode-as-canonlist-or-val
                in
                be?
                val
                %mediafile:canon-makernote-shot-info-canonlist-decoder-hash
                "exif:canon:shot-info"))))
     (5 . #(exif:canon:panorama
            ,(lambda (in be? val)
               (%mediafile:decode-as-canonlist-or-val
                in
                be?
                val
                %mediafile:canon-makernote-panorama-canonlist-decoder-hash
                "exif:canon:panorama"))))
     (6 . exif:canon:image-type) ;; TODO: %mediafile:trim-canon-markernote-ascii AND MAKE GENERIC PROC NOT HIDE STRINGS
     (7 . exif:canon:firmware-version) ;; TODO: %mediafile:trim-canon-markernote-ascii
     (8 . exif:canon:file-number)
     (9 . exif:canon:owner-name) ;; TODO: %mediafile:trim-canon-markernote-ascii
     (12 . exif:canon:serial-number) ;; TODO: !!! decode this to string
     (13 . exif:canon:camera-info) ; TODO: !!! HOW DO WE DECODE "camera-info"?
     (15 . exif:canon:custom-functions) ;; TODO: Decode this.  Specific to camera model?
     ;; ,(lambda (in be? val)
     ;;    (%mediafile:decode-as-canonlist-or-val
     ;;     in
     ;;     be?
     ;;     val
     ;;     %mediafile:canon-makernote-custom-functions-canonlist-decoder-hash
     ;;     "exif:canon:custom-functions"))))
     (16 . exif:canon:model-id)
     (18 . #(exif:canon:picture-info
             ,(lambda (in be? val)
                (%mediafile:decode-as-canonlist-or-val
                 in
                 be?
                 val
                 %mediafile:canon-makernote-picture-info-canonlist-decoder-hash
                 "exif:canon:picture-info"))))
     (19 . exif:canon:thumbnail-image-valid-area)
     (21 . exif:canon:serial-number-format)
     (26 . exif:canon:super-macro)
     (38 . exif:canon:af-info)
     (131 . exif:canon:original-decision-data-offset)
     (164 . exif:canon:white-balance-table)
     (149 . exif:canon:lens-model)
     (150 . exif:canon:internal-serial-number)
     (151 . exif:canon:dust-removal-data)
     (153 . exif:canon:custom-functions)
     (160 . exif:canon:processing-info)
     (170 . exif:canon:measured-color)
     (180 . exif:canon:color-space)
     (208 . exif:canon:vrd-offset)
     (224 . exif:canon:sensor-info)
     (16385 . exif:canon:color-data))))

;; (define (%mediafile:decode-undefined-val-as-ifd-chain-or-val in be? val decoder-hash unknown-prefix)
;;   (match val
;;     ((vector 'undefined* item-count four-bytes)
;;      ;; TODO: Do any makers ever stuff an empty IFD into four-bytes rather than
;;      ;; have the address indirection?
;;      (%mediafile:read-tiff-ifd-chain-as-flat in
;;                                   be?
;;                                   (%mediafile:bytes->tiff-uint32 four-bytes be? 0)
;;                                   decoder-hash unknown-prefix))
;;     (_ val)))

(define (%mediafile:decode-undefined-val-as-ifd-or-val in be? val decoder-hash unknown-prefix)
  (match val
    ((vector 'undefined-type item-count four-bytes)
     ;; TODO: Do any makers ever stuff an empty IFD into four-bytes rather than
     ;; have the address indirection?
     (%mediafile:decode-tiff-entries in
                                     be?
                                     decoder-hash
                                     (reverse (%mediafile:read-tiff-ifd/no-chain in
                                                                                 be?
                                                                                 '()
                                                                                 (%mediafile:bytes->tiff-uint32 four-bytes be? 0)))
                                     unknown-prefix))
    (_ val)))

(define (decode-canonlist in be? val decoder-hash unknown-prefix)
  (let loop ((val val)
             (num 0))
    (if (null? val)
        '()
        ;; TODO: Rename %mediafile:tiff-entry-decode, since we're using it for multiple
        ;; purposes.
        (cons (%mediafile:tiff-entry-decode in
                                            be?
                                            decoder-hash
                                            unknown-prefix
                                            num
                                            (car val))
              (loop (cdr val)
                    (add1 num))))))

(define (%mediafile:decode-as-canonlist-or-val in be? val decoder-hash unknown-prefix)
  (if (and (pair? val)
           (integer? (car val)))
      (decode-canonlist in
                        be?
                        val
                        decoder-hash unknown-prefix)
      val))

(define %mediafile:exif-ifd-entry-decoder-hash
  (make-hasheqv
   `((36864 . exif:exif-version)
     (40960 . exif:flashpix-version)
     (40961 . exif:color-space)
     (42240 . exif:gamma)
     (40962 . exif:pixel-x-dimension)
     (40963 . exif:pixel-y-dimension)
     (37121 . exif:components-configuration)
     (37122 . exif:compressed-bits-per-pixel)
     (37500 . #(exif:maker-note
                ,(lambda (in be? val)
                   (let* ((make            (%mediafile:current-tiff-make))
                          (model           (%mediafile:current-tiff-model))
                          (maker-note-type (cond ((equal? make "Canon") 'canon)
                                                 (else #f))))
                     (if maker-note-type
                         (with-handlers ((exn:fail? (lambda (e)
                                                      (vector 'error
                                                              (format "could not parse presumed ~S maker-note: ~A"
                                                                      maker-note-type
                                                                      (exn-message e))))))
                           (vector 'maker-note
                                   maker-note-type
                                   (case maker-note-type
                                     ((canon)
                                      ;; Note: When we tried to decode this as a chain of IFDs rather than a single IFD, we
                                      (%mediafile:decode-undefined-val-as-ifd-or-val
                                       in
                                       be?
                                       val
                                       %mediafile:canon-makernote-ifd-entry-decoder-hash
                                       "exif:canon"))
                                     (else (error '<%mediafile:exif-ifd-entry-decoder-hash>
                                                  "unsupported maker-note type ~S"
                                                  maker-note-type)))))
                         (vector 'unknown-maker-note
                                 make
                                 model
                                 val))))))
     (37510 . exif:user-comment) ;; TODO: !!! How do we decode this?  "Type=UNDEFINED" see Exif 2.3 page 46.
     (40964 . exif:related-sound-file)
     (36867 . exif:date-time-original)
     (36868 . exif:date-time-digitized)
     (37520 . exif:subsec-time)
     (37521 . exif:subsec-time-original)
     (37522 . exif:subsec-time-digitized)
     (33434 . exif:exposure-time)
     (33437 . exif:f-number)
     (34850 . (exif:exposure-program
               . ,(lambda (val)
                    (case val
                      ((0) 'not-defined)
                      ((1) 'manual)
                      ((2) 'normal-program)
                      ((3) 'aperture-priority)
                      ((4) 'shutter-priority)
                      ((5) 'creative-program)
                      ((6) 'action-program)
                      ((7) 'portrait-mode)
                      ((8) 'landscape-mode)
                      (else val)))))
     (34852 . exif:spectral-sensitivity)
     (34855 . exif:photographic-sensitivity)
     (34856 . exif:oecf) ; TODO: Decode?
     (34864 . (exif:sensitivity-type
               . ,(lambda (val)
                    (case val
                      ((0) 'unknown)
                      ((1) 'sos)
                      ((2) 'rei)
                      ((3) 'iso-speed)
                      ((4) 'sos-and-rei)
                      ((5) 'sos-and-iso-speed)
                      ((6) 'rei-and-iso-speed)
                      ((7) 'sos-and-rei-and-iso-speed)
                      (else val)))))
     (34865 . exif:standard-output-sensitivity)
     (34866 . exif:recommended-exposure-index)
     (34867 . exif:iso-speed)
     (34868 . exif:iso-speed-latitude-yyy)
     (34869 . exif:iso-speed-latitude-zzz)
     (37377 . exif:shutter-speed-value)
     (37378 . exif:aperture-value)
     (37379 . (exif:brightness-value
               . ,(lambda (val)
                    (match val
                      ((vector 'rational #xffffffff d)
                       'unknown)
                      (_ val)))))
     (37380 . exif:exposure-bias-value)
     (37381 . exif:max-aperture-value)
     (37382 . (exif:subject-distance
               . ,(lambda (val)
                    (match val
                      ((vector 'rational #xffffffff d)
                       'unknown)
                      (_ val)))))
     (37383 . (exif:metering-mode
               . ,(lambda (val)
                    (case val
                      ((0)   'unknown)
                      ((1)   'average)
                      ((2)   'center-weighted-average)
                      ((3)   'spot)
                      ((4)   'multi-spot)
                      ((5)   'pattern)
                      ((6)   'partial)
                      ((255) 'other)
                      (else val)))))
     (37384 . (exif:light-source
               . ,(lambda (val)
                    (case val
                      ((0)   'unknown)
                      ((1)   'daylight)
                      ((2)   'fluorescent)
                      ((3)   'tungsten)
                      ((4)   'flash)
                      ((9)   'fine-weather)
                      ((10)  'cloudy-weather)
                      ((11)  'shade)
                      ((12)  'daylight-fluorescent)
                      ((13)  'day-white-fluorescent)
                      ((14)  'cool-white-fluorescent)
                      ((15)  'white-fluorescent)
                      ((16)  'warm-white-fluorescent)
                      ((17)  'standard-light-a)
                      ((18)  'standard-light-b)
                      ((19)  'standard-light-c)
                      ((20)  'd55)
                      ((21)  'd65)
                      ((22)  'd75)
                      ((23)  'd50)
                      ((24)  'iso-studio-tungsten)
                      ((255) 'other)
                      (else val)))))
     (37385 . exif:flash) ; TODO: Decode!
     (37396 . exif:subject-area)
     (37386 . exif:focal-length)
     (40965 . #(exif:interoperability-ifd
                ,(lambda (in be? val)
                   (log-mediafile-debug "reading interoperability-ifd...")
                   (%mediafile:read-tiff-ifd-chain-as-flat in
                                                           be?
                                                           val
                                                           %mediafile:interop-ifd-entry-decoder-hash
                                                           "exif:interoperability"))))
     (41483 . exif:flash-energy)
     (41484 . exif:spacial-frequency-response)
     (41486 . exif:focal-plane-x-resolution)
     (41487 . exif:focal-plane-y-resolution)
     (41488 . exif:focal-plane-resolution-unit)
     (41492 . exif:subject-location)
     (41493 . exif:exposure-index)
     (41495 . (exif:sensing-method
               . ,(lambda (val)
                    (case val
                      ((1) 'not-defined)
                      ((2) 'one-chip-color-area-sensor)
                      ((3) 'two-chip-color-area-sensor)
                      ((4) 'three-chip-color-area-sensor)
                      ((5) 'color-sequential-area-sensor)
                      ((7) 'trilinear-sensor)
                      ((8) 'color-sequential-linear-sensor)
                      (else val)))))
     (41728 . (exif:file-source
               . ,(lambda (val)
                    (case val
                      ((0) 'others)
                      ((1) 'scanner-of-transparent-type)
                      ((2) 'scanner-of-reflex-type)
                      ((3) 'dsc)
                      (else val)))))
     (41729 . (exif:scene-type
               . ,(lambda (val)
                    (match val
                      ((vector 'undefined-type 1 bstr)
                       ;; TODO: We're just guessing we should take
                       ;; the first byte here.  Exif 2.3 spec is
                       ;; strange on this.
                       (case (bytes-ref bstr 0)
                         ((1) 'directly-photographed)
                         (else val)))))))
     (41730 . exif:cfa-pattern)
     (41985 . (exif:custom-rendered
               . ,(lambda (val)
                    (case val
                      ((0) 'normal-process)
                      ((1) 'custom-process)
                      (else val)))))
     (41986 . (exif:exposure-mode
               . ,(lambda (val)
                    (case val
                      ((0) 'auto-exposure)
                      ((1) 'manual-exposure)
                      ((2) 'auto-bracket)
                      (else val)))))
     (41987 . (exif:white-balance
               . ,(lambda (val)
                    (case val
                      ((0) 'auto-white-balance)
                      ((1) 'manual-white-balance)
                      (else val)))))
     (41988 . (exif:digital-zoom-ratio
               . ,(lambda (val)
                    (match val
                      ((vector 'rational 0 d)
                       'not-applicable)
                      (_ val)))))
     (41989 . exif:focal-length-in-35mm-film)
     (41990 . (exif:scene-capture-type
               . ,(lambda (val)
                    (case val
                      ((0) 'standard)
                      ((1) 'landscape)
                      ((2) 'portrait)
                      ((3) 'night-scene)
                      (else val)))))
     (41991 . (exif:gain-control
               . ,(lambda (val)
                    (case val
                      ((0) 'none)
                      ((1) 'low-gain-up)
                      ((2) 'high-gain-up)
                      ((3) 'low-gain-down)
                      ((4) 'high-gain-down)
                      (else val)))))
     (41992 . (exif:contrast
               . ,(lambda (val)
                    (case val
                      ((0) 'normal)
                      ((1) 'soft)
                      ((2) 'hard)
                      (else val)))))
     (41993 . (exif:saturation
               . ,(lambda (val)
                    (case val
                      ((0) 'normal)
                      ((1) 'low-saturation)
                      ((2) 'high-saturation)
                      (else val)))))
     (41994 . (exif:sharpness
               . ,(lambda (val)
                    (case val
                      ((0) 'normal)
                      ((1) 'soft)
                      ((2) 'hard)
                      (else val)))))
     (41995 . exif:device-setting-description) ; TODO: Decode?
     (41996 . (exif:subject-distance-range
               . ,(lambda (val)
                    (case val
                      ((0) 'unknown)
                      ((1) 'macro)
                      ((2) 'close-view)
                      ((3) 'distant-view)
                      (else val)))))
     (42016 . exif:image-unique-id)
     (42032 . exif:camera-owner-name)
     (42033 . exif:body-serial-number)
     (42034 . exif:lens-specification)
     (42035 . exif:lens-make)
     (42036 . exif:lens-model)
     (42037 . exif:lens-serial-number))))

(define (%mediafile:gps-true/magnetic-direction-val-decode val)
  (cond ((equal? val "T") 'true-direction)
        ((equal? val "M") 'magnetic-direction)
        (else val)))

(define (%mediafile:gps-north/south-latitude-val-decode val)
  (cond ((equal? val "N") 'north-latitude)
        ((equal? val "S") 'south-latitude)
        (else val)))

(define (%mediafile:gps-east/west-longitude-val-decode val)
  (cond ((equal? val "E") 'east-longitude)
        ((equal? val "W") 'west-longitude)
        (else val)))

(define %mediafile:gps-ifd-entry-decoder-hash
  (make-hasheqv
   `((0 . exif:gps-version-id)
     (1 . (exif:gps-latitude-ref . ,%mediafile:gps-north/south-latitude-val-decode))
     (2 . exif:gps-latitude)
     (3 . (exif:gps-longitude-ref . ,%mediafile:gps-east/west-longitude-val-decode))
     (4 . exif:gps-longitude)
     (5 . (exif:gps-altitude-ref . ,(lambda (val)
                                      (case val
                                        ((0) 'sea-level)
                                        ((1) 'sea-level-reference-negative-value)
                                        (else val)))))
     (6 . exif:gps-altitude)
     (7 . exif:gps-timestamp)
     (8 . exif:gps-satellites)
     (9 . (exif:gps-status . ,(lambda (val)
                                (cond ((equal? val "A") 'measurement-in-progress)
                                      ((equal? val "V") 'measurement-interoperability)
                                      (else val)))))
     (10 . (exif:gps-measure-mode . ,(lambda (val)
                                       (cond ((equal? val "2") 'two-dimensional)
                                             ((equal? val "3") 'three-dimensional)
                                             (else val)))))
     (11 . exif:gps-dop)
     (12 . (exif:gps-speed-ref . ,(lambda (val)
                                    (cond ((equal? val "K") 'kilometers-per-hour)
                                          ((equal? val "M") 'miles-per-hour)
                                          ((equal? val "N") 'knots)
                                          (else val)))))
     (13 . exif:gps-speed)
     (14 . (exif:gps-track-ref . ,%mediafile:gps-true/magnetic-direction-val-decode))
     (15 . exif:gps-track)
     (16 . exif:gps-img-direction-ref . ,%mediafile:gps-true/magnetic-direction-val-decode)
     (17 . exif:gps-img-direction)
     (18 . exif:gps-map-datum)
     (19 . exif:gps-dest-latitude-ref . ,%mediafile:gps-north/south-latitude-val-decode)
     (20 . exif:gps-dest-latitude)
     (21 . (exif:gps-dest-longitude-ref . ,%mediafile:gps-east/west-longitude-val-decode))
     (22 . exif:gps-dest-longitude)
     (23 . exif:gps-dest-bearing-ref . ,%mediafile:gps-true/magnetic-direction-val-decode)
     (24 . exif:gps-dest-bearing)
     (25 . exif:gps-dest-distance-ref . ,(lambda (val)
                                           (cond ((equal? val "K") 'kilometers)
                                                 ((equal? val "M") 'miles)
                                                 ((equal? val "N") 'nautical-miles)
                                                 (else val))))
     (26 . exif:gps-dest-distance)
     (27 . exif:gps-processing-method) ; TODO: Decode
     (28 . exif:gps-area-information) ; TODO: Decode
     (29 . exif:gps-date-stamp)
     (30 . (exif:gps-differential . ,(lambda (val)
                                       (case (val)
                                         ((0) 'without-correction)
                                         ((1) 'with-correction)
                                         (else val)))))
     (31 . exif:gps-h-positioning-error))))

(define %mediafile:interop-ifd-entry-decoder-hash
  (make-hasheqv
   `((1 . exif:interoperability:interoperability-index))))

(define %mediafile:tiff-ifd-entry-decoder-hash
  (make-hasheqv
   `((254 . tiff:new-subfile-type) ;; TODO: !!! burst the bitfields into symbols
     (255 . (tiff:subfile-type .
                               ,(lambda (val)
                                  (case val
                                    ((1) 'full-resolution-image)
                                    ((2) 'reduced-resolution-image)
                                    ((3) 'image-page)
                                    (else val)))))
     (256 . tiff:image-width)
     (257 . tiff:image-length)
     (258 . tiff:bits-per-sample)
     (259 . (tiff:compression .
                              ,(lambda (val)
                                 (case val
                                   ((1)     'none)
                                   ((2)     'ccitt-1d)
                                   ((3)     'group-3-fax)
                                   ((4)     'group-4-fax)
                                   ((5)     'lzw)
                                   ((6)     'jpeg)
                                   ((32773) 'packbits)
                                   (else val)))))
     (262 . (tiff:photometric-interpretation .
                                             ,(lambda (val)
                                                (case val
                                                  ((0) 'white-is-zero)
                                                  ((1) 'black-is-zero)
                                                  ((2) 'rgb)
                                                  ((3) 'palette-color)
                                                  ((4) 'transparency-mask)
                                                  ((5) 'cmyk)
                                                  ((6) 'ycbcr)
                                                  ((8) 'cielab)
                                                  (else val)))))
     (263 . (tiff:thresholding .
                               ,(lambda (val)
                                  (case val
                                    ((1) 'none)
                                    ((2) 'ordered)
                                    ((3) 'randomized)
                                    (else val)))))
     (264 . tiff:cell-width)
     (265 . tiff:cell-length)
     (266 . tiff:fill-order) ; Note: Don't make symbols for this one.
     (269 . tiff:document-name)
     (270 . tiff:image-description)
     (271 . (tiff:make . ,(lambda (val)
                            (%mediafile:current-tiff-make val)
                            val)))
     (272 . (tiff:model . ,(lambda (val)
                             (%mediafile:current-tiff-model val)
                             val)))
     (273 . tiff:strip-offsets)
     (274 . tiff:orientation) ;; TODO: Make symbols?
     (277 . tiff:samples-per-pixel)
     (278 . tiff:rows-per-strip)
     (279 . tiff:strip-byte-counts)
     (280 . tiff:min-sample-value)
     (281 . tiff:max-sample-value)
     (282 . tiff:x-resolution)
     (283 . tiff:y-resolution)
     (284 . (tiff:planar-configuration .
                                       ,(lambda (val)
                                          (case val
                                            ((1) 'chunky)
                                            ((2) 'planar)
                                            (else val)))))
     (285 . tiff:page-name)
     (286 . tiff:x-position)
     (287 . tiff:y-position)
     (288 . tiff:free-offsets)
     (289 . tiff:free-byte-counts)
     (290 . tiff:gray-response-unit) ; TODO: Fractional number val?
     (291 . tiff:gray-response-curve)
     (292 . tiff:t4-options) ; TODO: Explode bitfields?
     (293 . tiff:t6-options) ; TODO: Explode bitfields?
     (296 . tiff:resolution-unit)
     (297 . tiff:page-number)
     (301 . tiff:transfer-function)
     (305 . tiff:software)
     (306 . tiff:date-time) ; TODO: convert timestamp?
     (315 . tiff:artist)
     (316 . tiff:host-computer)
     (317 . (tiff:predictor .
                            ,(lambda (val)
                               (case val
                                 ((1) 'none)
                                 ((2) 'horizontal-differencing)
                                 (else val)))))
     (318 . tiff:white-point)
     (319 . tiff:primary-chromaticities)
     (320 . tiff:color-map)
     (321 . tiff:halftone-hints)
     (322 . tiff:tile-width)
     (323 . tiff:tile-length)
     (324 . tiff:tile-offsets)
     (325 . tiff:tile-byte-counts)
     (332 . (tiff:ink-set .
                          ,(lambda (val)
                             (case val
                               ((1) 'cmyk)
                               ((2) 'not-cmyk)
                               (else val)))))
     (333 . tiff:ink-names)
     (334 . tiff:number-of-inks)
     (336 . tiff:dot-range)
     (337 . tiff:target-printer)
     (338 . (tiff:extra-samples .
                                ,(lambda (val)
                                   (case val
                                     ((0) 'unspecified-data)
                                     ((1) 'associated-alpha-data)
                                     ((2) 'unassociated-alpha-data)
                                     (else val)))))
     (339 . (tiff:sample-format .
                                ,(lambda (val)
                                   (case val
                                     ((1) 'unsigned-integer)
                                     ((2) 'twos-complement-signed-integer)
                                     ((3) 'ieee-floating-point)
                                     ((4) 'undefined)
                                     (else val)))))
     (340 . tiff:s-min-sample-value)
     (341 . tiff:s-max-sample-value)
     (342 . tiff:transfer-range)
     (512 . (tiff:jpeg-proc .
                            ,(lambda (val)
                               (case val
                                 ((1)  'baseline-sequential)
                                 ((14) 'lossless-with-huffman)
                                 (else val)))))
     (513 . tiff:jpeg-interchange-format)
     (514 . tiff:jpeg-interchange-format-length)
     (515 . tiff:jpeg-restart-interval)
     (517 . tiff:jpeg-lossless-predictors)
     (518 . tiff:jpeg-point-transforms)
     (519 . tiff:jpeg-q-tables)
     (520 . tiff:jpeg-dc-tables)
     (521 . tiff:jpeg-ac-tables)
     (529 . tiff:ycbcr-coefficients)
     (530 . tiff:ycbcr-sub-sampling)
     (531 . (tiff:ycbcr-positioning .
                                    ,(lambda (val)
                                       (case val
                                         ((1) 'centered)
                                         ((2) 'co-sited)
                                         (else val)))))
     (532 . tiff:reference-black-white)
     (33432 . tiff:copyright)

     (34665 . #(tiff:exif-ifd
                ,(lambda (in be? val)
                   (log-mediafile-debug "reading exif-ifd...")
                   (%mediafile:read-tiff-ifd-chain-as-flat in
                                                           be?
                                                           val
                                                           %mediafile:exif-ifd-entry-decoder-hash
                                                           "exif"))))
     (34853 . #(tiff:gps-ifd
                ,(lambda (in be? val)
                   (log-mediafile-debug "reading gps-ifd...")
                   (%mediafile:read-tiff-ifd-chain-as-flat in
                                                           be?
                                                           val
                                                           %mediafile:gps-ifd-entry-decoder-hash
                                                           "exif:gps")))))))

(define (%mediafile:tiff-entry-decode in be? hash unknown-prefix tag val)
  ;; TODO: Do we have to keep properties from each ifd separate, such as by
  ;; prefixing/suffixing the tag with the number
  ;; (e.g. "subfile-1:new-subfile-type" or "1:newsubfile-type")?  Or maybe
  ;; separate alists (and mediafile package can flatten alists)?  Or have an
  ;; option?
  (log-mediafile-debug "%mediafile:tiff-entry-decode :unknown-prefix ~S :tag ~S :val ~S"
                       unknown-prefix
                       tag
                       val)
  (let-values (((decoded-tag decoded-val)
                (cond ((hash-ref hash tag #f)
                       => (lambda (tag-decoder)
                            (cond ((symbol? tag-decoder)
                                   (values tag-decoder val))
                                  ((pair? tag-decoder)
                                   (values (car tag-decoder)
                                           ((cdr tag-decoder) val)))
                                  ((vector? tag-decoder)
                                   (values (vector-ref tag-decoder 0)
                                           ((vector-ref tag-decoder 1) in be? val)))
                                  (else (error '%mediafile:tiff-entry-decode
                                               "invalid tag decoder ~S for tag ~S"
                                               tag-decoder
                                               tag)))))
                      (else (values (string->symbol (string-append unknown-prefix
                                                                   ":unknown-"
                                                                   (number->string tag)))
                                    val)))))
    (log-mediafile-debug "%mediafile:tiff-entry-decode :decoded-tag ~S :decoded-val ~S"
                         decoded-tag
                         decoded-val)
    (cons decoded-tag decoded-val)))

(define (%mediafile:read-tiff-header-and-props in)
  (let* ((tiff-header-pos  (file-position in))
         (be?              (%mediafile:read-tiff-byte-order-be in))
         (tiff-marker      (%mediafile:read-tiff-uint16 in be?))
         (first-ifd-offset (%mediafile:read-tiff-uint32 in be?)))
    `((#f . ((tiff-endian . ,(if be? 'big 'little))))
      ,@(parameterize ((%mediafile:current-tiff-header-pos tiff-header-pos)
                       (%mediafile:current-tiff-make #f)
                       (%mediafile:current-tiff-model #f))
          ;; TODO: Having make and model as parameters is non-ideal.
          (%mediafile:read-tiff-ifd-chain-as-parts in
                                                   be?
                                                   first-ifd-offset
                                                   %mediafile:tiff-ifd-entry-decoder-hash
                                                   "tiff")))))

(define (%mediafile:bytes->jpeg-uint16 bstr (offset 0))
  (+ (arithmetic-shift (bytes-ref bstr (+ 1 offset)) 8)
     (bytes-ref bstr                        offset)))

(define (%mediafile:bytes->jpeg-uint32 bstr (offset 0))
  (+ (arithmetic-shift (bytes-ref bstr (+ 3 offset)) 24)
     (arithmetic-shift (bytes-ref bstr (+ 2 offset)) 16)
     (arithmetic-shift (bytes-ref bstr (+ 1 offset)) 8)
     (bytes-ref bstr                        offset)))

(define (%mediafile:read-jpeg-uint16 in)
  (%mediafile:bytes->jpeg-uint16 (read-bytes 2 in) 0))

(define (%mediafile:read-jpeg-uint32 in)
  (%mediafile:bytes->jpeg-uint32 (read-bytes 4 in) 0))

(define (%mediafile:read-jpeg-marker in)
  ;; Note: Per T.81 sec. B.1.1.2.
  (let ((two-bytes (read-bytes 2 in)))
    (if (= #xff (bytes-ref two-bytes 0))
        (let loop ((last-byte (bytes-ref two-bytes 1)))
          (case last-byte
            ((#xff) (loop (read-byte in)))
            ((#x00) (error '%mediafile:read-jpeg-marker
                           "encountered byte 0 in marker in ~S"
                           in))
            (else last-byte)))
        (error '%mediafile:read-jpeg-marker
               "expected first byte of marker ~S to be FF in ~S"
               two-bytes
               in))))

(define (seek-jpeg-marker-or-false in marker-byte)
  (and (regexp-try-match (byte-regexp (bytes #xff marker-byte)) in)
       #true))

(define (%mediafile:read-jpeg-file-props in (flat-within-parts? #t))
  (let ((soi (%mediafile:read-jpeg-marker in)))
    (or (equal? #xd8 soi)
        ;; TODO: Parse JFIF if no SOI?
        (error '%mediafile:read-jpeg-file-props
               "invalid JPEG SOI marker ~S"
               soi)))
  (or (seek-jpeg-marker-or-false in #xe1)
      (error '%mediafile:read-jpeg-file-props
             "could not find JPEG APP1 marker in ~S"
             in))
  (let ((parts-alist (let ((app1-segment-size (%mediafile:read-jpeg-uint16 in)))
                       (let ((exif-id (read-bytes 6 in)))
                         (or (equal? #"Exif\0\0" exif-id)
                             (error '%mediafile:read-jpeg-file-props
                                    "invalid APP1 Exif ID ~S in ~S"
                                    exif-id
                                    in)))
                       (%mediafile:read-tiff-header-and-props in))))
    ;; TODO: !!! APP2 entries? (let loop-app2-segments ((app2-propses '()))

    (if flat-within-parts?
        (map (lambda (part)
               (cons (car part)
                     (%mediafile:flatten-props-alist (cdr part))))
             parts-alist)
        parts-alist)))

(define (%mediafile:flatten-props-alist alist)
  (let loop ((alist       alist)
             (alist-stack '()))
    (if (null? alist)
        (if (null? alist-stack)
            '()
            (loop (car alist-stack)
                  (cdr alist-stack)))
        (let* ((pair      (car alist))
               (pair-name (car pair)))
          (case pair-name
            ((exif:canon:camera-settings
              exif:canon:panorama
              exif:canon:picture-info
              exif:canon:shot-info
              exif:interoperability-ifd
              tiff:exif-ifd
              tiff:gps-ifd)
             (loop (cdr pair)
                   (cons (cdr alist)
                         alist-stack)))
            ((exif:maker-note)
             (cond ((match (cdr pair)
                      ;; TODO: Make this work for other maker-note types
                      ((vector 'maker-note 'canon canon-alist)
                       (cons (cons 'exif-maker-note-type 'canon)
                             (loop canon-alist
                                   (cons (cdr alist)
                                         alist-stack))))
                      (_ #false))
                    => (lambda (x) x))
                   (else (cons pair
                               (loop (cdr alist)
                                     alist-stack)))))
            (else (cons pair
                        (loop (cdr alist)
                              alist-stack))))))))

(module+ test
  (test (%mediafile:flatten-props-alist
         '((tiff:a . "A")
           (tiff:b . "B")
           (tiff:c . "C")
           (tiff:exif-ifd
            (exif:d . "D")
            (exif:e . "E")
            (exif:f . "F")
            (exif:maker-note
             . #(maker-note canon
                            ((exif:canon:camera-settings
                              (exif:canon:camera-settings:g . "G")
                              (exif:canon:camera-settings:h . "H")
                              (exif:canon:camera-settings:i . "I"))
                             (exif:canon:j . "J")
                             (exif:canon:k . "K")
                             (exif:canon:l . "L")
                             (exif:canon:shot-info
                              (exif:canon:shot-info:m . "M")
                              (exif:canon:shot-info:n . "N")
                              (exif:canon:shot-info:o . "O"))
                             (exif:canon:p . "P")
                             (exif:canon:q . "Q")
                             (exif:canon:r . "R"))))
            (exif:s . "S")
            (exif:t . "T")
            (exif:interoperability-ifd
             (exif:interoperability:u . "U")
             (exif:interoperability:v . "V"))
            (exif:w . "W")
            (exif:x . "X")
            (exif:y . "Y"))
           (tiff:gps-ifd
            (exif:z . "Z"))))
        '((tiff:a . "A")
          (tiff:b . "B")
          (tiff:c . "C")
          (exif:d . "D")
          (exif:e . "E")
          (exif:f . "F")
          (exif:-maker-note-type . canon)
          (exif:canon:camera-settings:g . "G")
          (exif:canon:camera-settings:h . "H")
          (exif:canon:camera-settings:i . "I")
          (exif:canon:j . "J")
          (exif:canon:k . "K")
          (exif:canon:l . "L")
          (exif:canon:shot-info:m . "M")
          (exif:canon:shot-info:n . "N")
          (exif:canon:shot-info:o . "O")
          (exif:canon:p . "P")
          (exif:canon:q . "Q")
          (exif:canon:r . "R")
          (exif:s . "S")
          (exif:t . "T")
          (exif:interoperability:u . "U")
          (exif:interoperability:v . "V")
          (exif:w . "W")
          (exif:x . "X")
          (exif:y . "Y")
          (exif:z . "Z"))))

(provide get-tiff-file-props)
(define (get-tiff-file-props path)
  (call-with-input-file path %mediafile:read-tiff-header-and-props))

(provide get-jpeg-file-props)
(define (get-jpeg-file-props path)
  (call-with-input-file path %mediafile:read-jpeg-file-props))

(module+ test
  (call-with-input-file "test-files/public-domain/jpeg/htc-wildfire-s.jpg"
    %mediafile:read-jpeg-file-props))