anchor.diff:                           (ash (aref bytes 1) 8)
                            (aref bytes 0))))))
   
  -(defun read-tiff-header (stream)
  -  (let ((byte-order (read-bytes stream 2)))
  -    ))
  -
  -(defun read-ifd-entry (stream)
  +(defun read-int-32-array (stream count)
  +  (let ((array (make-array count :element-type '(unsigned-byte 32))))
  +    (loop for i below count
  +       do (setf (aref array i) (read-int-32 stream)))
  +    array))
  +
  +(defun read-rational (stream)
  +  (/ (read-int-32 stream) (read-int-32 stream)))
  +
  +(defun read-rational-array (stream count)
  +  (let ((array (make-array count :element-type '(unsigned-byte 32))))
  +    (loop for i below count
  +       do (setf (aref array i) (read-rational stream)))
  +    array))
  +
  +(defvar *tiff-field-types* nil)
  +
  +(defclass tiff-field ()
  +  ((reader :accessor tiff-field-reader :initarg reader)))
  +
  +(defun read-field-bytes (stream count)
  +  (if (<= count 4)
  +      (loop for i below 4
  +         for byte = (read-byte stream)
  +         when (< i count)
  +         collect byte)
  +      (let ((offset (read-int-32 stream))
  +            (field-pos (file-position stream)))
  +        (file-position stream offset)
  +        (prog1
  +            (read-bytes stream count)
  +          (file-position stream field-pos)))))
  +
  +(defun split-strings (char-list)
  +  (let ((strings))
  +    (cond ((listp char-list)
  +           (loop for char in char-list with string
  +              do
  +                (if (zerop char)
  +                    (push (coerce (nreverse string) 'string) strings)
  +                    (push (code-char char) string))))
  +          ((vectorp char-list)
  +           (loop for char across char-list with string
  +              do
  +                (if (zerop char)
  +                    (push (coerce (nreverse string) 'string) strings)
  +                    (push (code-char char) string)))))
  +    strings))
  +
  +(defun read-field-asciis (stream count)
  +  (if (<= count 4)
  +      (let ((strs (loop for i below 4
  +                     for byte = (read-byte stream)
  +                     when (< i count)
  +                     collect byte)))
  +        (split-strings strs))
  +      (let ((offset (read-int-32 stream))
  +            (field-pos (file-position stream)))
  +        (file-position stream offset)
  +        (prog1
  +            (split-strings (read-bytes stream count))
  +          (file-position stream field-pos)))))
  +
  +(defun read-field-shorts (stream count)
  +  (if (<= count 2)
  +      (loop for i below 2
  +         for short = (read-int-16 stream)
  +         when (< i count)
  +         collect short)
  +      (let ((offset (read-int-32 stream))
  +            (field-pos (file-position stream)))
  +        (file-position stream offset)
  +        (prog1
  +            (read-int-16-array stream count)
  +          (file-position stream field-pos)))))
  +
  +(defun read-field-longs (stream count)
  +  (let ((value-or-offset (read-int-32 stream)))
  +    (if (<= count 1)
  +        value-or-offset
  +        (let ((field-pos (file-position stream)))
  +          (file-position stream value-or-offset)
  +          (prog1
  +              (read-int-32-array stream count)
  +            (file-position stream field-pos))))))
  +
  +(defun read-field-rationals (stream count)
  +    (let ((offset (read-int-32 stream)))
  +      (let ((field-pos (file-position stream)))
  +        (file-position stream offset)
  +        (prog1
  +            (read-rational-array stream count)
  +          (file-position stream field-pos)))))
  +
  +(defconstant +image-width-tag+ 256)
  +(defconstant +image-length-tag+ 257)
  +(defconstant +bits-per-sample-tag+ 258)
  +(defconstant +compression-tag+ 259)
  +(defconstant +photometric-interpretation-tag+ 262)
  +(defconstant +strip-offsets-tag+ 273)
  +(defconstant +samples-per-pixel-tag+ 277)
  +(defconstant +rows-per-strip-tag+ 278)
  +(defconstant +rows-per-strip-tag+ 278)
  +(defconstant +strip-byte-counts-tag+ 279)
  +(defconstant +x-resolution-tag+ 282)
  +(defconstant +y-resolution-tag+ 283)
  +(defconstant +resolution-unit-tag+ 296)
  +
  +(macrolet ((def-tiff-field-type (type value reader)
  +             `(progn
  +                (defconstant ,(intern (format nil "+field-type-~A+" type)) ,value)
  +                (pushnew (cons ',type ,value) *tiff-field-types* :test 'equal))))
  +  (def-tiff-field-type byte 1 'read-field-bytes)
  +  (def-tiff-field-type ascii 2 nil)
  +  (def-tiff-field-type short 3 read-field-shorts)
  +  (def-tiff-field-type long 4 nil)
  +  (def-tiff-field-type rational 5 nil)
  +  (def-tiff-field-type sbyte 6 nil)
  +  (def-tiff-field-type undefined 7 nil)
  +  (def-tiff-field-type sshort 8 nil)
  +  (def-tiff-field-type slong 9 nil)
  +  (def-tiff-field-type srational 10 nil)
  +  (def-tiff-field-type float 11 nil)
  +  (def-tiff-field-type double 12 nil))
  +
  +(defun read-ifd-tag-type-and-count (stream)
     (let ((tag (read-int-16 stream))
           (field-type (read-int-16 stream))
  -        (values (read-int-32 stream))
  -        (value-offset (read-int-32 stream)))
  -    (list tag field-type values value-offset)))
  +        (value-count (read-int-32 stream)))
  +    (list tag field-type value-count)))
  +
  +(defun read-ifd-entry (stream)
  +  (let ((tag-type-and-count (read-ifd-tag-type-and-count stream)))
  +    (destructuring-bind (tag field-type value-count)
  +        tag-type-and-count
  +      (list tag field-type value-count
  +            (cond ((= field-type +field-type-short+)
  +                   (read-field-shorts stream value-count))
  +                  ((= field-type +field-type-ascii+)
  +                   (read-field-asciis stream value-count))
  +                  ((= field-type +field-type-long+)
  +                   (read-field-longs stream value-count))
  +                  ((= field-type +field-type-rational+)
  +                   (read-field-rationals stream value-count))
  +                  ((= field-type +field-type-undefined+)
  +                   (read-field-bytes stream value-count))
  +                  (t (let ((value-offset (read-int-32 stream)))
  +                       value-offset)))))))
  +
  +(defun ifd-entry-values (ifd-entry)
  +  (elt ifd-entry 3))
   
   (defun read-ifd (stream)
     (let ((ifd-count (read-int-16 stream)))
  
positive.code:        (progn
           (file-position stream ifd)
           (read-ifd stream))))
  
  (defun read-tiff-stream (stream)
    (let ((*byte-order*))
  
negative.code:       (unless (= tiff-magic 42)
          (error "Error reading TIFF file. ~S is not 42." tiff-magic)))
      (let ((ifds (read-ifds stream)))
        (let ((ifd (car ifds)))
          (read-image stream ifd)))))
  
  (defun read-tiff-file (pathname)
    (with-open-file (stream pathname :direction :input :element-type :default)
      (read-tiff-stream stream)))
  
  (defun write-tiff-stream (stream image)
    (declare (ignore stream image))
    (error "Not yet!"))
  
  (defun write-tiff-file (pathname image)
    (with-open-file (stream pathname :direction :output :element-type :default)
      (write-tiff-stream stream image)))
  