typesetting/pitfall/pitfall/jpeg.rkt

#lang debug racket/base
(require
  racket/match
  "reference.rkt"
  "core.rkt"
  racket/dict
  sugar/unstable/dict)

#|
https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee
|#

(provide make-jpeg (struct-out $jpeg))

(define MARKERS '(#xffc0 #xffc1 #xffc2 #xffc3
                         #xffc5 #xffc6 #xffc7
                         #xffc8 #xffc9 #xffca #xffcb
                         #xffcc #xffcd #xffce #xffcf))

(struct $jpeg $img (bits channels colorSpace) #:transparent #:mutable)

(define (make-jpeg data [label #f])
  
  (define jpeg-ip (if (input-port? data) data (open-input-bytes data)))
  (unless (= (read-16bit-integer jpeg-ip) #xffd8)
    (error 'JPEG "Start of input marker byte not found"))
  (define marker (let loop ([skip 0])
                   (read-bytes skip jpeg-ip)
                   (define m (read-16bit-integer jpeg-ip))
                   (if (memv m MARKERS)
                       m
                       (loop (read-16bit-integer (peek-bytes 2 0 jpeg-ip))))))
  (read-16bit-integer jpeg-ip)
  (define bits (read-byte jpeg-ip))
  (define height (read-16bit-integer jpeg-ip))
  (define width (read-16bit-integer jpeg-ip))
  (define channels (read-byte jpeg-ip))
  (define colorSpace (case channels
                       [(1) 'DeviceGray]
                       [(3) 'DeviceRGB]
                       [(4) 'DeviceCMYK]))
  (define obj #f)
  ($jpeg data label width height obj jpeg-embed bits channels colorSpace))
  
(define (jpeg-embed jpeg)
  (unless ($img-ref jpeg)
    (set-$img-ref! jpeg
                   (make-ref
                    (mhash
                     'Type 'XObject
                     'Subtype 'Image
                     'BitsPerComponent ($jpeg-bits jpeg)
                     'Width ($img-width jpeg)
                     'Height ($img-height jpeg)
                     'ColorSpace ($jpeg-colorSpace jpeg)
                     'Filter 'DCTDecode)))
    
    ;; add extra decode params for CMYK images. By swapping the
    ;; min and max values from the default, we invert the colors. See
    ;; section 4.8.4 of the spec. 
    (when (eq? ($jpeg-colorSpace jpeg) 'DeviceCMYK)
      (dict-set! ($img-ref jpeg) 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0)))
    (file-position ($img-data jpeg) 0)
    (ref-write ($img-ref jpeg) ($img-data jpeg))
    (ref-end ($img-ref jpeg))))

(define (read-16bit-integer ip-or-bytes)
  (define signed #f) (define big-endian #t)
  (integer-bytes->integer (read-bytes 2 (match ip-or-bytes
                                          [(? bytes? bs) (open-input-bytes bs)]
                                          [ip ip])) signed big-endian))


(module+ test
  (require rackunit)
  (check-equal? (number->string (read-16bit-integer (bytes #x12 #x34 #x56)) 16) "1234")
  (define my-jpeg (make-jpeg (open-input-file "../ptest/assets/test.jpeg")))
  (check-equal? ($img-height my-jpeg) 533)
  (check-equal? ($img-width my-jpeg) 400)
  (check-equal? ($jpeg-channels my-jpeg) 3)
  (check-equal? ($jpeg-colorSpace my-jpeg) 'DeviceRGB))