jpeg sizes or binary shuffle (lisp)

2006-06-30 11:14:50

I was going to use jpeg.lisp to get jpeg dimensions for cl-picarc but defconstant and sbcl would not play nice. Plus it was a little heavy handed for what I needed, so I rolled by own:

;; I only need the dimisions of a jpeg so I am going
;; to roll my own dimension extractor
;; based in part on
;; http://dev.w3.org/cvsweb/Amaya/libjpeg/rdjpgcom.c?rev=1.2

(defun jpeg-next-marker (in)
  (labels ((1-byte (s c)
                   (if (= c #xff) 
                       (1-byte s (read-byte s))
                       c)))
    (1-byte in (read-byte in))))

(defun jpeg-skip-variable (in)
  (let ((len (2-bytes in)))
    (if (< len 2) (error "Bad jpeg marker length")
        (dotimes (i (- len 1)) 
          (read-byte in)))))
    

(defun jpeg-first-marker (in)
  (let ((c1 (read-byte in))
        (c2 (read-byte in)))
    (if (not (and (= c1 #xff) (= c2 #xd8)))
        (error "Not a JPEG file"))
    c2))

;;msb first
(defun 2-bytes (in)
  (let ((b1 (read-byte in))
        (b2 (read-byte in)))
    (dpb b1 (byte 8 8) (dpb b2 (byte 8 0) #x0))))

(defun jpeg-process-image-size (in)
  (2-bytes in)
  (read-byte in)
  (let ((height (2-bytes in))
        (width  (2-bytes in)))
    (values width height)))
                  
(defun jpeg-image-size (file-name)
  (with-open-file (s file-name :element-type '(unsigned-byte 8))
    (if (not (= (jpeg-first-marker s) #xd8))
        (values 0 0)
        (progn
          (loop
           (let ((marker (jpeg-next-marker s)))
             (cond ((or (= marker #xC0)
                        (= marker #xC1)
                        (= marker #xC2)
                        (= marker #xC3)
                        (= marker #xC5)
                        (= marker #xC6)
                        (= marker #xC7)
                        (= marker #xC9)
                        (= marker #xCA)
                        (= marker #xCB)
                        (= marker #xCD)
                        (= marker #xCE)
                        (= marker #xCF)) 
                    (return (jpeg-process-image-size s)))
                   ((or (= marker #xda)
                        (= marker #xd9)) (return (values 0 0)))
                   (t (jpeg-skip-variable s)))))))))

This is the first time I have had to work with binary files using lisp. It is kind of nice. I am using cl-png to get the png image sizes and I do not plan to support gifs.