listen

pitfall/pitfall/annotations.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require
   "core.rkt"
+    "reference.rkt"
   racket/class
   racket/match
   racket/contract
@@ -36,7 +37,7 @@
   (for ([(k v) (in-hash options)])
     (hash-set! options (string->symbol (string-titlecase (symbol->string k))) v))
 
-  (define annots-ref (send this make-ref options))
+  (define annots-ref (make-ref options))
   (send (· this page) annotations annots-ref)
   (· annots-ref end)
   this)
@@ -46,7 +47,7 @@
   ((number? number? number? number? string?) (hash?) . ->*m . object?)
   (hash-set*! options
               'Subtype "Link"
-              'A (send this make-ref (mhash 'S "URI"
+              'A (make-ref (mhash 'S "URI"
                                        'URI (String url))))
   (send (· options A) end)
   (send this annotate x y w h options))

pitfall/pitfall/color.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require
   "core.rkt"
+  "reference.rkt"
   racket/class
   racket/match
   racket/string)
@@ -104,7 +105,7 @@
                          (hash-set! dictionary 'ca fill-opacity))
                        (when stroke-opacity
                          (hash-set! dictionary 'CA stroke-opacity))
-                       (define ref-dict (send this make-ref dictionary))
+                       (define ref-dict (make-ref dictionary))
                        (send ref-dict end)
                        (set! @opacity-count (add1 @opacity-count))
                        (list ref-dict (format "Gs~a" @opacity-count)))))

pitfall/pitfall/core.rkt

