cache annotations refs

pitfall/pitfall/annotations.rkt

@@ -9,6 +9,12 @@
 
 (provide (all-defined-out))
 
+(define annots-cache (make-hash))
+(define link-ref-cache (make-hash))
+(define (reset-annotations-cache!)
+  (set! link-ref-cache (make-hash))
+  (set! annots-cache (make-hash)))
+
 (define (annotate doc x y w h options)
   (hash-set*! options
               'Type 'Annot
@@ -23,28 +29,38 @@
   (for ([(k v) (in-hash options)])
     (hash-set! options (string->symbol (string-titlecase (symbol->string k))) v))
 
-  (define annots-ref (make-ref options))
+  ;; reuse previous identical annotations (= fewer refs in file)
+  (define annots-ref
+    (hash-ref! annots-cache (sort (hash->list options) #:key car symbol<?)
+               (λ ()
+                 (define new-ref (make-ref options))
+                 (ref-end new-ref)
+                 new-ref)))
   (page-annotations (current-page doc) annots-ref)
-  (ref-end annots-ref)
   doc)
 
 (define (convert-rect doc x1 y1 w h)
-        ;; flip y1 and y2
-        (let ([y2 y1]
-              [y1 (+ y1 h)]
-              [x2 (+ x1 w)])
-          (match-define (list m0 m1 m2 m3 m4 m5) ($doc-ctm doc))
-          (let* ([x1 (+ (* x1 m0) (* y1 m2) m4)]
-                 [y1 (+ (* x1 m1) (* y1 m3) m5)]
-                 [x2 (+ (* x2 m0) (* y2 m2) m4)]
-                 [y2 (+ (* x2 m1) (* y2 m3) m5)])
-            (list x1 y1 x2 y2))))
+  ;; flip y1 and y2
+  (let ([y2 y1]
+        [y1 (+ y1 h)]
+        [x2 (+ x1 w)])
+    (match-define (list m0 m1 m2 m3 m4 m5) ($doc-ctm doc))
+    (let* ([x1 (+ (* x1 m0) (* y1 m2) m4)]
+           [y1 (+ (* x1 m1) (* y1 m3) m5)]
+           [x2 (+ (* x2 m0) (* y2 m2) m4)]
+           [y2 (+ (* x2 m1) (* y2 m3) m5)])
+      (list x1 y1 x2 y2))))
 
 (define (link doc x y w h url [options (mhasheq)])
+  ;; reuse previous links (= fewer refs in file)
+  (define link-ref
+    (hash-ref! link-ref-cache url
+               (λ ()
+                 (define link-ref (make-ref (mhasheq 'S 'URI 'URI url)))
+                 (ref-end link-ref)
+                 link-ref)))
   (hash-set*! options
               'Subtype 'Link
-              'A (make-ref (mhash 'S 'URI
-                                  'URI url)))
-  (ref-end (hash-ref options 'A))
+              'A link-ref)
   (annotate doc x y w h options))
 

pitfall/pitfall/document.rkt

@@ -5,6 +5,7 @@
   racket/format
   racket/dict
   sugar/unstable/dict
+  "annotations.rkt"
   "reference.rkt"
   "object.rkt"
   "page.rkt"
@@ -57,6 +58,7 @@
                         y
                         image-registry))
   (set-current-ref-id! 1)
+  (reset-annotations-cache!)
   (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)))))