whoa that's slow

quad/quad/position.rkt

@@ -20,26 +20,29 @@
 
 (define (coerce-int x) (if (integer? x) (inexact->exact x) x))
 
-(define fonts (make-hash))
+
+(define (get-font p)
+  (define fonts (make-hash))
+  (hash-ref! fonts p (λ () (openSync p))))
 
 (define/contract (ascender q)
   (quad? . -> . real?)
   (define p (hash-ref (attrs q) 'font "Courier"))
   (unless p
     (error 'ascender-no-font-key))
-  (ascent (hash-ref! fonts p (λ () (openSync p)))))
+  (ascent (get-font p)))
 
 (define/contract (units-per-em q)
   (quad? . -> . real?)
   (define p (hash-ref (attrs q) 'font "Courier"))
   (unless p
     (error 'units-per-em-no-font-key))
-  (unitsPerEm (hash-ref! fonts p (λ () (openSync p)))))
+  (unitsPerEm (get-font p)))
 
 (define (fontsize q)
   ;; this needs to not default to 0
   ;; needs parameter with default font size
-  (define val (hash-ref (attrs q) 'fontsize 0))
+  (define val (hash-ref (attrs q) 'fontsize (λ () (error 'no-font-size))))
   ((if (number? val) values string->number) val))
 
 (define (vertical-baseline-offset q)
@@ -56,10 +59,9 @@
       [( w) '(0 0.5)] [(c) '(0.5 0.5)] [( e) '(1 0.5)]
       [(sw) '(0 1  )] [(s) '(0.5 1  )] [(se) '(1 1  )]
       [(bi) '(0 0  )]                  [(bo) '(1 0  )]))
-  (for/list ([coord (size q)]
-             [fac (list x-fac y-fac)]
-             [offset (list 0 (if (memq anchor '(bi bo)) (vertical-baseline-offset q) 0))])
-            (coerce-int (+ (* coord fac) offset))))
+  (match-define (list x y) (size q))
+  (pt (coerce-int (* x x-fac))
+      (coerce-int (+ (* y y-fac) (if (memq anchor '(bi bo)) (vertical-baseline-offset q) 0)))))
 
 (define point/c (quad? . -> . point?))
 

quad/quad/typewriter-test.rkt

@@ -1,3 +1,5 @@
 #lang quad/typewriter
 
-◊quad[#:fontsize "18"]{Hel}◊quad[#:fontsize "32"]{Lo}◊quad[#:fontsize "8"]{ World}
+◊quad[#:fontsize "11"]{◊quad[#:link "http://beautifulracket.com"]{An expression that} is not a value can ◊quad[#:fontsize "22"]{always}  ◊quad[#:fontsize "7"]{be partitioned} into}
+
+◊;quad[#:fontsize "11"]{◊quad[#:link "http://beautifulracket.com"]{An expression that} is not a value can ◊quad[#:fontsize "22"]{always}  ◊quad[#:fontsize "7"]{be partitioned} into two parts: a redex, which is the part that changed in a single-step simplification (highlighted), and the continuation, which is the evaluation context surrounding an expression. In (- 4 (+ 1 1)), the redex is (+ 1 1), and the continuation is (- 4 []), where [] takes the place of the redex. That is, the continuation says how to "continue" after the redex is reduced to a value."}

quad/quad/typewriter.rkt

@@ -23,18 +23,21 @@
   (send doc fill "#f99")  
   (send doc restore))
 
-(define char-sizes (make-hasheqv))
+(define char-sizes (make-hash))
 (define (charify q)
   ($char (hash-set* (attrs q)
                     'in 'bi
                     'out 'bo
                     'font fira
-                    'size (λ ()
-                            (send util-doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12")))
-                            (send util-doc font fira)
-                            (list
-                             (send util-doc widthOfString (apply string (elems q)))
-                             (send util-doc currentLineHeight)))
+                    'size 
+                    (delay
+                      (let ([fontsize (string->number (hash-ref (attrs q) 'fontsize "12"))]
+                              [str (apply string (elems q))])
+                          (send util-doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12")))
+                          (send util-doc font fira)
+                          (list
+                           (send util-doc widthOfString str)
+                           (send util-doc currentLineHeight))))
                     'printable? (case (car (elems q))
                                   [(#\u00AD) (λ (sig) (memq sig '(end)))]
                                   [(#\space) (λ (sig) (not (memq sig '(start end))))]
@@ -59,7 +62,7 @@
 (define (run-attrs-match left right)
   (define missing (gensym))
   (for/and ([k (in-list '(link weight fontsize))])
-    (equal? (hash-ref (attrs left) k missing) (hash-ref (attrs right) k missing))))
+           (equal? (hash-ref (attrs left) k missing) (hash-ref (attrs right) k missing))))
 
 (define (consolidate-runs pcs)
   (for/fold ([runs empty]
@@ -118,7 +121,10 @@
   (define chars 25)
   (define line-width (* 7.2 chars))
   (define lines-per-page (* 4 line-height))
-  (position ($doc (hasheq 'origin '(36 36)) (page-wrap (line-wrap (map charify (atomize qarg)) line-width) lines-per-page))))
+  (let* ([x (begin (report 'line-wrap) (time (line-wrap (map charify (atomize qarg)) line-width)))]
+         [x (begin (report 'page-wrap) (time (page-wrap x lines-per-page)))]
+         [x (begin (report 'position) (time (position ($doc (hasheq 'origin '(36 36)) x))))])
+    x))
 
 
 (provide quad)
@@ -129,17 +135,18 @@
     #'(#%module-begin
        (define q (typeset (qexpr->quad (quad . ARGS))))
        ;q
-       (let ([doc (make-object PDFDocument
-                    (hasheq 'compress #t
-                            'autoFirstPage #f
-                            'size '(150 150)))])
-         (send* doc
-           [pipe (open-output-file PS #:exists 'replace)]
-           [registerFont "Fira" (path->string fira)]
-           [font "Fira"]
-           [fontSize 12])
-         (draw q doc)
-         (send doc end))
+       (report 'draw)
+       (time (let ([doc (make-object PDFDocument
+                          (hasheq 'compress #t
+                                  'autoFirstPage #f
+                                  'size '(300 200)))])
+               (send* doc
+                 [pipe (open-output-file PS #:exists 'replace)]
+                 [registerFont "Fira" (path->string fira)]
+                 [font "Fira"]
+                 [fontSize 12])
+               (draw q doc)
+               (send doc end)))
        (void))))
 
 (module reader syntax/module-reader