Get image dimensions (PNG/JPG) without loading the file in Common Lisp
Hey Common Lispers! Why are we so few, when this language, and tooling, is so amazing and fabulous? :)
Today I added PhotoSwipe on a website I'm working on for a friend. The backend is written in Common Lisp, because life's too short. PhotoSwipe is a wonderful library, It Just Works™, but it has this minor-yet-inconvenient requirement — you have to declare the image size (width and height) for each thumbnail, in some data attributes. I've searched for some Common Lisp code that could fetch an image dimensions from the file, and I couldn't find any. There are image manipulation libraries, alright, but they parse and decode the whole file (and that's slow), when I only need the dimensions. Those could be fetched from the headers, reading just a few bytes and consing nothing at all (or almost nothing).
Following research, since I couldn't find any code that does that, I wrote my own. I hope it will be useful for someone else too. Pasting it below, or get it from this GitHub gist. It should work okay for PNG, JPEG and GIF. I'm not so sure about WEBP. Any comments or improvements are welcome!
Update: I added a proper parser to figure out orientation from the Exif block (which is really a TIFF header).
(defgeneric image-size (input)
(:method ((input pathname))
(with-open-file (input input :element-type 'unsigned-byte)
(image-size input)))
(:method ((input string))
(with-open-file (input input :element-type 'unsigned-byte)
(image-size input)))
(:method ((input stream))
(labels ((read-num (count &key pos little)
(when pos (file-position input pos))
(loop with num = 0
for i = 0 then (+ i 8)
for j = (* 8 (1- count)) then (- j 8)
repeat count
do (setf (ldb (byte 8 (if little i j)) num)
(read-byte input))
finally (return num)))
(pos (&optional pos)
(if pos
(file-position input pos)
(file-position input)))
(skip (count)
(pos (+ count (pos))))
(maybe-png ()
(ignore-errors
(file-position input 0)
(when (and (= #x89 (read-byte input))
(= #x50 (read-byte input))
(= #x4E (read-byte input))
(= #x47 (read-byte input))
(= #x0D (read-byte input))
(= #x0A (read-byte input))
(= #x1A (read-byte input))
(= #x0A (read-byte input)))
(list (read-num 4 :pos 16) (read-num 4 :pos 20)))))
(maybe-gif ()
(ignore-errors
(file-position input 0)
(when (and (= #x47 (read-byte input))
(= #x49 (read-byte input))
(= #x46 (read-byte input))
(= #x38 (read-byte input))
(let ((b (read-byte input)))
(or (= #x37 b)
(= #x39 b)))
(= #x61 (read-byte input)))
(list (read-num 2 :pos 6 :little t)
(read-num 2 :pos 8 :little t)))))
(tiff-orientation ()
;; TIFF starts with two bytes specifying the byte order
;; 0x4949 means little-endian.
(let* ((start-of-tiff (pos))
(le (= #x4949 (read-num 2))))
;; two bytes encoding the number 42 follow
(when (= 42 (read-num 2 :little le))
;; four bytes encoding the image file directory offset,
;; relative to start-of-tiff, so jump to that location.
(pos (+ start-of-tiff (read-num 4 :little le)))
;; two bytes count the number of directory entries
(let ((count-entries (read-num 2 :little le)))
(loop repeat count-entries
for pos = (pos)
for tag = (read-num 2 :little le)
for type = (read-num 2 :little le)
for count = (read-num 4 :little le)
for value = (read-num (case type
(1 1)
(3 2)
(otherwise 4))
:little le)
;; do (format t "~4,'0X ~D ~D ~8,'0X~%" tag type count value)
when (= tag #x0112)
do (return value)
do (pos (+ 12 pos)))))))
(maybe-jpeg ()
(let (width height orientation)
(ignore-errors
(file-position input 0)
(when (and (= #xFF (read-byte input))
(= #xD8 (read-byte input)))
(loop do
(unless (= #xFF (read-byte input))
(return))
(let* ((marker (read-byte input))
(index (pos))
(length (read-num 2)))
(case marker
((#xC0 #xC1 #xC2 #xC3 #xC5 #xC6 #xC7 #xC9 #xCA #xCB #xCD #xCE #xCF)
(skip 1)
(setf height (read-num 2)
width (read-num 2))
(return))
((#xE1)
(when (= #x45786966 (read-num 4)) ; Exif
(skip 2) ; two nulls
(setf orientation (tiff-orientation)))))
(pos (+ index length))))))
(when (and width height)
(if (and orientation (or (= 6 orientation)
(= 8 orientation)))
(list height width)
(list width height)))))
(maybe-webp ()
(ignore-errors
(file-position input 0)
(when (and (= #x52 (read-byte input)) ; R
(= #x49 (read-byte input)) ; I
(= #x46 (read-byte input)) ; F
(= #x46 (read-byte input)) ; F
(skip 4)
(= #x57 (read-byte input)) ; W
(= #x45 (read-byte input)) ; E
(= #x42 (read-byte input)) ; B
(= #x50 (read-byte input))) ; P
(let ((seq (make-array 4 :element-type 'unsigned-byte)))
(when (= (read-sequence seq input)
(length seq))
(let ((format (map 'string #'code-char seq)))
(when (string= format "VP8 ")
(return-from maybe-webp (list (read-num 2 :pos 26 :little t)
(read-num 2 :pos 28 :little t))))
(when (string= format "VP8X")
(return-from maybe-webp (list (1+ (read-num 3 :pos 24 :little t))
(1+ (read-num 3 :pos 27 :little t))))))))))))
(or (maybe-jpeg)
(maybe-png)
(maybe-gif)
(maybe-webp)))))