structify png

pitfall/pitfall/core.rkt

@@ -4,6 +4,8 @@
 
 ;; structs
 
+(struct $img (data label width height obj embed-proc) #:transparent #:mutable)
+
 (struct $ref (id payload offset port) #:transparent #:mutable
   #:methods gen:dict
   [(define (dict-ref $ key [thunk (λ () (error 'dict-ref-key-not-found))])

pitfall/pitfall/image.rkt

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

pitfall/pitfall/images.rkt

@@ -4,6 +4,7 @@
   racket/match
   sugar/unstable/dict
   "image.rkt"
+  "core.rkt"
   "page.rkt")
 (provide image-mixin)
 
@@ -21,14 +22,15 @@
 
       (define image (cond
                       [(and (string? src) (hash-ref @image-registry src #f))]
-                      [(and (object? src) (get-field width src) (get-field height src)) src]
+                      [(and (object? src) ($img-width src) ($img-height src)) src]
+                      [(and ($img? src) ($img-width src) ($img-height src)) src]
                       [else (send this open-image src)]))
-      (unless (get-field obj image) (send image embed))
+      (unless ($img-obj image) (($img-embed-proc image) image))
   
-      (hash-ref! (page-xobjects (page)) (get-field label image) (get-field obj image))
+      (hash-ref! (page-xobjects (page)) ($img-label image) ($img-obj image))
 
-      (define image-width (get-field width image))
-      (define image-height (get-field height image))
+      (define image-width ($img-width image))
+      (define image-height ($img-height image))
       (define options-width (hash-ref options 'width #f))
       (define options-height (hash-ref options 'height #f))
       (define w (or options-width image-width))
@@ -90,7 +92,7 @@
       (when (= @y y) (set! y (+ y h)))
       (send this save)
       (send this transform w 0 0 (- h) x (+ y h))
-      (send this add-content (format "/~a Do" (get-field label image)))
+      (send this add-content (format "/~a Do" ($img-label image)))
       (send this restore)
       this)
 

pitfall/pitfall/png.rkt

@@ -2,6 +2,7 @@
 (require
   racket/class
   "reference.rkt"
+  "core.rkt"
   racket/dict
   racket/draw
   sugar/unstable/dict)
@@ -9,98 +10,98 @@
 #|
 https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee
 |#
-
 (require "png-reader.rkt" "zlib.rkt")
-(provide PNG)
 
-(define PNG
-  (class object%
-    (super-new)
-    (init-field [(@data data)] [label #f])
-  
-    (field [(@image image) (read-png @data)] ; `image` is a hash
-           [pixel-bit-length (hash-ref @image 'pixelBitlength)]
-           [(@width width) (hash-ref @image 'width)]
-           [(@height height) (hash-ref @image 'height)]
-           [(@img-data img-data) (hash-ref @image 'imgData)]
-           [(@alpha-channel alpha-channel) #f]
-           [(@obj obj) #f])
+(provide (all-defined-out))
+
+(struct $png $img (image pixel-bit-length img-data alpha-channel)
+  #:transparent #:mutable)
+
+(define (make-png data [label #f])
+  (define image (read-png data))
+  (define pixel-bit-length (hash-ref image 'pixelBitlength))
+  (define width (hash-ref image 'width))
+  (define height (hash-ref image 'height))
+  (define img-data (hash-ref image 'imgData))
+  (define alpha-channel #f)
+  (define obj #f)
+  ($png data label width height obj png-embed image pixel-bit-length img-data alpha-channel))
 
-    (define/public (embed)
-      (unless @obj
-        (set! @obj
+(define (png-embed png)
+      (unless ($img-obj png)
+        (set-$img-obj! png
               (make-ref
                (mhash 'Type 'XObject
                       'Subtype 'Image
-                      'BitsPerComponent (hash-ref @image 'bits)
-                      'Width @width
-                      'Height @height
+                      'BitsPerComponent (hash-ref ($png-image png) 'bits)
+                      'Width ($img-width png)
+                      'Height ($img-height png)
                       'Filter 'FlateDecode)))
 
-        (unless (hash-ref @image 'hasAlphaChannel #f)
+        (unless (hash-ref ($png-image png) 'hasAlphaChannel #f)
           (define params (make-ref
                           (mhash 'Predictor 15
-                                 'Colors (hash-ref @image 'colors)
-                                 'BitsPerComponent (hash-ref @image 'bits)
-                                 'Columns @width)))
-          (dict-set! @obj 'DecodeParms params)
+                                 '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? @image 'palette)
+          [(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 @image 'palette))
+           (ref-write palette-ref (hash-ref ($png-image png) 'palette))
            (ref-end palette-ref)
            ;; build the color space array for the image
-           (dict-set! @obj 'Colorspace
-                      (list 'Indexed 'DeviceRGB (sub1 (/ (bytes-length (hash-ref @image 'palette)) 3)) palette-ref))]
-          [else (dict-set! @obj 'ColorSpace 'DeviceRGB)])
+           (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 @image 'transparency #f)
+          [(hash-ref ($png-image png) 'transparency #f)
            (cond
-             [(hash-ref (hash-ref @image 'transparency) 'grayscale #f)
+             [(hash-ref (hash-ref ($png-image png) 'transparency) 'grayscale #f)
               (error 'transparency-grayscale-not-implemented)]
-             [(hash-ref (hash-ref @image 'transparency) 'rgb #f)
+             [(hash-ref (hash-ref ($png-image png) 'transparency) 'rgb #f)
               (error 'transparency-rgb-not-implemented)]
-             [(hash-ref (hash-ref @image 'transparency) 'indexed #f)
+             [(hash-ref (hash-ref ($png-image png) 'transparency) 'indexed #f)
               (error 'transparency-indexed-not-implemented)])]
-          [(hash-ref @image 'hasAlphaChannel #f)
+          [(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! @img-data (deflate img-bytes))
-           (set! @alpha-channel (deflate alpha-bytes))]))
+           (set-$png-img-data! png (deflate img-bytes))
+           (set-$png-alpha-channel! png (deflate alpha-bytes))]))
 
-      (when @alpha-channel
+      (when ($png-alpha-channel png)
         (define sMask-ref
           (make-ref
            (mhash 'Type 'XObject
                   'Subtype 'Image
-                  'Height @height
-                  'Width @width
+                  'Height ($img-height png)
+                  'Width ($img-width png)
                   'BitsPerComponent 8
                   'Filter 'FlateDecode
                   'ColorSpace 'DeviceGray
                   'Decode '(0 1))))
-        (ref-write sMask-ref @alpha-channel)
+        (ref-write sMask-ref ($png-alpha-channel png))
         (ref-end sMask-ref)
-        (dict-set! @obj 'SMask sMask-ref))
+        (dict-set! ($img-obj png) 'SMask sMask-ref))
   
       ;; embed the actual image data
-      (ref-write @obj @img-data)
-      (ref-end @obj))
+      (ref-write ($img-obj png) ($png-img-data png))
+      (ref-end ($img-obj png)))
 
 
-    (define/public (split-alpha-channel)
-      (define ip @data)
+    (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 @width @height)))
-      (send bmap get-argb-pixels 0 0 @width @height pixels)
+      (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)))
@@ -109,11 +110,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee
               [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)))))
+        (values img-bytes alpha-bytes)))
 
 
 ;; test files
 ;; http://www.libpng.org/pub/png/png-sitemap.html#images
 (module+ test
-  (define pic (make-object PNG (open-input-file "../ptest/assets/death-alpha.png")))
-  (define-values (img alpha) (send pic split-alpha-channel)))
+  (define pic (make-png (open-input-file "../ptest/assets/death-alpha.png")))
+  (define-values (img alpha) (split-alpha-channel pic)))