From a72b101e11e2e7a48790240ac3b2bcada422c625 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 12 May 2017 12:28:27 -0700
Subject: [PATCH] resume in @transform function

---
 pitfall/pitfall/kit/document.rkt  | 222 +++++++++++++++---------------
 pitfall/pitfall/kit/helper.rkt    |  57 ++++++++
 pitfall/pitfall/kit/page-test.rkt |  26 ++--
 pitfall/pitfall/kit/page.rkt      |  64 ++++-----
 pitfall/pitfall/kit/reference.rkt |  52 +++----
 5 files changed, 242 insertions(+), 179 deletions(-)
 create mode 100644 pitfall/pitfall/kit/helper.rkt

diff --git a/pitfall/pitfall/kit/document.rkt b/pitfall/pitfall/kit/document.rkt
index 691190e9..a5cf424d 100644
--- a/pitfall/pitfall/kit/document.rkt
+++ b/pitfall/pitfall/kit/document.rkt
@@ -3,74 +3,77 @@
 (require sugar/debug)
 (provide PDFDocument)
 
-(require "reference.rkt" "struct.rkt" "object.rkt" "page.rkt")
+(require "reference.rkt" "struct.rkt" "object.rkt" "page.rkt" "helper.rkt")
 
 (define PDFDocument
   (class object% ; actually is an instance of readable.Stream, which is an input port
-    (init-field [options (hasheq)])
-    (let ([output-file (hash-ref options 'out "outrkt.pdf")])
+    (init-field [(@options options) (mhasheq)])
+    (let ([output-file (hash-ref @options 'out "outrkt.pdf")])
       (super-new))
 
     ; list of byte chunks to push onto
     ; simulates interface of stream.readable
-    (field [byte-strings empty]) 
+    (field [(@byte-strings byte-strings) empty]) 
     
     ;; PDF version
-    (field [version 1.3])
+    (field [(@version version) 1.3])
     
     ;; Whether streams should be compressed
-    (field [compress (hash-ref options 'compress #t)])
+    (field [(@compress compress) (hash-ref @options 'compress #t)])
     
-    (field [_pageBuffer null])
-    (field [_pageBufferStart 0])
+    (field [(@_pageBuffer _pageBuffer) null])
+    (field [(@_pageBufferStart _pageBufferStart) 0])
 
     ;; The PDF object store
-    (field [_offsets null])
-    (field [_waiting 0])
-    (field [_ended #f])
-    (field [_offset 0])
-
-    (field [_root (ref
-                   (hasheq 'Type "Catalog"
-                           'Pages (ref
-                                   (hasheq 'Type "Pages"
-                                           'Count 0
-                                           'Kids empty))))])
+    (field [(@_offsets _offsets) null])
+    (field [(@_waiting _waiting) 0])
+    (field [(@_ended _ended) #f])
+    (field [(@_offset _offset) 0])
+
+    (field [(@_root _root) (@ref
+                            (mhasheq 'Type "Catalog"
+                                     'Pages (@ref
+                                             (mhasheq 'Type "Pages"
+                                                      'Count 0
+                                                      'Kids empty))))])
 
     ;; The current page
-    (field [page #f])
+    (field [(@page page) #f])
+
+    ;; other fields, hoisted from below (why is this necessary?)
+    (field [(@x x) 0])
+    (field [(@y y) 0])
+    (field [(@_ctm _ctm) null])
 
     ;; todo
     ;; Initialize mixins
-    #;(initColor)
-    #;(initVector)
-    #;(initFonts)
-    #;(initText)
-    #;(initImages)
+    #;(@initColor)
+    #;(@initVector)
+    #;(@initFonts)
+    #;(@initText)
+    #;(@initImages)
 
     ;; Initialize the metadata
-    (field [info (hasheq
-                  'Producer "PitfallKit"
-                  'Creator "PitfallKit"
-                  'CreationDate (seconds->date (current-seconds)))])
-
-    (when (hash-ref options 'info #f)
-      (for ([(key val) (in-hash (hash-ref options 'info))])
-        (hash-set! info key val)))
+    (field [(@info info) (mhasheq
+                          'Producer "PitfallKit"
+                          'Creator "PitfallKit"
+                          'CreationDate (seconds->date (current-seconds)))])
 
-    (report info)
+    (when (hash-ref @options 'info #f)
+      (for ([(key val) (in-hash (hash-ref @options 'info))])
+           (hash-set! @info key val)))
 
     ;; Write the header
     ;; PDF version
-    (_write (format "%PDF-~a" version))
+    (@_write (format "%PDF-~a" @version))
 
     ;; 4 binary chars, as recommended by the spec
     (let ([c (integer->char #xFF)])
-      (_write (string-append "%" (string c c c c))))
+      (@_write (string-append "%" (string c c c c))))
 
     ;; Add the first page
-    (unless (not (hash-ref options 'autoFirstPage #t))
-      (addPage))
+    (unless (not (hash-ref @options 'autoFirstPage #t))
+      (@addPage))
 
     ;; todo
     ;;mixin = (methods) =>
@@ -86,123 +89,120 @@
     ;mixin require './mixins/images'
     ;mixin require './mixins/annotations'
 
-    (field [x 0])
-    (field [y 0])
-    (field [_ctm null])
-    (define/public (addPage [my-options options])
+    
+    (public [@addPage addPage])
+    (define (@addPage [options @options])
       ;; end the current page if needed
-      (unless (hash-ref options 'bufferPages #f)
-        (flushPages))
+      (unless (hash-ref @options 'bufferPages #f)
+        (@flushPages))
 
       ;; create a page object
-      (define page (make-object PDFPage this my-options))
-      (push! _pageBuffer page)
-      #|
+      (define @page (make-object PDFPage this options))
+      (push! @_pageBuffer @page)
       ;; add the page to the object store
-      (define pages (make-hasheq)) ; todo @_root.data.Pages.data
-      (hash-update! pages 'Kids (λ (val) (cons 42 val)) null) ; todo @page.dictionary
-      (hash-update! pages 'Count add1 0)
+      (define pages (· @_root data Pages data))
+      (hash-update! pages 'Kids (λ (val) (cons (· @page dictionary) val)) null)
+      (hash-update! pages 'Count add1)
 
       ;; reset x and y coordinates
-      (set! x 42) ;; todo @page.margins.left
-      (set! y 42) ;; todo @page.margins.top
-
+      (set! @x (· @page margins left))
+      (set! @y (· @page margins top))
       ;; flip PDF coordinate system so that the origin is in
       ;; the top left rather than the bottom left
-      (set! _ctm '(1 0 0 1 0 0))
-      ;; (transform 1 0 0 -1 0 @page.height) ;; todo
-
-      ;; @emit('pageAdded') ;; todo
+      (set! @_ctm '(1 0 0 1 0 0))
+      #;(@transform 1 0 0 -1 0 (· @page height))
 
+      #;(@emit "pageAdded")
       this
-|#
       )
-    
-    (define/public (flushPages)
+
+    (public [@flushPages flushPages])
+    (define (@flushPages)
       ;; this local variable exists so we're future-proof against
       ;; reentrant calls to flushPages.
-      (define pages _pageBuffer)
-      (set! _pageBuffer empty)
-      (set! _pageBufferStart (+ _pageBufferStart (length pages)))
-      (for ([page (in-list pages)])
-        (send page end)))
+      (define pages @_pageBuffer)
+      (set! @_pageBuffer empty)
+      (+= @_pageBufferStart (length pages))
+      (·map end pages))
 
     ;; every js function argument is 'undefined' by default
     ;; so even a function defined without default values
     ;; can be called without arguments
-    (define/public (ref [data (make-hasheq)])
-      (define ref (make-object PDFReference this (add1 (length _offsets)) data))
-      (push! _offsets #f) ; placeholder for this object's offset once it is finalized
-      (set! _waiting (add1 _waiting))
+    (public [@ref ref])
+    (define (@ref [data (make-hasheq)])
+      (define ref (make-object PDFReference this (add1 (length @_offsets)) data))
+      (push! @_offsets #f) ; placeholder for this object's offset once it is finalized
+      (++ @_waiting)
       ref)
 
-    (define/public (push chunk)
-      (push! byte-strings chunk))
-                                          
-    (define/public (_write data)
-      (let ([data (if (not (bytes? data))
-                      ; `string->bytes/latin-1` is equivalent to plain binary encoding
-                      (string->bytes/latin-1 (string-append data "\n"))
+    (public [@push push])
+    (define (@push chunk)
+      (push! @byte-strings chunk))
+
+    (public [@_write _write])
+    (define (@_write data)
+      (let ([data (if (not (isBuffer? data))
+                      (newBuffer (string-append data "\n"))
                       data)])
-        (push data)
-        (report byte-strings)
-        (set! _offset (+ _offset (bytes-length data)))))
+        (@push data)
+        (report @byte-strings)
+        (+= @_offset (buffer-length data))))
 
     (field [op #f])
     (define/public (pipe port)
       (set! op port))
 
-    (define _info #f)
+    (field [(@_info _info) #f])
     (define/public (end)
-      (flushPages)
-      (set! _info (ref))
-      (for ([(key val) (in-hash info)])
-        ;; upgrade string literal to String struct
-        (hash-set! (get-field data _info) key
-                   (if (string? val) (String val) val)))
-      (send _info end)
+      (@flushPages)
+      (set! @_info (@ref))
+      (for ([(key val) (in-hash @info)])
+           ;; upgrade string literal to String struct
+           (hash-set! (· @_info data) key (if (string? val) (String val) val)))
+      (· @_info end)
 
       ;; todo: fonts
       ;; for name, font of @_fontFamilies
       ;; font.finalize()
 
-      (send _root end)
-      (send (hash-ref (get-field data _root) 'Pages) end)
+      (· @_root end)
+      (· @_root data Pages end)
 
-      (if (or (zero? _waiting) 'debug)
-          (_finalize)
-          (set! _ended #t))
+      (if (or (zero? @_waiting) 'debug)
+          (@_finalize)
+          (set! @_ended #t))
 
       'done)
 
-    (define/public (_finalize [fn #f])
+    (public (@_finalize _finalize))
+    (define (@_finalize [fn #f])
       ;; generate xref
-      (define xRefOffset _offset)
-      (_write "xref")
-      (_write (format "0 ~a" (add1 (length _offsets))))
-      (_write "0000000000 65535 f ")
-      (for ([offset (in-list _offsets)])
-        (_write (string-append
-                 (~r (or offset (random 17)) #;debug #:min-width 10 #:pad-string "0")
-                 " 00000 n ")))
+      (define xRefOffset @_offset)
+      (@_write "xref")
+      (@_write (format "0 ~a" (add1 (length @_offsets))))
+      (@_write "0000000000 65535 f ")
+      (for ([offset (in-list @_offsets)])
+           (@_write (string-append
+                     (~r (or offset (random 17)) #;debug #:min-width 10 #:pad-string "0")
+                     " 00000 n ")))
       ;; trailer
-      (_write "trailer")
+      (@_write "trailer")
       ;; todo: make `PDFObject:convert` a static method
-      (_write (send (make-object PDFObject) convert
-                    (hasheq 'Size (add1 (length _offsets))
-                            'Root _root
-                            'Info _info)))
+      (@_write (send (make-object PDFObject) convert
+                     (mhasheq 'Size (add1 (length @_offsets))
+                              'Root @_root
+                              'Info @_info)))
 
-      (_write "startxref")
-      (_write (number->string xRefOffset))
-      (_write "%%EOF")
+      (@_write "startxref")
+      (@_write (number->string xRefOffset))
+      (@_write "%%EOF")
 
       ;; end the stream
-      ;; in node you (push null) which signals to the stream
+      ;; in node you (@push null) which signals to the stream
       ;; to copy to its output port
       ;; here we'll do it manually
       (copy-port (open-input-bytes
-                  (apply bytes-append (reverse byte-strings)))
+                  (apply bytes-append (reverse @byte-strings)))
                  op)
       (close-output-port op))))
 
diff --git a/pitfall/pitfall/kit/helper.rkt b/pitfall/pitfall/kit/helper.rkt
new file mode 100644
index 00000000..4587603f
--- /dev/null
+++ b/pitfall/pitfall/kit/helper.rkt
@@ -0,0 +1,57 @@
+#lang racket/base
+(require (for-syntax racket/base) racket/class sugar/list racket/list)
+(provide (all-defined-out))
+
+(define-syntax (· stx)
+  (syntax-case stx ()
+    [(_ x ref)
+     #'(cond
+         [(object? x) (with-handlers ([exn:fail:object? (λ (exn) (send x ref))])
+                        (get-field ref x))]
+         [(hash? x) (hash-ref x 'ref)]
+         [else (raise-argument-error '· "object or hash" x)])]
+    [(_ x ref0 . refs) #'(· (· x ref0) . refs)]))
+
+(define-syntax (·map stx)
+  (syntax-case stx ()
+    [(_ ref xs) #'(for/list ([x (in-list xs)]) (· x ref))]))
+
+(define-syntax-rule (+= id thing) (set! id (+ id thing))) 
+(define-syntax-rule (++ id) (+= id 1))
+(define-syntax-rule (-- id) (+= id -1))
+(define-syntax-rule (-= id thing) (+= id (- thing)))
+
+(module+ test
+  (require rackunit)
+  (define C
+    (class object%
+      (super-new)
+      (field [foo 'field])
+      (define/public (bar) 'method)
+      (define/public (zam) (hasheq 'zoom 'hash))))
+  (define h (hasheq 'bam (new C) 'foo 'hashlet))
+  (define o (new C))
+  (check-equal? (· o foo) 'field)
+  (check-equal? (· o bar) 'method)
+  (check-equal? (· o zam zoom) 'hash)
+  (check-equal? (· h bam foo) 'field)
+  (check-equal? (· h bam bar) 'method)
+  (check-equal? (· h bam zam zoom) 'hash)
+  (check-equal? (·map foo (list o h)) '(field hashlet)))
+
+
+(define (listify kvs)
+  (for/list ([slice (in-list (slice-at kvs 2))])
+            (cons (first slice) (second slice))))
+(define-syntax-rule (define-hashifier id hasher) (define (id . kvs) (hasher (listify kvs))))
+(define-hashifier mhash make-hash)
+(define-hashifier mhasheq make-hasheq)
+(define-hashifier mhasheqv make-hasheqv)
+
+(module+ test
+  (check-equal? (mhash 'k "v") (make-hash (list (cons 'k "v"))))) 
+
+
+(define isBuffer? bytes?)
+(define (newBuffer x) (string->bytes/latin-1 (format "~a" x)))
+(define buffer-length bytes-length)
\ No newline at end of file
diff --git a/pitfall/pitfall/kit/page-test.rkt b/pitfall/pitfall/kit/page-test.rkt
index e055abd1..cd03ec4a 100644
--- a/pitfall/pitfall/kit/page-test.rkt
+++ b/pitfall/pitfall/kit/page-test.rkt
@@ -1,13 +1,15 @@
-#lang br
-
-(require rackunit "document.rkt" "page.rkt")
+#lang racket/base
+(require racket/class rackunit "document.rkt" "page.rkt" "reference.rkt" "helper.rkt")
 (define p (make-object PDFPage (make-object PDFDocument)))
-(get-field size p)
-(get-field layout p)
-(get-field margins p)
-(get-field height p)
-(get-field width p)
-(get-field resources p)
-(get-field data (get-field resources p))
-(send p fonts)
-(get-field data (get-field dictionary p))
\ No newline at end of file
+(check-equal? (· p size) "letter")
+(check-equal? (· p layout) "portrait")
+(check-equal? (· p margins) '#hasheq((right . 72) (bottom . 72) (left . 72) (top . 72)))
+(check-equal? (· p height) 792.0)
+(check-equal? (· p width) 612.0)
+(check-equal? (· p resources data ProcSet) '("PDF" "Text" "ImageB" "ImageC" "ImageI"))
+
+(check-equal? (· p dictionary data Type) "Page")
+(check-equal? (· p dictionary data MediaBox)  '(0 0 612.0 792.0))
+(check-true (is-a? (· p dictionary data Contents) PDFReference))
+(check-true (is-a? (· p dictionary data Resources) PDFReference))
+(check-true (is-a? (· p dictionary data Parent) PDFReference))
\ No newline at end of file
diff --git a/pitfall/pitfall/kit/page.rkt b/pitfall/pitfall/kit/page.rkt
index 05e8c253..e5cf87f5 100644
--- a/pitfall/pitfall/kit/page.rkt
+++ b/pitfall/pitfall/kit/page.rkt
@@ -1,65 +1,65 @@
 #lang racket/base
-(require racket/class)
+(require racket/class "helper.rkt")
 (provide PDFPage)
 
 
 (define PDFPage
   (class object%
     (super-new)
-    (init-field document
-                [options (make-hasheq)])
-    (field [size (hash-ref options 'size "letter")])
-    (field [layout (hash-ref options 'layout "portrait")])
+    (init-field [(@document document)] [(@options options) (mhash)])
+    (field [(@size size) (hash-ref @options 'size "letter")])
+    (field [(@layout layout) (hash-ref @options 'layout "portrait")])
 
     ;; process margins
-    (field [margins
-            (let ([margin-value (hash-ref options 'margin #f)])
+    (field [(@margins margins)
+            (let ([margin-value (hash-ref @options 'margin #f)])
               (if (number? margin-value)
-                  (hasheq 'top margin-value
-                          'left margin-value
-                          'bottom margin-value
-                          'right margin-value)
+                  (mhash 'top margin-value
+                         'left margin-value
+                         'bottom margin-value
+                         'right margin-value)
                   ;; default to 1 inch margins
-                  (hash-ref options 'margins DEFAULT_MARGINS)))])
+                  (hash-ref @options 'margins DEFAULT_MARGINS)))])
 
     ;; calculate page dimensions
-    (define dimensions (if (list? size)
-                           size
-                           (hash-ref SIZES (string-upcase size))))
-    (field [width (list-ref dimensions (if (equal? layout "portrait") 0 1))])
-    (field [height (list-ref dimensions (if (equal? layout "portrait") 1 0))])
+    (define dimensions (if (list? @size)
+                           @size
+                           (hash-ref SIZES (string-upcase @size))))
+    (field [(@width width) (list-ref dimensions (if (equal? @layout "portrait") 0 1))])
+    (field [(@height height) (list-ref dimensions (if (equal? @layout "portrait") 1 0))])
 
-    (field [content (send document ref)])
+    (field [(@content content) (· @document ref)])
 
     ;; Initialize the Font, XObject, and ExtGState dictionaries
-    (field [resources (send document ref (make-hash (list (cons 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))))])
+    (field [(@resources resources) (send @document ref (mhash 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))])
 
     ;; Lazily create these dictionaries
     (define/public (fonts)
-      (hash-ref! (get-field data resources) 'Font (make-hash)))
+      (hash-ref! (· @resources data) 'Font (make-hash)))
 
     (define/public (xobjects)
-      (hash-ref! (get-field data resources) 'XObject (make-hash)))
+      (hash-ref! (· @resources data) 'XObject (make-hash)))
 
     (define/public (ext_gstates)
-      (hash-ref! (get-field data resources) 'ExtGState (make-hash)))
+      (hash-ref! (· @resources data) 'ExtGState (make-hash)))
 
     (define/public (patterns)
-      (hash-ref! (get-field data resources) 'Pattern (make-hash)))
+      (hash-ref! (· @resources data) 'Pattern (make-hash)))
 
     (define/public (annotations)
-      (hash-ref! (get-field data resources) 'Annots null))
+      (hash-ref! (· @resources data) 'Annots null))
           
     ;; The page dictionary
-    (field [dictionary
-            (send document ref
-                             (make-hash (list
-                                         (cons 'Type "Page")
-                                         (cons 'Parent (hash-ref (get-field data (get-field _root document)) 'Pages))
-                                         (cons 'MediaBox (list 0 0 width height))
-                                         (cons 'Contents content)
-                                         (cons 'Resources resources))))])
+    (field [(@dictionary dictionary)
+            (send @document ref
+                  (mhash 'Type "Page"
+                         'Parent (· @document _root data Pages)
+                         'MediaBox (list 0 0 @width @height)
+                         'Contents @content
+                         'Resources @resources))])
 
+    (define/public (end)
+      'nothing) ;; temp
     
     
     ))
diff --git a/pitfall/pitfall/kit/reference.rkt b/pitfall/pitfall/kit/reference.rkt
index 258459de..3e99487e 100644
--- a/pitfall/pitfall/kit/reference.rkt
+++ b/pitfall/pitfall/kit/reference.rkt
@@ -1,46 +1,50 @@
 #lang br
-
+(require "helper.rkt")
 (provide PDFReference)
 
 (define PDFReference
   (class object%
-    (init-field document id [data (make-hasheq)])
+    (init-field [(@document document)] [(@id id)] [(@data data) (mhasheq)])
     (super-new)
-    (field [gen 0])
-    (field [deflate #f])
-    (field [compress (and (with-handlers ([exn:fail:contract? (λ (exn) #f)])
-                            (get-field compress document)) (not (hash-ref data 'Filter #f)))])
-    (field [uncompressedLength 0])
-    (field [chunks empty])
-
-    (define/public (initDeflate)
+    (field [(@gen gen) 0])
+    (field [(@deflate deflate) #f])
+    (field [(@compress compress) (and (with-handlers ([exn:fail:contract? (λ (exn) #f)])
+                                        (get-field compress @document)) (not (hash-ref @data 'Filter #f)))])
+    (field [(@uncompressedLength uncompressedLength) 0])
+    (field [(@chunks chunks) empty])
+
+    (public [@initDeflate initDeflate])
+    (define (@initDeflate)
       ;; todo
       (void))
 
-    (define/public (_write chunk encoding callback)
-      ;; assume chunk is a string
-      (set! uncompressedLength (+ uncompressedLength (string-length chunk)))
-      (hash-ref! data 'Length 0)
+    (define/public (_write chunk-in encoding callback)
+      (define chunk (if (isBuffer? chunk-in)
+                        chunk-in
+                        (newBuffer (string-append chunk "\n"))))
+      (+= @uncompressedLength (buffer-length chunk))
+      (hash-ref! @data 'Length 0)
       (cond
-        [compress (when (not deflate) (initDeflate))
-                  (deflate chunk)]
-        [else (push! chunks chunk)
-              (hash-update! data 'Length (λ (len) (+ len (string-length chunk))))])
+        [@compress (when (not @deflate) (@initDeflate))
+                   (send @deflate write chunk)]
+        [else (push! @chunks chunk)
+              (hash-update! @data 'Length (λ (len) (+ len (buffer-length chunk))))])
       (callback))
 
     (define/public (end [chunk #f])
       ; (super) ; todo
-      (if deflate
+      (if @deflate
           (void) ; todo (deflate-end)
-          (finalize)))
+          (@finalize)))
 
     (field [offset #f])
-    (define/public (finalize)
-      (set! offset (get-field _offset document))
-      (send document _write (format "~a ~a obj" id gen))
+    (public [@finalize finalize])
+    (define (@finalize)
+      (set! offset (· @document _offset))
+      (send @document _write (format "~a ~a obj" @id @gen))
       )
 
     (define/public (toString)
-      (format "~a ~a R" id gen)) 
+      (format "~a ~a R" @id @gen)) 
 
     ))