From c6b515d69e28bec00a47475278954eef020cb579 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 26 Dec 2018 08:35:01 -0800 Subject: [PATCH] nits --- pitfall/pitfall/core.rkt | 7 ++- pitfall/pitfall/image.rkt | 19 -------- pitfall/pitfall/images.rkt | 27 +++++++++--- pitfall/pitfall/jpeg-structy.rkt | 74 -------------------------------- pitfall/pitfall/jpeg.rkt | 15 +++---- pitfall/pitfall/png.rkt | 16 +++---- 6 files changed, 37 insertions(+), 121 deletions(-) delete mode 100644 pitfall/pitfall/image.rkt delete mode 100644 pitfall/pitfall/jpeg-structy.rkt diff --git a/pitfall/pitfall/core.rkt b/pitfall/pitfall/core.rkt index 113d7107..03377684 100644 --- a/pitfall/pitfall/core.rkt +++ b/pitfall/pitfall/core.rkt @@ -4,8 +4,10 @@ ;; structs -(struct $img (data label width height obj embed-proc) #:transparent #:mutable) +;; for JPEG and PNG +(struct $img (data label width height ref embed-proc) #:transparent #:mutable) +;; for reference (struct $ref (id payload offset port) #:transparent #:mutable #:methods gen:dict [(define (dict-ref $ key [thunk (λ () (error 'dict-ref-key-not-found))]) @@ -16,9 +18,6 @@ (define (dict-update! $ key updater [failure-result (λ () (error 'update-no-key))]) (hash-update! ($ref-payload $) key updater failure-result))]) -;; for JPEG and PNG -(struct image (label width height obj) #:transparent #:mutable) - ;; for page (struct margin (top left bottom right) #:transparent #:mutable) diff --git a/pitfall/pitfall/image.rkt b/pitfall/pitfall/image.rkt deleted file mode 100644 index 193f6aee..00000000 --- a/pitfall/pitfall/image.rkt +++ /dev/null @@ -1,19 +0,0 @@ -#lang racket/base -(require - racket/class - "jpeg.rkt" - "png.rkt") -(provide PDFImage-open) - -(define (PDFImage-open src label) - (define data (cond - [(bytes? src) (open-input-bytes src)] - [(regexp-match #rx"^data:.+;base64,(.*)$" src) (void)] ;; base64 ; todo - [else (open-input-file src)])) - (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)) - diff --git a/pitfall/pitfall/images.rkt b/pitfall/pitfall/images.rkt index 410b6e71..63e27069 100644 --- a/pitfall/pitfall/images.rkt +++ b/pitfall/pitfall/images.rkt @@ -3,11 +3,24 @@ racket/class racket/match sugar/unstable/dict - "image.rkt" "core.rkt" - "page.rkt") + "page.rkt" + "png.rkt" + "jpeg.rkt") (provide image-mixin) +(define (open-pdf-image src label) + (define data (cond + [(bytes? src) (open-input-bytes src)] + [(regexp-match #rx"^data:.+;base64,(.*)$" src) (void)] ;; base64 ; todo + [else (open-input-file src)])) + (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 'open-pdf-image "valid image format" src)])) + (img-constructor data label)) + (define (image-mixin [% object%]) (class % (super-new) @@ -22,12 +35,11 @@ (define image (cond [(and (string? src) (hash-ref @image-registry src #f))] - [(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 ($img-obj image) (($img-embed-proc image) image)) + (unless ($img-ref image) (($img-embed-proc image) image)) - (hash-ref! (page-xobjects (page)) ($img-label image) ($img-obj image)) + (hash-ref! (page-xobjects (page)) ($img-label image) ($img-ref image)) (define image-width ($img-width image)) (define image-height ($img-height image)) @@ -100,8 +112,9 @@ (cond [(and (string? src) (hash-ref @image-registry src #f))] [else - (define new-image - (PDFImage-open src (string->symbol (format "I~a" (let () (set! @image-count (add1 @image-count)) @image-count))))) + (set! @image-count (add1 @image-count)) + (define image-id (string->symbol (format "I~a" @image-count))) + (define new-image (open-pdf-image src image-id)) (when (string? src) (hash-set! @image-registry src new-image)) new-image])))) diff --git a/pitfall/pitfall/jpeg-structy.rkt b/pitfall/pitfall/jpeg-structy.rkt deleted file mode 100644 index 94fd5747..00000000 --- a/pitfall/pitfall/jpeg-structy.rkt +++ /dev/null @@ -1,74 +0,0 @@ -#lang debug racket/base -(require - "core.rkt" - "reference.rkt" - racket/class - racket/contract - racket/dict - sugar/unstable/class - sugar/unstable/js - sugar/unstable/dict - sugar/unstable/port) - -(provide +JPEG (struct-out JPEG)) - -(define MARKERS '(#xffc0 #xffc1 #xffc2 #xffc3 #xffc5 #xffc6 #xffc7 - #xffc8 #xffc9 #xffca #xffcb #xffcc #xffcd #xffce #xffcf)) - -(define (read-16bit-integer [port (current-input-port)]) - (define signed #f) (define big-endian #t) - (integer-bytes->integer - (read-bytes 2 port) signed big-endian)) - -(struct JPEG image (data bits channels colorSpace) #:transparent #:mutable) - -(define (+JPEG data [label #f]) - (parameterize ([current-input-port (if (input-port? data) data (open-input-bytes data))]) - (unless (equal? (read-16bit-integer) #xffd8) - (error 'JPEG "Start of Input marker byte not found")) - (define marker (let loop ([skip 0]) - (read-bytes skip) - (define m (read-16bit-integer)) - (if (memv m MARKERS) - m - (loop (read-16bit-integer (open-input-bytes (peek-bytes 2 0))))))) - (read-16bit-integer) ; what is it and why am I ignoring it? - (define bits (read-byte)) - (define height (read-16bit-integer)) - (define width (read-16bit-integer)) - (define channels (read-byte)) - (define colorSpace (case channels - [(1) "DeviceGray"] - [(3) "DeviceRGB"] - [(4) "DeviceCMYK"])) - (define obj #f) - (JPEG label width height obj data bits channels colorSpace))) - -(define (embed this) - #;(object? . ->m . void?) - - (unless (· this obj) - (set-field! obj this - (make-ref - (mhash - 'Type "XObject" - 'Subtype "Image" - 'BitsPerComponent (· this bits) - 'Width (· this width) - 'Height (· this height) - 'ColorSpace (· this colorSpace) - '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 (equal? (· this colorSpace) "DeviceCMYK") - (dict-set! (· this obj) 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0))) - - (port-position (· this data) 0) - (send (· this obj) end (· this data)))) - -(module+ test - (require rackunit) - (check-equal? (number->string (read-16bit-integer (open-input-bytes (bytes #x12 #x34 #x56))) 16) "1234") - (+JPEG (open-input-file "../ptest/assets/test.jpeg"))) \ No newline at end of file diff --git a/pitfall/pitfall/jpeg.rkt b/pitfall/pitfall/jpeg.rkt index 4056f49d..17a139c8 100644 --- a/pitfall/pitfall/jpeg.rkt +++ b/pitfall/pitfall/jpeg.rkt @@ -1,6 +1,5 @@ #lang debug racket/base (require - racket/class racket/match "reference.rkt" "core.rkt" @@ -18,8 +17,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee #xffc8 #xffc9 #xffca #xffcb #xffcc #xffcd #xffce #xffcf)) -(struct $jpeg $img (bits channels colorSpace) - #:transparent #:mutable) +(struct $jpeg $img (bits channels colorSpace) #:transparent #:mutable) (define (make-jpeg data [label #f]) @@ -44,10 +42,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee (define obj #f) ($jpeg data label width height obj jpeg-embed bits channels colorSpace)) - (define (jpeg-embed jpeg) - (unless ($img-obj jpeg) - (set-$img-obj! jpeg + (unless ($img-ref jpeg) + (set-$img-ref! jpeg (make-ref (mhash 'Type 'XObject @@ -62,10 +59,10 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee ;; 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))) + (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-obj jpeg) ($img-data jpeg)) - (ref-end ($img-obj jpeg)))) + (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) diff --git a/pitfall/pitfall/png.rkt b/pitfall/pitfall/png.rkt index ad1ca0eb..4b8e3bb2 100644 --- a/pitfall/pitfall/png.rkt +++ b/pitfall/pitfall/png.rkt @@ -28,8 +28,8 @@ 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 + (unless ($img-ref png) + (set-$img-ref! png (make-ref (mhash 'Type 'XObject 'Subtype 'Image @@ -44,7 +44,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee '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) + (dict-set! ($img-ref png) 'DecodeParms params) (ref-end params)) (cond @@ -54,9 +54,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee (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 + (dict-set! ($img-ref 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)]) + [else (dict-set! ($img-ref png) 'ColorSpace 'DeviceRGB)]) (cond @@ -89,11 +89,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee 'Decode '(0 1)))) (ref-write sMask-ref ($png-alpha-channel png)) (ref-end sMask-ref) - (dict-set! ($img-obj png) 'SMask sMask-ref)) + (dict-set! ($img-ref png) 'SMask sMask-ref)) ;; embed the actual image data - (ref-write ($img-obj png) ($png-img-data png)) - (ref-end ($img-obj png))) + (ref-write ($img-ref png) ($png-img-data png)) + (ref-end ($img-ref png))) (define (split-alpha-channel png)