Start of a clojure JPEG file decoder.

jpeg.clj

(ns scottdw.jpeg
  (:import [clojure.lang Keyword]
           [com.drew.imaging ImageMetadataReader]
           [com.drew.metadata Directory Metadata Tag]
           [java.net URI]
           [java.nio ByteBuffer]
           [java.nio.file Files Paths])
  (:require [clojure.java.io :as io]))

(defn read-metadata [^String file-name]
  (-> file-name  io/file ImageMetadataReader/readMetadata))

(defn metadata-to-string [^Metadata metadata]
  (let [sb (StringBuilder.)]
    (doseq [^Directory d (.getDirectories metadata)]
      (.append sb (.getName d))
      (.append sb \newline)
      (doseq [^Tag t (.getTags d)]
        (doto sb
          (.append \tab)
          (.append (.getTagName t))
          (.append " : ")
          (.append (.getDescription t))
          (.append \newline))))
    (.toString sb)))

(defn read-into-byte-buffer [^String file-name]
  (-> file-name io/file .toPath Files/readAllBytes ByteBuffer/wrap))

(defrecord Marker [^short code-assignment ^Keyword symbol ^String description ^boolean segment])

(defn make-markers [start-value end-value keyword-prefix description-format segment]
  (let [n (inc (- end-value start-value))]
    (map #(Marker. (unchecked-short (+ start-value %))
                   (keyword (str keyword-prefix \_ %))
                   (format description-format %)
                   segment)
       (range n))))

(def markers
  (reduce into
[[
;; Start Of Frame markers, non-differential, Huffman coding
  (Marker. (unchecked-short 0xFFC0) :SOF_0 "Baseline DCT" true)
  (Marker. (unchecked-short 0xFFC1) :SOF_1 "Extended sequential DCT" true)
  (Marker. (unchecked-short 0xFFC2) :SOF_2 "Progressive DCT" true)
  (Marker. (unchecked-short 0xFFC3) :SOF_3 "Lossless (sequential)" true)
;; Start Of Frame markers, differential, Huffman coding
  (Marker. (unchecked-short 0xFFC5) :SOF_5 "Differential sequential DCT" true)
  (Marker. (unchecked-short 0xFFC6) :SOF_6 "Differential progressive DCT" true)
  (Marker. (unchecked-short 0xFFC7) :SOF_7 "Differential lossless (sequential)" true)
;; Start Of Frame markers, non-differential, arithmetic coding
  (Marker. (unchecked-short 0xFFC8) :JPG "Reserved for JPEG extensions" true)
  (Marker. (unchecked-short 0xFFC9) :SOF9 "Extended sequential DCT" true)
  (Marker. (unchecked-short 0xFFCA) :SOF10 "Progressive DCT" true)
  (Marker. (unchecked-short 0xFFCB) :SOF11 "Lossless (sequential)" true)
;; Start Of Frame markers, differential, arithmetic coding
  (Marker. (unchecked-short 0xFFCD) :SOF13 "Differential sequential DCT" true)
  (Marker. (unchecked-short 0xFFCE) :SOF14 "Differential progressive DCT" true)
  (Marker. (unchecked-short 0xFFCF) :SOF15 "Differential lossless (sequential)" true)
;; Huffman table specification
  (Marker. (unchecked-short 0xFFC4) :DHT "Define Huffman table(s)" true)
;; Arithmetic coding conditioning specification
  (Marker. (unchecked-short 0xFFCC) :DAC "Define arithmetic coding conditioning(s)" true)
;; Other markers
  (Marker. (unchecked-short 0xFFD8) :SOI "Start of image" false)
  (Marker. (unchecked-short 0xFFD9) :EOI "End of image" false)
  (Marker. (unchecked-short 0xFFDA) :SOS "Start of scan" true)
  (Marker. (unchecked-short 0xFFDB) :DQT "Define quantization table(s)" true)
  (Marker. (unchecked-short 0xFFDC) :DNL "Define number of lines" true)
  (Marker. (unchecked-short 0xFFDD) :DRI "Define restart interval" true)
  (Marker. (unchecked-short 0xFFDE) :DHP "Define hierarchical progression" true)
  (Marker. (unchecked-short 0xFFDF) :EXP "Expand reference component(s)" true)
  (Marker. (unchecked-short 0xFFFE) :COM "Comment" true)
;; Reserved markers
  (Marker. (unchecked-short 0xFF01) :TEM "For temporary private use in arithmetic coding" false)
]
;; Restart interval termination
 (make-markers 0xFFD0 0xFFD7 "RST" "Restart with modulo 8 count \"%1$s\"" false)
;; Reserved for application segments
 (make-markers 0xFFE0 0xFFEF "APP" "Application segment [%1$s]" true)
;; Reserved for JPEG extensions
 (make-markers 0xFFF0 0xFFFD "JPG" "JPEG extension [%1$s]" true)
;; Reserved
 (make-markers 0xFF02 0xFFBF "RES" "Reserved [%1$s]" true)]))

(def marker-map (zipmap (map :code-assignment markers) markers))

(defn seek-next-marker [^ByteBuffer bb]
  (if (> (.remaining bb) 1)
    (let [p (.position bb)
          b (.get bb)]
      (if (= b (unchecked-byte 0xFF))
        (if (marker-map (unchecked-short (bit-or (bit-shift-left b 8)
                                                 (.get bb))))
          (do (.position bb p) p)
          (recur (doto bb (.position (inc p)))))
        (recur bb)))
    -1))

(defn read-marker [^ByteBuffer bb]
  (let [p (.position bb)
        m (.getShort bb)
        {:keys [segment symbol] :as marker} (marker-map m)]
    (when segment
      (do (.position bb (+ p (+ (.getShort bb) 2)))))
    (let [np (seek-next-marker bb)]
      [symbol p (- (if (neg? np) (.limit bb) np) p)])))

(defn read-all-markers [^ByteBuffer bb]
  (let [dup (doto (.duplicate bb) (.position 0))]
    (loop [markers []]
      (if (neg? (seek-next-marker dup))
        markers
        (recur (conj markers (read-marker dup)))))))