From 7287495bca008d4d90dc840c4fb8a615c78d4634 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 26 Dec 2018 11:34:02 -0800
Subject: [PATCH] step0

---
 pitfall/pitfall/core.rkt     |  24 +++
 pitfall/pitfall/document.rkt | 312 ++++++++++++++++++++++++-----------
 pitfall/pitfall/page.rkt     |  82 ++++-----
 pitfall/pitfall/pdftest.rkt  |   6 +-
 pitfall/pitfall/vector.rkt   |  27 +--
 5 files changed, 303 insertions(+), 148 deletions(-)

diff --git a/pitfall/pitfall/core.rkt b/pitfall/pitfall/core.rkt
index 03377684..4feaca61 100644
--- a/pitfall/pitfall/core.rkt
+++ b/pitfall/pitfall/core.rkt
@@ -4,6 +4,30 @@
 
 ;; structs
 
+(struct $doc (options
+              pages
+              refs
+              root
+              info
+              opacity-registry
+              opacity-count
+              grad-count
+              current-fill-color
+              ctm
+              ctm-stack
+              font-families
+              font-count
+              current-font-size
+              current-font
+              registered-fonts
+              line-gap
+              text-options
+              x
+              y
+              image-registry
+              image-count) #:transparent #:mutable)
+
+
 ;; for JPEG and PNG
 (struct $img (data label width height ref embed-proc) #:transparent #:mutable)
 
diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt
index 8d424cab..0b2ccfcd 100644
--- a/pitfall/pitfall/document.rkt
+++ b/pitfall/pitfall/document.rkt
@@ -15,103 +15,229 @@
   "text.rkt"
   "images.rkt"
   "annotations.rkt")
-(provide PDFDocument)
-
-(define PDFDocument
-  (class (annotation-mixin
-          (image-mixin
-           (text-mixin
-            (fonts-mixin
-             (vector-mixin
-              (color-mixin (class object%
-                             (super-new)
-                             (field [@pages null])
-                             (define/public (page) (first @pages))                  
-                             (define/public (add-content data)
-                               (page-write (first @pages) data)))))))))
-    (set-current-ref-id! 1)
-    (register-ref-listener (λ (ref) (store-ref ref)))
-
-    (super-new)
-    (init-field [(@options options) (mhasheq)])
-    (field [@refs null]
-           [@root (make-ref (mhasheq 'Type 'Catalog
-                                     'Pages (make-ref (mhasheq 'Type 'Pages))))]
-           ;; initialize the metadata
-           [@info (mhasheq 'Producer "PITFALL"
-                           'Creator "PITFALL"
-                           'CreationDate (current-seconds))])
-
-    ;; initialize mixins
-    (inherit-field @ctm) ; from vector mixin
-    (inherit-field @font-families) (inherit font) ; from font mixin
-    (inherit-field [@x x] [@y y]) ; from text
-    (inherit transform) ; from vector
-    (inherit-field @pages) (inherit page) ; from base
-
-    ;; initialize params
-    (current-compress-streams? (hash-ref @options 'compress #t))
-    (current-auto-first-page (hash-ref @options 'autoFirstPage #t))
-    (when (current-auto-first-page) (add-page))
-    (when (current-auto-helvetica) (font "Helvetica"))
-
-    ;; copy options
-    (for ([(key val) (in-hash (hash-ref @options 'info (hasheq)))]) 
-      (hash-set! @info key val))
-
-    (define/public (store-ref ref)
-      (set! @refs (cons ref @refs)))
-
-    (define/public (add-page [options-arg @options])
-      ;; create a page object
-      (define page-parent (dict-ref @root 'Pages))
-      (set! @pages (cons (make-page page-parent options-arg) @pages))
+(provide (all-defined-out))
+
+(define (store-ref doc ref)
+  (set-$doc-refs! doc (cons ref ($doc-refs doc))))
+
+(define (page doc) (first ($doc-pages doc)))
+
+(define (add-content doc data)
+  (page-write (page doc) data))
+
+(define (transform doc scaleX shearY shearX scaleY mdx mdy)
+  (define new-ctm (list scaleX shearY shearX scaleY mdx mdy))
+  (set-$doc-ctm! doc (combine-transforms ($doc-ctm doc) new-ctm))
+  (add-content doc (make-transform-string new-ctm)))
+
+(define (make-$doc [options (make-hasheq)])
+
+  ;; initial values
+  (define pages null)
+  (define refs null)
+  (define info (mhasheq 'Producer "PITFALL"
+                        'Creator "PITFALL"
+                        'CreationDate (current-seconds)))
+  (for ([(key val) (in-hash (hash-ref options 'info (hasheq)))]) 
+    (hash-set! info key val))
+  (define opacity-registry (make-hash))
+  (define opacity-count 0)
+  (define grad-count 0)
+  (define current-fill-color #false)
+  (define ctm default-ctm-value)
+  (define ctm-stack null)
+  (define font-families (make-hash))
+  (define font-count 0)
+  (define current-font-size 12)
+  (define current-font #false)
+  (define registered-fonts (make-hash))
+  (define line-gap 0)
+  (define text-options #false)
+  (define x 0)
+  (define y 0)
+  (define image-registry (make-hash))
+  (define image-count 0)
+  (define new-doc ($doc options
+                        pages
+                        refs
+                        'dummy-root-value-that-will-be-replaced-below
+                        info
+                        opacity-registry
+                        opacity-count
+                        grad-count
+                        current-fill-color
+                        ctm
+                        ctm-stack
+                        font-families
+                        font-count
+                        current-font-size
+                        current-font
+                        registered-fonts
+                        line-gap
+                        text-options
+                        x
+                        y
+                        image-registry
+                        image-count))
+  (set-current-ref-id! 1)
+  (register-ref-listener (λ (ref) (store-ref new-doc ref)))
+  (set-$doc-root! new-doc (make-ref (mhasheq 'Type 'Catalog
+                                             'Pages (make-ref (mhasheq 'Type 'Pages)))))
+
+  ;; initialize params
+  (current-compress-streams? (hash-ref options 'compress #t))
+  (current-auto-first-page (hash-ref options 'autoFirstPage #t))
+  (when (current-auto-first-page) (add-page new-doc))
+  #;(when (current-auto-helvetica) (font "Helvetica"))
+  
+  new-doc)
+
+(define (add-page doc [options-arg ($doc-options doc)])
+  ;; create a page object
+  (define page-parent (dict-ref ($doc-root doc) 'Pages))
+  (set-$doc-pages! doc (cons (make-page page-parent options-arg) ($doc-pages doc)))
+      
+  ;; reset x and y coordinates
+  (set-$doc-x! doc (margin-left ($page-margins (page doc))))
+  (set-$doc-y! doc (margin-right ($page-margins (page doc))))
+  ;; flip PDF coordinate system so that the origin is in
+  ;; the top left rather than the bottom left
+  (set-$doc-ctm! doc default-ctm-value)
+  (transform doc 1 0 0 -1 0 ($page-height (page doc)))
+  doc)
+
+(define (start-doc doc)
+  (write-bytes-out (format "%PDF-~a" (current-pdf-version)))
+  (write-bytes-out "%ÿÿÿÿ"))
+
+(define (end-doc doc)
+  (for-each page-end ($doc-pages doc))
+
+  (define doc-info (make-ref))
+  (for ([(key val) (in-hash ($doc-info doc))])
+    (dict-set! doc-info key val))
+  (ref-end doc-info)
+    
+  (for ([font (in-hash-values ($doc-font-families doc))])
+    (send font end))
+
+  (define pages-ref (dict-ref ($doc-root doc) 'Pages))
+  (dict-set! pages-ref 'Count (length ($doc-pages doc)))
+  (dict-set! pages-ref 'Kids (map $page-dictionary (reverse ($doc-pages doc))))
+  (ref-end pages-ref)
+      
+  (ref-end ($doc-root doc))
       
-      ;; reset x and y coordinates
-      (set! @x (margin-left ($page-margins (page))))
-      (set! @y (margin-right ($page-margins (page))))
-      ;; flip PDF coordinate system so that the origin is in
-      ;; the top left rather than the bottom left
-      (set! @ctm default-ctm-value)
-      (transform 1 0 0 -1 0 ($page-height (page)))
-      this)
-
-    (define/public (start-doc)
-      (write-bytes-out (format "%PDF-~a" (current-pdf-version)))
-      (write-bytes-out "%ÿÿÿÿ"))
-
-    (define/public (end-doc)
-      (for-each page-end @pages)
-
-      (define doc-info (make-ref))
-      (for ([(key val) (in-hash @info)])
-        (dict-set! doc-info key val))
-      (ref-end doc-info)
+  (define xref-offset (file-position (current-output-port)))
+  (write-bytes-out "xref")
+  (write-bytes-out (format "0 ~a" (add1 (length ($doc-refs doc)))))
+  (write-bytes-out "0000000000 65535 f ")
+  (for ([ref (in-list (reverse ($doc-refs doc)))])
+    (write-bytes-out
+     (string-append (~r ($ref-offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
+  (write-bytes-out "trailer")
+  (write-bytes-out (convert (mhasheq 'Size (add1 (length ($doc-refs doc)))
+                                     'Root ($doc-root doc)
+                                     'Info doc-info)))
+  (write-bytes-out "startxref")
+  (write-bytes-out (numberizer xref-offset))
+  (write-bytes-out "%%EOF"))
+
+#;(define PDFDocument
+    (class (annotation-mixin
+            (image-mixin
+             (text-mixin
+              (fonts-mixin
+               (vector-mixin
+                (color-mixin (class object%
+                               (super-new)
+                               (field [@pages null])
+                               (define/public (page) (first @pages))                  
+                               (define/public (add-content data)
+                                 (page-write (first @pages) data)))))))))
+      (set-current-ref-id! 1)
+      (register-ref-listener (λ (ref) (store-ref ref)))
+
+      (super-new)
+      (init-field [(@options options) (mhasheq)])
+      (field [@refs null]
+             [@root (make-ref (mhasheq 'Type 'Catalog
+                                       'Pages (make-ref (mhasheq 'Type 'Pages))))]
+             ;; initialize the metadata
+             [@info (mhasheq 'Producer "PITFALL"
+                             'Creator "PITFALL"
+                             'CreationDate (current-seconds))])
+
+      ;; initialize mixins
+      (inherit-field @ctm) ; from vector mixin
+      (inherit-field @font-families) (inherit font) ; from font mixin
+      (inherit-field [@x x] [@y y]) ; from text
+      (inherit transform) ; from vector
+      (inherit-field @pages) (inherit page) ; from base
+
+      ;; initialize params
+      (current-compress-streams? (hash-ref @options 'compress #t))
+      (current-auto-first-page (hash-ref @options 'autoFirstPage #t))
+      (when (current-auto-first-page) (add-page))
+      (when (current-auto-helvetica) (font "Helvetica"))
+
+      ;; copy options
+      (for ([(key val) (in-hash (hash-ref @options 'info (hasheq)))]) 
+        (hash-set! @info key val))
+
+      (define/public (store-ref ref)
+        (set! @refs (cons ref @refs)))
+
+      (define/public (add-page [options-arg @options])
+        ;; create a page object
+        (define page-parent (dict-ref @root 'Pages))
+        (set! @pages (cons (make-page page-parent options-arg) @pages))
+      
+        ;; reset x and y coordinates
+        (set! @x (margin-left ($page-margins (page))))
+        (set! @y (margin-right ($page-margins (page))))
+        ;; flip PDF coordinate system so that the origin is in
+        ;; the top left rather than the bottom left
+        (set! @ctm default-ctm-value)
+        (transform 1 0 0 -1 0 ($page-height (page)))
+        this)
+
+      (define/public (start-doc)
+        (write-bytes-out (format "%PDF-~a" (current-pdf-version)))
+        (write-bytes-out "%ÿÿÿÿ"))
+
+      (define/public (end-doc)
+        (for-each page-end @pages)
+
+        (define doc-info (make-ref))
+        (for ([(key val) (in-hash @info)])
+          (dict-set! doc-info key val))
+        (ref-end doc-info)
     
-      (for ([font (in-hash-values @font-families)])
-        (send font end))
+        (for ([font (in-hash-values @font-families)])
+          (send font end))
 
-      (define pages-ref (dict-ref @root 'Pages))
-      (dict-set! pages-ref 'Count (length @pages))
-      (dict-set! pages-ref 'Kids (map $page-dictionary (reverse @pages)))
-      (ref-end pages-ref)
+        (define pages-ref (dict-ref @root 'Pages))
+        (dict-set! pages-ref 'Count (length @pages))
+        (dict-set! pages-ref 'Kids (map $page-dictionary (reverse @pages)))
+        (ref-end pages-ref)
       
-      (ref-end @root)
+        (ref-end @root)
       
-      (define xref-offset (file-position (current-output-port)))
-      (write-bytes-out "xref")
-      (write-bytes-out (format "0 ~a" (add1 (length @refs))))
-      (write-bytes-out "0000000000 65535 f ")
-      (for ([ref (in-list (reverse @refs))])
-        (write-bytes-out
-         (string-append (~r ($ref-offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
-      (write-bytes-out "trailer")
-      (write-bytes-out (convert (mhasheq 'Size (add1 (length @refs))
-                                         'Root @root
-                                         'Info doc-info)))
-      (write-bytes-out "startxref")
-      (write-bytes-out (numberizer xref-offset))
-      (write-bytes-out "%%EOF"))))
+        (define xref-offset (file-position (current-output-port)))
+        (write-bytes-out "xref")
+        (write-bytes-out (format "0 ~a" (add1 (length @refs))))
+        (write-bytes-out "0000000000 65535 f ")
+        (for ([ref (in-list (reverse @refs))])
+          (write-bytes-out
+           (string-append (~r ($ref-offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
+        (write-bytes-out "trailer")
+        (write-bytes-out (convert (mhasheq 'Size (add1 (length @refs))
+                                           'Root @root
+                                           'Info doc-info)))
+        (write-bytes-out "startxref")
+        (write-bytes-out (numberizer xref-offset))
+        (write-bytes-out "%%EOF"))))
 
 (module+ test
-  (define d (new PDFDocument)))
\ No newline at end of file
+  (define d (make-$doc)))
\ No newline at end of file
diff --git a/pitfall/pitfall/page.rkt b/pitfall/pitfall/page.rkt
index d0a6cbae..73739779 100644
--- a/pitfall/pitfall/page.rkt
+++ b/pitfall/pitfall/page.rkt
@@ -12,56 +12,56 @@
 
 (define (make-page [page-parent #false] [options (mhash)])
   [define size (hash-ref options 'size "letter")]
-           [define layout (hash-ref options 'layout "portrait")]
-           [define dimensions (if (list? size)
-                           size
-                           (hash-ref page-sizes (string-upcase size)))]
-           [define width (list-ref dimensions (if (equal? layout "portrait") 0 1))]
-           [define height (list-ref dimensions (if (equal? layout "portrait") 1 0))]
-           [define content (make-ref)]
-           [define resources (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI)))]
-           [define margins
-            (let ([margin-value (hash-ref options 'margin #f)])
-              (if (number? margin-value)
-                  (margin margin-value margin-value margin-value margin-value)
-                  (hash-ref options 'margins (current-default-margins))))]
-           ;; The page dictionary
-           [define dictionary
-            (make-ref
-                  (mhash 'Type 'Page
-                         'Parent page-parent
-                         'MediaBox (list 0 0 width height)
-                         'Contents content
-                         'Resources resources))]
+  [define layout (hash-ref options 'layout "portrait")]
+  [define dimensions (if (list? size)
+                         size
+                         (hash-ref page-sizes (string-upcase size)))]
+  [define width (list-ref dimensions (if (equal? layout "portrait") 0 1))]
+  [define height (list-ref dimensions (if (equal? layout "portrait") 1 0))]
+  [define content (make-ref)]
+  [define resources (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI)))]
+  [define margins
+    (let ([margin-value (hash-ref options 'margin #f)])
+      (if (number? margin-value)
+          (margin margin-value margin-value margin-value margin-value)
+          (hash-ref options 'margins (current-default-margins))))]
+  ;; The page dictionary
+  [define dictionary
+    (make-ref
+     (mhash 'Type 'Page
+            'Parent page-parent
+            'MediaBox (list 0 0 width height)
+            'Contents content
+            'Resources resources))]
   ($page page-parent options size layout dimensions width height content resources margins dictionary))
 
-    (define (page-fonts p)
-      (dict-ref! ($page-resources p) 'Font (make-hasheq)))
+(define (page-fonts p)
+  (dict-ref! ($page-resources p) 'Font (make-hasheq)))
 
-    (define (page-xobjects p)
-      (dict-ref! ($page-resources p) 'XObject (make-hasheq)))
+(define (page-xobjects p)
+  (dict-ref! ($page-resources p) 'XObject (make-hasheq)))
 
-    (define (page-ext_gstates p)
-      (dict-ref! ($page-resources p) 'ExtGState (make-hasheq)))
+(define (page-ext_gstates p)
+  (dict-ref! ($page-resources p) 'ExtGState (make-hasheq)))
 
-    (define (page-patterns p)
-      (dict-ref! ($page-resources p) 'Pattern (make-hasheq)))
+(define (page-patterns p)
+  (dict-ref! ($page-resources p) 'Pattern (make-hasheq)))
 
-    (define (page-annotations p [annot #f])
-      (if annot
-          (dict-update! ($page-dictionary p) 'Annots (λ (val) (cons annot val)) null)
-          (dict-ref! ($page-dictionary p) 'Annots null)))
+(define (page-annotations p [annot #f])
+  (if annot
+      (dict-update! ($page-dictionary p) 'Annots (λ (val) (cons annot val)) null)
+      (dict-ref! ($page-dictionary p) 'Annots null)))
 
-    (define (page-maxY p)
-      (- ($page-height p) (margin-bottom ($page-margins p))))
+(define (page-maxY p)
+  (- ($page-height p) (margin-bottom ($page-margins p))))
 
-    (define (page-write p chunk)
-      (ref-write ($page-content p) chunk)) 
+(define (page-write p chunk)
+  (ref-write ($page-content p) chunk)) 
 
-    (define (page-end p)
-      (ref-end ($page-dictionary p))
-      (ref-end ($page-resources p))
-      (ref-end ($page-content p)))
+(define (page-end p)
+  (ref-end ($page-dictionary p))
+  (ref-end ($page-resources p))
+  (ref-end ($page-content p)))
 
 
 (define page-sizes
diff --git a/pitfall/pitfall/pdftest.rkt b/pitfall/pitfall/pdftest.rkt
index 73df7d2b..2b9d0cde 100644
--- a/pitfall/pitfall/pdftest.rkt
+++ b/pitfall/pitfall/pdftest.rkt
@@ -37,10 +37,10 @@
   (time
    (with-output-to-file ps
      (λ ()
-       (define doc (make-object PDFDocument (hash 'compress compress?)))
-       (send doc start-doc)
+       (define doc (make-$doc (hash 'compress compress?)))
+       (start-doc doc)
        (proc doc)
-       (send doc end-doc))
+       (end-doc doc))
      #:exists 'replace))
   (when test?
     (check-headers-equal? ps (this->control ps))
diff --git a/pitfall/pitfall/vector.rkt b/pitfall/pitfall/vector.rkt
index ff9e4dd8..c3329bd3 100644
--- a/pitfall/pitfall/vector.rkt
+++ b/pitfall/pitfall/vector.rkt
@@ -1,6 +1,6 @@
 #lang racket/base
 (require
-  "helper.rkt"
+  "core.rkt"
   racket/class
   racket/match
   racket/string
@@ -9,10 +9,12 @@
   sugar/unstable/js
   sugar/unstable/dict
   "path.rkt")
-(provide vector-mixin default-ctm-value)
+(provide vector-mixin default-ctm-value combine-transforms make-transform-string)
 
 (define default-ctm-value '(1 0 0 1 0 0))
 
+
+
 (define (vector-mixin [% mixin-tester%])
   (class %
     (super-new)
@@ -39,16 +41,16 @@
     (define/public (line-cap [c #f])
       (define cap-styles (hasheq 'butt 0 'round 1 'square 2))
       (add-content
-            (format "~a J" (if (symbol? c)
-                               (hash-ref cap-styles c)
-                               ""))))
+       (format "~a J" (if (symbol? c)
+                          (hash-ref cap-styles c)
+                          ""))))
 
     (define/public (line-join [j #f])
       (define cap-styles (hasheq 'miter 0 'round 1 'bevel 2))
       (add-content
-            (format "~a j" (if (symbol? j)
-                               (hash-ref cap-styles j)
-                               ""))))
+       (format "~a j" (if (symbol? j)
+                          (hash-ref cap-styles j)
+                          ""))))
 
     (define/public (line-width w)
       (add-content (format "~a w" (number w))))
@@ -57,9 +59,9 @@
       (cond
         [(list? length)
          (add-content
-               (format "[~a] ~a d"
-                       (string-join (map number length) " ")
-                       (hash-ref options 'phase 0)))]
+          (format "[~a] ~a d"
+                  (string-join (map number length) " ")
+                  (hash-ref options 'phase 0)))]
         [length
          (define space (hash-ref options 'space length))
          (define phase (hash-ref options 'phase 0))
@@ -172,6 +174,9 @@
         (+ (* m0 dx) (* m2 dy) m4)
         (+ (* m1 dx) (* m3 dy) m5)))
 
+(define (make-transform-string ctm)
+      (format "~a cm" (string-join (map numberizer ctm) " ")))
+
 (module+ test
   (require rackunit)
   (define ctm default-ctm-value)