@@ -26,6 +26,8 @@
 (define current-font (make-parameter #f))
 (define current-font-size (make-parameter 12))
 
+(define current-ref-listeners (make-parameter null))
+
 ;; helpers
 
 (define (numberizer x #:round [round? #true])

pitfall/pitfall/document.rkt

@@ -3,7 +3,6 @@
   "core.rkt"
   racket/class
   racket/format
-  racket/generator
   racket/match
   racket/dict
   racket/list
@@ -21,13 +20,13 @@
 
 (define PDFDocument
   (class (annotation-mixin (image-mixin (text-mixin (fonts-mixin (vector-mixin (color-mixin object%))))))
+        (set-current-id! 1)
+    (current-ref-listeners (cons (λ (ref) (send this log-ref ref)) (current-ref-listeners)))
+
     (super-new)
     (init-field [(@options options) (mhasheq)])  
     (field [@pages null]
            [@refs null]
-           [@ref-gen (generator () (let loop ([refid 1])
-                                     (yield refid)
-                                     (loop (add1 refid))))]
            [@root (make-ref (mhasheq 'Type "Catalog"
                                 'Pages (make-ref (mhasheq 'Type "Pages"))))]
            [(@x x) 0]
@@ -53,12 +52,10 @@
     (for ([(key val) (in-hash (hash-ref @options 'info (hasheq)))]) 
       (hash-set! @info key val))
 
-    (define/public (page) (first @pages))
+    (define/public (log-ref ref)
+      (set! @refs (cons ref @refs)))
 
-    (define/public (make-ref [payload (mhasheq)])
-      (define new-ref (make-object PDFReference (@ref-gen) payload))
-      (set! @refs (cons new-ref @refs))
-      new-ref)
+    (define/public (page) (first @pages))
 
     (define/public (add-page [options-arg @options])
       ;; create a page object

pitfall/pitfall/embedded.rkt

@@ -2,6 +2,7 @@
 (require
   (for-syntax racket/base)
   "core.rkt"
+  "reference.rkt"
   racket/class
   racket/match
   racket/string
@@ -88,7 +89,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
     (define/override (embed)
       ;; no CFF support
       (define isCFF #false) #;(is-a? subset CFFSubset)
-      (define font-file (send @document make-ref))
+      (define font-file (make-ref))
 
       (when isCFF
         (dict-set! font-file 'Subtype "CIDFontType0C"))
@@ -115,7 +116,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
                                   (integer->char (random 65 (+ 65 26))))))
       (define name (string-append tag "+" (font-postscript-name font)))
       (define bbox (font-bbox font))
-      (define descriptor (send @document make-ref
+      (define descriptor (make-ref
                                (mhash
                                 'Type "FontDescriptor"
                                 'FontName name
@@ -132,7 +133,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
       (dict-set! descriptor (if isCFF 'FontFile3 'FontFile2) font-file)
       (send descriptor end)
 
-      (define descendant-font (send @document make-ref
+      (define descendant-font (make-ref
                                    (mhash
                                     'Type "Font"
                                     'Subtype (string-append "CIDFontType" (if isCFF "0" "2"))
@@ -159,7 +160,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
 
 
     (define/public (toUnicodeCmap)
-      (define cmap (send @document make-ref))
+      (define cmap (make-ref))
       (define entries
         (for/list ([idx (in-range (length (hash-keys unicode)))])
           (define codepoints (hash-ref unicode idx))

pitfall/pitfall/font.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require racket/class)
+(require racket/class "reference.rkt")
 (provide PDFFont)
 
 (define PDFFont
@@ -17,7 +17,7 @@
     
     (define/public (ref)
       (unless @dictionary
-        (set! @dictionary (send @document make-ref)))
+        (set! @dictionary (make-ref)))
       @dictionary)
 
     (define/public (finalize)

pitfall/pitfall/jpeg-structy.rkt

@@ -48,7 +48,7 @@
 
   (unless (· this obj)
     (set-field! obj this
-                (send doc-in make-ref
+                (make-ref
                       (mhash
                        'Type "XObject"
                        'Subtype "Image"

pitfall/pitfall/jpeg.rkt

@@ -1,6 +1,7 @@
 #lang debug racket/base
 (require
   racket/class
+    "reference.rkt"
   racket/contract
   racket/dict
   sugar/unstable/class
@@ -55,7 +56,7 @@
 
   (unless (· this obj)
     (set-field! obj this
-                (send doc-in make-ref
+                (make-ref
                       (mhash
                        'Type "XObject"
                        'Subtype "Image"

pitfall/pitfall/page.rkt

@@ -2,6 +2,7 @@
 (require
   racket/class
   racket/dict
+  "reference.rkt"
   sugar/unstable/dict
   "core.rkt")
 
@@ -18,8 +19,8 @@
                            (hash-ref page-sizes (string-upcase @size)))]
            [(@width width) (list-ref @dimensions (if (equal? @layout "portrait") 0 1))]
            [(@height height) (list-ref @dimensions (if (equal? @layout "portrait") 1 0))]
-           [@content (send @doc make-ref)]
-           [(@resources resources) (send @doc make-ref (mhash 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))]
+           [@content (make-ref)]
+           [(@resources resources) (make-ref (mhash 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))]
            [(@margins margins)
             (let ([margin-value (hash-ref @options 'margin #f)])
               (if (number? margin-value)
@@ -27,7 +28,7 @@
                   (hash-ref @options 'margins (current-default-margins))))]
            ;; The page dictionary
            [(@dictionary dictionary)
-            (send @doc make-ref
+            (make-ref
                   (mhash 'Type "Page"
                          'Parent @page-parent
                          'MediaBox (list 0 0 @width @height)

pitfall/pitfall/png.rkt

@@ -1,6 +1,7 @@
 #lang debug racket/base
 (require
   racket/class
+    "reference.rkt"
   racket/contract
   racket/dict
   racket/draw
@@ -34,7 +35,7 @@
   
   (unless (· this obj)
     (set-field! obj this
-                (send (· this document) make-ref
+                (make-ref
                       (mhash 'Type "XObject"
                              'Subtype "Image"
                              'BitsPerComponent (· this image bits)
@@ -43,7 +44,7 @@
                              'Filter "FlateDecode")))
 
     (unless (· this image hasAlphaChannel)
-      (define params (send (· this document) make-ref
+      (define params (make-ref
                            (mhash 'Predictor 15
                                   'Colors (· this image colors)
                                   'BitsPerComponent (· this image bits)
@@ -82,7 +83,7 @@
 
   (when (· this alphaChannel)
     (define sMask
-      (send (· this document) make-ref
+      (make-ref
             (mhash 'Type "XObject"
                    'Subtype "Image"
                    'Height (· this height)

pitfall/pitfall/reference.rkt

@@ -7,7 +7,7 @@
          "core.rkt"
          "object.rkt"
          "zlib.rkt")
-(provide PDFReference)
+(provide PDFReference set-current-id! make-ref)
 
 (define dictable<%>
   (interface* ()
@@ -20,6 +20,15 @@
                                       (define (dict-set! refobj key val) (send refobj set-key! key val))
                                       (define (dict-update! refobj key updater [failure-result (λ () (error 'update-no-key))]) (send refobj update-key! key updater failure-result)))])))
 
+(define current-id 0)
+(define (set-current-id! val)
+  (set! current-id val))
+
+(define (make-ref [payload (make-hasheq)])
+  (begin0
+    (make-object PDFReference current-id payload)
+    (set! current-id (add1 current-id))))
+
 (define PDFReference
   (class* object% (dictable<%>)
     (super-new)
@@ -28,6 +37,8 @@
     (field [(@offset offset) #f]
            [@port (open-output-bytes)])
 
+    (for-each (λ (proc) (proc this)) (current-ref-listeners))
+
     (define/public (write x)
       (write-bytes (to-bytes x) @port))