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 ()
                (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 ()
                (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)
                  (file-position input 0)
                  (when (and (= #xFF (read-byte input))
                             (= #xD8 (read-byte input)))
                    (loop do
                      (unless (= #xFF (read-byte input))
                      (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))
                           (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 ()
                (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)
5 comments. This is HOT!

Add your comment

# Mariano Montone
2023-08-15 21:43
Hi. This is nice. May I include as a module in ? It goes with your Copyright and license. I created mutils specially for this kind of thing, things that we usually put in gists, but I think they'd better be available somewhere else that makes it easier to load.
# Mishoo
2023-08-15 23:20
Sounds good. :) Feel free to add it. MIT license, if that matters.
# Zach
2023-08-16 14:03
I have some old code to do this here: - I guess it's not exactly useful as-is because I never bothered to document or license it.
# Mishoo
2023-08-16 14:40
Nice! It's weird that I did not found it while googling yesterday. One thing I noticed after I posted this, was that for some images it flipped the width and height, so I updated the code to dig the orientation bit from the EXIF data, and switch values if needed. Your code seems to miss that as well.
# Mariano
2023-08-17 16:24
I've added it: Thank you.
Welcome! (login)

Get image dimensions (PNG/JPG) without loading the file in Common Lisp

  • Published: 2023-08-15
  • Modified: 2023-08-31 10:15
  • By: Mishoo
  • Comments: 5 (add)