From bbafbba8cbd1e7cf622d9582f4de0ba2454716b1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 24 Dec 2018 19:13:49 -0800 Subject: [PATCH] methodize png --- pitfall/pitfall/jpeg.rkt | 4 + pitfall/pitfall/png.rkt | 188 +++++++++++++++++++-------------------- 2 files changed, 96 insertions(+), 96 deletions(-) diff --git a/pitfall/pitfall/jpeg.rkt b/pitfall/pitfall/jpeg.rkt index 1acd899e..b4a5062d 100644 --- a/pitfall/pitfall/jpeg.rkt +++ b/pitfall/pitfall/jpeg.rkt @@ -6,6 +6,10 @@ racket/dict sugar/unstable/dict) +#| +https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee +|# + (provide JPEG) (define MARKERS '(#xffc0 #xffc1 #xffc2 #xffc3 diff --git a/pitfall/pitfall/png.rkt b/pitfall/pitfall/png.rkt index 26b36d18..6298e5db 100644 --- a/pitfall/pitfall/png.rkt +++ b/pitfall/pitfall/png.rkt @@ -1,120 +1,116 @@ #lang debug racket/base (require racket/class - "reference.rkt" - racket/contract + "reference.rkt" racket/dict racket/draw - sugar/unstable/class - sugar/unstable/js - sugar/unstable/dict - sugar/unstable/port) + sugar/unstable/dict) + +#| +https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee +|# (require "png-reader.rkt" "zlib.rkt") (provide PNG) -(define-subclass object% (PNG data [label #f]) - - (field [image (read-png data)] ; `image` is a hash - [pixelBitlength (· image pixelBitlength)] - [width (· image width)] - [height (· image height)] - [imgData (· image imgData)] - [alphaChannel #f] - [obj #f]) - - (as-methods - embed - split-alpha-channel)) - -(define/contract (embed this) - (->m void?) - +(define PNG + (class object% + (super-new) + (init-field [(@data data)] [label #f]) - (unless (· this obj) - (set-field! obj this - (make-ref - (mhash 'Type "XObject" - 'Subtype "Image" - 'BitsPerComponent (· this image bits) - 'Width (· this width) - 'Height (· this height) - 'Filter "FlateDecode"))) + (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]) - (unless (· this image hasAlphaChannel) - (define params (make-ref - (mhash 'Predictor 15 - 'Colors (· this image colors) - 'BitsPerComponent (· this image bits) - 'Columns (· this width)))) - (dict-set! (· this obj) 'DecodeParms params) - (send params end)) + (define/public (embed) + (unless @obj + (set! @obj + (make-ref + (mhash 'Type "XObject" + 'Subtype "Image" + 'BitsPerComponent (hash-ref @image 'bits) + 'Width @width + 'Height @height + 'Filter "FlateDecode"))) - (cond - [(hash-has-key? (· this image) 'palette) - ;; embed the color palette in the PDF as an object stream - (define palette-ref (· this document ref)) - (send* palette-ref [write (· this image palette)] [end]) + (unless (hash-ref @image '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) + (send params end)) - ;; build the color space array for the image - (dict-set! (· this object) 'Colorspace - (list "Indexed" "DeviceRGB" (sub1 (bytes-length (· this image palette))) palette-ref))] - [else (dict-set! (· this obj) 'ColorSpace "DeviceRGB")]) + (cond + [(hash-has-key? @image 'palette) + ;; embed the color palette in the PDF as an object stream + (define palette-ref (make-ref)) + (send* palette-ref [write (hash-ref @image 'palette)] [end]) + ;; 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")]) - (cond - [(hash-ref (· this image) 'transparency #f) - (cond - [(hash-ref (hash-ref (· this image) 'transparency) 'grayscale #f) - (error 'transparency-grayscale-not-implemented)] - [(hash-ref (hash-ref (· this image) 'transparency) 'rgb #f) - (error 'transparency-rgb-not-implemented)] - [(hash-ref (hash-ref (· this image) 'transparency) 'indexed #f) - (error 'transparency-indexed-not-implemented)])] - [(hash-ref (· this image) '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) (send this split-alpha-channel)) - (set-field! imgData this (deflate img-bytes)) - (set-field! alphaChannel this (deflate alpha-bytes))])) + (cond + [(hash-ref @image 'transparency #f) + (cond + [(hash-ref (hash-ref @image 'transparency) 'grayscale #f) + (error 'transparency-grayscale-not-implemented)] + [(hash-ref (hash-ref @image 'transparency) 'rgb #f) + (error 'transparency-rgb-not-implemented)] + [(hash-ref (hash-ref @image 'transparency) 'indexed #f) + (error 'transparency-indexed-not-implemented)])] + [(hash-ref @image '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))])) - (when (· this alphaChannel) - (define sMask - (make-ref - (mhash 'Type "XObject" - 'Subtype "Image" - 'Height (· this height) - 'Width (· this width) - 'BitsPerComponent 8 - 'Filter "FlateDecode" - 'ColorSpace "DeviceGray" - 'Decode '(0 1)))) - (send* sMask [write (· this alphaChannel)] [end]) - (dict-set! (· this obj) 'SMask sMask)) + (when @alpha-channel + (define sMask-ref + (make-ref + (mhash 'Type "XObject" + 'Subtype "Image" + 'Height @height + 'Width @width + 'BitsPerComponent 8 + 'Filter "FlateDecode" + 'ColorSpace "DeviceGray" + 'Decode '(0 1)))) + (send* sMask-ref [write @alpha-channel] [end]) + (dict-set! @obj 'SMask sMask-ref)) - ;; embed the actual image data - (send* (· this obj) [write (· this imgData)] [end])) + ;; embed the actual image data + (send* @obj [write @img-data] [end])) + + (define/public (split-alpha-channel) + (define ip @data) + (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) + (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 this) - (define ip (· this data)) - (port-position ip 0) - (define bmap (read-bitmap ip 'png/alpha)) - (define pixels (make-bytes (* 4 (· this width) (· this height)))) - (send bmap get-argb-pixels 0 0 (· this width) (· this height) 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 ;; 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) (split-alpha-channel pic))) \ No newline at end of file + (define-values (img alpha) (send pic split-alpha-channel))) \ No newline at end of file