From 9b595201643b338cb161634ce7780f7987115369 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 21 Dec 2018 13:46:43 -0800 Subject: [PATCH] put "payload" under interface --- pitfall/pitfall/document.rkt | 12 ++++++------ pitfall/pitfall/embedded.rkt | 18 +++++++++--------- pitfall/pitfall/jpeg-structy.rkt | 2 +- pitfall/pitfall/jpeg.rkt | 2 +- pitfall/pitfall/png.rkt | 8 ++++---- pitfall/pitfall/reference.rkt | 16 +++++++++++----- 6 files changed, 32 insertions(+), 26 deletions(-) diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index 84cd6564..e1ee97a2 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -56,7 +56,7 @@ (define/public (page) (first @pages)) ;; for use by page.rkt rather than invading our fields - (define/public (page-parent) (hash-ref (get-field payload @root) 'Pages)) + (define/public (page-parent) (send @root get-key 'Pages)) (define/public (ref [payload (mhasheq)]) (define refid (@ref-gen)) @@ -79,9 +79,9 @@ ;; in Kids, store page dictionaries in correct order ;; this determines order in document - (define pages (get-field payload (hash-ref (get-field payload @root) 'Pages))) - (hash-update! pages 'Kids (λ (val) (append val (list (get-field dictionary (page)))))) - (hash-set! pages 'Count (length (hash-ref pages 'Kids))) + (define pages (send @root get-key 'Pages)) + (send pages update-key! 'Kids (λ (val) (append val (list (get-field dictionary (page)))))) + (send pages set-key! 'Count (length (send pages get-key 'Kids))) ;; reset x and y coordinates (set! @x (hash-ref (get-field margins (page)) 'left)) @@ -107,13 +107,13 @@ (define doc-info (ref)) (for ([(key val) (in-hash @info)]) ;; upgrade string literal to String struct - (hash-set! (get-field payload doc-info) key (if (string? val) (String val) val))) + (send doc-info set-key! key (if (string? val) (String val) val))) (send doc-info end) (for ([font (in-hash-values @font-families)]) (send font finalize)) (send @root end) - (send (hash-ref (get-field payload @root) 'Pages) end) + (send (send @root get-key 'Pages) end) (define xref-offset (current-doc-offset)) (match-define (list this-idxs this-offsets) diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index e7afeedd..71da9daf 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/pitfall/pitfall/embedded.rkt @@ -90,7 +90,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (define fontFile (· this document ref)) (when isCFF - (hash-set! (· fontFile payload) 'Subtype "CIDFontType0C")) + (send fontFile set-key! 'Subtype "CIDFontType0C")) (send* fontFile [write (get-output-bytes (encode-to-port (· this subset)))] [end]) @@ -131,7 +131,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee 'XHeight (* (or (font-x-height (· this font)) 0) (· this scale)) 'StemV 0))) - (hash-set! (· descriptor payload) (if isCFF + (send descriptor set-key! (if isCFF 'FontFile3 'FontFile2) fontFile) @@ -152,13 +152,13 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (hash-ref (· this widths) idx (λ () (error 'embed (format "hash key ~a not found" idx))))))))) (· descendantFont end) - (hash-set*! (· this dictionary payload) - 'Type "Font" - 'Subtype "Type0" - 'BaseFont name - 'Encoding "Identity-H" - 'DescendantFonts (list descendantFont) - 'ToUnicode (· this toUnicodeCmap)) + (send* (· this dictionary) + [set-key! 'Type "Font"] + [set-key! 'Subtype "Type0"] + [set-key! 'BaseFont name] + [set-key! 'Encoding "Identity-H"] + [set-key! 'DescendantFonts (list descendantFont)] + [set-key! 'ToUnicode (· this toUnicodeCmap)]) (· this dictionary end)) diff --git a/pitfall/pitfall/jpeg-structy.rkt b/pitfall/pitfall/jpeg-structy.rkt index 399b1cbb..1888c82b 100644 --- a/pitfall/pitfall/jpeg-structy.rkt +++ b/pitfall/pitfall/jpeg-structy.rkt @@ -61,7 +61,7 @@ ;; min and max values from the default, we invert the colors. See ;; section 4.8.4 of the spec. (when (equal? (· this colorSpace) "DeviceCMYK") - (hash-set! (· this obj payload) 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0))) + (send obj set-key! '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)))) diff --git a/pitfall/pitfall/jpeg.rkt b/pitfall/pitfall/jpeg.rkt index 4e19e36d..a7068807 100644 --- a/pitfall/pitfall/jpeg.rkt +++ b/pitfall/pitfall/jpeg.rkt @@ -68,7 +68,7 @@ ;; min and max values from the default, we invert the colors. See ;; section 4.8.4 of the spec. (when (equal? (· this colorSpace) "DeviceCMYK") - (hash-set! (· this obj payload) 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0))) + (send (· this obj) set-key! '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) [write (· this data)] diff --git a/pitfall/pitfall/png.rkt b/pitfall/pitfall/png.rkt index 5cc1f8e2..eb36f2a6 100644 --- a/pitfall/pitfall/png.rkt +++ b/pitfall/pitfall/png.rkt @@ -47,7 +47,7 @@ 'Colors (· this image colors) 'BitsPerComponent (· this image bits) 'Columns (· this width)))) - (hash-set! (· this obj payload) 'DecodeParms params) + (send (· this obj) set-key! 'DecodeParms params) (send params end)) (cond @@ -57,9 +57,9 @@ (send* palette-ref [write (· this image palette)] [end]) ;; build the color space array for the image - (hash-set! (· this object payload) 'Colorspace + (send (· this object) set-key! 'Colorspace (list "Indexed" "DeviceRGB" (sub1 (bytes-length (· this image palette))) palette-ref))] - [else (hash-set! (· this obj payload) 'ColorSpace "DeviceRGB")]) + [else (send (· this obj) set-key! 'ColorSpace "DeviceRGB")]) (cond @@ -91,7 +91,7 @@ 'ColorSpace "DeviceGray" 'Decode '(0 1)))) (send* sMask [write (· this alphaChannel)] [end]) - (hash-set! (· this obj payload) 'SMask sMask)) + (send (· this obj) set-key! 'SMask sMask)) ;; embed the actual image data (send* (· this obj) [write (· this imgData)] [end])) diff --git a/pitfall/pitfall/reference.rkt b/pitfall/pitfall/reference.rkt index 0ea64d44..b92de898 100644 --- a/pitfall/pitfall/reference.rkt +++ b/pitfall/pitfall/reference.rkt @@ -16,17 +16,23 @@ (field [(@offset offset) #f] [@portal (open-output-bytes)]) - (define/public (write x) + (define/public (write x [op @portal]) (define bstr (match x [(? bytes?) x] [(? input-port?) (port->bytes x)] [_ (string->bytes/latin-1 (format "~a\n" x))])) - (write-bytes bstr @portal)) + (write-bytes bstr op)) - (define/public (end [chunk #f]) - (when chunk - (write chunk)) + (define/public (get-key key) + (hash-ref @payload key)) + (define/public (set-key! key val) + (hash-set! @payload key val)) + + (define/public (update-key! key updater) + (hash-update! @payload key updater)) + + (define/public (end) (set! @offset (current-doc-offset)) (send @doc write (format "~a 0 obj" @id))