structify jpeg

pitfall/pitfall/image.rkt

@@ -10,8 +10,10 @@
                  [(bytes? src) (open-input-bytes src)]
                  [(regexp-match #rx"^data:.+;base64,(.*)$" src) (void)] ;; base64 ; todo
                  [else (open-input-file src)]))
-  (cond
-      [(equal? (peek-bytes 2 0 data) (bytes #xff #xd8)) (make-object JPEG data label)]
-      [(equal? (peek-bytes 4 0 data) (apply bytes (map char->integer '(#\u0089 #\P #\N #\G)))) (make-png data label)]
+  (define img-constructor
+    (cond
+      [(equal? (peek-bytes 2 0 data) (bytes #xff #xd8)) make-jpeg]
+      [(equal? (peek-bytes 4 0 data) (apply bytes (map char->integer '(#\u0089 #\P #\N #\G)))) make-png]
       [else (raise-argument-error 'PDFImage-open "valid image format" src)]))
+  (img-constructor data label))
            

pitfall/pitfall/jpeg.rkt

@@ -3,6 +3,7 @@
   racket/class
   racket/match
   "reference.rkt"
+  "core.rkt"
   racket/dict
   sugar/unstable/dict)
 
@@ -10,58 +11,61 @@
 https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee
 |#
 
-(provide JPEG)
+(provide make-jpeg (struct-out $jpeg))
 
 (define MARKERS '(#xffc0 #xffc1 #xffc2 #xffc3
                          #xffc5 #xffc6 #xffc7
                          #xffc8 #xffc9 #xffca #xffcb
                          #xffcc #xffcd #xffce #xffcf))
 
-(define JPEG
-  (class object%
-    (super-new)
-    (init-field [(@data data)] [(@label 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)
-    (field [(@bits bits) (read-byte jpeg-ip)]
-           [(@height height) (read-16bit-integer jpeg-ip)]
-           [(@width width) (read-16bit-integer jpeg-ip)]
-           [(@channels channels) (read-byte jpeg-ip)]
-           [(@colorSpace colorSpace) (case @channels
-                                       [(1) 'DeviceGray]
-                                       [(3) 'DeviceRGB]
-                                       [(4) 'DeviceCMYK])]
-           [(@obj obj) #f])
+(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/public (embed)
-      (unless @obj
-        (set! @obj (make-ref
+(define (jpeg-embed jpeg)
+  (unless ($img-obj jpeg)
+    (set-$img-obj! jpeg
+                   (make-ref
                     (mhash
                      'Type 'XObject
                      'Subtype 'Image
-                     'BitsPerComponent @bits
-                     'Width @width
-                     'Height @height
-                     'ColorSpace @colorSpace
+                     '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? @colorSpace 'DeviceCMYK)
-          (dict-set! @obj 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0)))
-        (file-position @data 0)
-        (ref-write @obj @data)
-        (ref-end @obj)))))
+    ;; 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-obj 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-obj jpeg) ($img-data jpeg))
+    (ref-end ($img-obj jpeg))))
 
 (define (read-16bit-integer ip-or-bytes)
   (define signed #f) (define big-endian #t)
@@ -70,8 +74,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee
                                           [ip ip])) signed big-endian))
 
 
-
 (module+ test
   (require rackunit)
   (check-equal? (number->string (read-16bit-integer (bytes #x12 #x34 #x56)) 16) "1234")
-  (make-object JPEG (open-input-file "../ptest/assets/test.jpeg")))
+  (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))

pitfall/pitfall/png.rkt

@@ -28,89 +28,89 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee
   ($png data label width height obj png-embed image pixel-bit-length img-data alpha-channel))
 
 (define (png-embed png)
-      (unless ($img-obj png)
-        (set-$img-obj! png
-              (make-ref
-               (mhash 'Type 'XObject
-                      'Subtype 'Image
-                      'BitsPerComponent (hash-ref ($png-image png) 'bits)
-                      'Width ($img-width png)
-                      'Height ($img-height png)
-                      'Filter 'FlateDecode)))
+  (unless ($img-obj png)
+    (set-$img-obj! png
+                   (make-ref
+                    (mhash 'Type 'XObject
+                           'Subtype 'Image
+                           'BitsPerComponent (hash-ref ($png-image png) 'bits)
+                           'Width ($img-width png)
+                           'Height ($img-height png)
+                           'Filter 'FlateDecode)))
 
-        (unless (hash-ref ($png-image png) 'hasAlphaChannel #f)
-          (define params (make-ref
-                          (mhash 'Predictor 15
-                                 'Colors (hash-ref ($png-image png) 'colors)
-                                 'BitsPerComponent (hash-ref ($png-image png) 'bits)
-                                 'Columns ($img-width png))))
-          (dict-set! ($img-obj png) 'DecodeParms params)
-          (ref-end params))
+    (unless (hash-ref ($png-image png) 'hasAlphaChannel #f)
+      (define params (make-ref
+                      (mhash 'Predictor 15
+                             'Colors (hash-ref ($png-image png) 'colors)
+                             'BitsPerComponent (hash-ref ($png-image png) 'bits)
+                             'Columns ($img-width png))))
+      (dict-set! ($img-obj png) 'DecodeParms params)
+      (ref-end params))
 
-        (cond
-          [(hash-has-key? ($png-image png) 'palette)
-           ;; embed the color palette in the PDF as an object stream
-           (define palette-ref (make-ref))
-           (ref-write palette-ref (hash-ref ($png-image png) 'palette))
-           (ref-end palette-ref)
-           ;; build the color space array for the image
-           (dict-set! ($img-obj png) 'Colorspace
-                      (list 'Indexed 'DeviceRGB (sub1 (/ (bytes-length (hash-ref ($png-image png) 'palette)) 3)) palette-ref))]
-          [else (dict-set! ($img-obj png) 'ColorSpace 'DeviceRGB)])
+    (cond
+      [(hash-has-key? ($png-image png) 'palette)
+       ;; embed the color palette in the PDF as an object stream
+       (define palette-ref (make-ref))
+       (ref-write palette-ref (hash-ref ($png-image png) 'palette))
+       (ref-end palette-ref)
+       ;; build the color space array for the image
+       (dict-set! ($img-obj png) 'Colorspace
+                  (list 'Indexed 'DeviceRGB (sub1 (/ (bytes-length (hash-ref ($png-image png) 'palette)) 3)) palette-ref))]
+      [else (dict-set! ($img-obj png) 'ColorSpace 'DeviceRGB)])
 
    
-        (cond
-          [(hash-ref ($png-image png) 'transparency #f)
-           (cond
-             [(hash-ref (hash-ref ($png-image png) 'transparency) 'grayscale #f)
-              (error 'transparency-grayscale-not-implemented)]
-             [(hash-ref (hash-ref ($png-image png) 'transparency) 'rgb #f)
-              (error 'transparency-rgb-not-implemented)]
-             [(hash-ref (hash-ref ($png-image png) 'transparency) 'indexed #f)
-              (error 'transparency-indexed-not-implemented)])]
-          [(hash-ref ($png-image png) 'hasAlphaChannel #f)
-           ;; For PNG color types 4 and 6, the transparency data is stored as a alpha
-           ;; channel mixed in with the main image data. Separate this data out into an
-           ;; SMask object and store it separately in the PDF.]
-           (define-values (img-bytes alpha-bytes) (split-alpha-channel))
-           (set-$png-img-data! png (deflate img-bytes))
-           (set-$png-alpha-channel! png (deflate alpha-bytes))]))
+    (cond
+      [(hash-ref ($png-image png) 'transparency #f)
+       (cond
+         [(hash-ref (hash-ref ($png-image png) 'transparency) 'grayscale #f)
+          (error 'transparency-grayscale-not-implemented)]
+         [(hash-ref (hash-ref ($png-image png) 'transparency) 'rgb #f)
+          (error 'transparency-rgb-not-implemented)]
+         [(hash-ref (hash-ref ($png-image png) 'transparency) 'indexed #f)
+          (error 'transparency-indexed-not-implemented)])]
+      [(hash-ref ($png-image png) 'hasAlphaChannel #f)
+       ;; For PNG color types 4 and 6, the transparency data is stored as a alpha
+       ;; channel mixed in with the main image data. Separate this data out into an
+       ;; SMask object and store it separately in the PDF.]
+       (define-values (img-bytes alpha-bytes) (split-alpha-channel png))
+       (set-$png-img-data! png (deflate img-bytes))
+       (set-$png-alpha-channel! png (deflate alpha-bytes))]))
 
-      (when ($png-alpha-channel png)
-        (define sMask-ref
-          (make-ref
-           (mhash 'Type 'XObject
-                  'Subtype 'Image
-                  'Height ($img-height png)
-                  'Width ($img-width png)
-                  'BitsPerComponent 8
-                  'Filter 'FlateDecode
-                  'ColorSpace 'DeviceGray
-                  'Decode '(0 1))))
-        (ref-write sMask-ref ($png-alpha-channel png))
-        (ref-end sMask-ref)
-        (dict-set! ($img-obj png) 'SMask sMask-ref))
+  (when ($png-alpha-channel png)
+    (define sMask-ref
+      (make-ref
+       (mhash 'Type 'XObject
+              'Subtype 'Image
+              'Height ($img-height png)
+              'Width ($img-width png)
+              'BitsPerComponent 8
+              'Filter 'FlateDecode
+              'ColorSpace 'DeviceGray
+              'Decode '(0 1))))
+    (ref-write sMask-ref ($png-alpha-channel png))
+    (ref-end sMask-ref)
+    (dict-set! ($img-obj png) 'SMask sMask-ref))
   
-      ;; embed the actual image data
-      (ref-write ($img-obj png) ($png-img-data png))
-      (ref-end ($img-obj png)))
+  ;; embed the actual image data
+  (ref-write ($img-obj png) ($png-img-data png))
+  (ref-end ($img-obj png)))
 
 
-    (define (split-alpha-channel png)
-      (define ip ($img-data png))
-      (file-position ip 0)
-      (define bmap (read-bitmap ip 'png/alpha))
-      (define pixels (make-bytes (* 4 ($img-width png) ($img-height png))))
-      (send bmap get-argb-pixels 0 0 ($img-width png) ($img-height png) pixels)
-      (parameterize ([current-input-port (open-input-bytes pixels)])
-        (define argb-len (/ (bytes-length pixels) 4))
-        (define img-bytes (make-bytes (* argb-len 3)))
-        (define alpha-bytes (make-bytes argb-len))
-        (for ([argb-bytes (in-port (λ (p) (read-bytes 4 p)))]
-              [i (in-range argb-len)])
-          (bytes-copy! alpha-bytes i argb-bytes 0 1)
-          (bytes-copy! img-bytes (* i 3) argb-bytes 1 4))
-        (values img-bytes alpha-bytes)))
+(define (split-alpha-channel png)
+  (define ip ($img-data png))
+  (file-position ip 0)
+  (define bmap (read-bitmap ip 'png/alpha))
+  (define pixels (make-bytes (* 4 ($img-width png) ($img-height png))))
+  (send bmap get-argb-pixels 0 0 ($img-width png) ($img-height png) pixels)
+  (parameterize ([current-input-port (open-input-bytes pixels)])
+    (define argb-len (/ (bytes-length pixels) 4))
+    (define img-bytes (make-bytes (* argb-len 3)))
+    (define alpha-bytes (make-bytes argb-len))
+    (for ([argb-bytes (in-port (λ (p) (read-bytes 4 p)))]
+          [i (in-range argb-len)])
+      (bytes-copy! alpha-bytes i argb-bytes 0 1)
+      (bytes-copy! img-bytes (* i 3) argb-bytes 1 4))
+    (values img-bytes alpha-bytes)))
 
 
 ;; test files