investigate slow

quad/quad/draw.rkt

@@ -1,21 +0,0 @@
-#lang debug br
-(require pict racket/draw)
-
-
-(dc (λ (dc dx dy)
-        (define old-brush (send dc get-brush))
-        (define old-pen (send dc get-pen))
-        (send dc set-brush
-          (new brush% [style 'fdiagonal-hatch]
-                      [color "darkslategray"]))
-        (send dc set-pen
-          (new pen% [width 3] [color "slategray"]))
-        (define path (new dc-path%))
-        (send path move-to 0 0)
-        (send path line-to 50 0)
-        (send path line-to 25 50)
-        (send path close)
-        (send dc draw-path path dx dy)
-        (send dc set-brush old-brush)
-        (send dc set-pen old-pen))
-    100 100)

quad/quad/typewriter-test.rkt

@@ -1,5 +1,7 @@
 #lang quad/typewriter
 
-◊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"]{Hello}
+
+◊;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

@@ -32,12 +32,12 @@
                     'size 
                     (delay
                       (let ([fontsize (string->number (hash-ref (attrs q) 'fontsize "12"))]
-                              [str (apply string (elems q))])
+                            [str (apply string (elems q))])
-                          (send util-doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12")))
+                        (send util-doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12")))
-                          (send util-doc font fira)
+                        (send util-doc font fira)
-                          (list
+                        (list
-                           (send util-doc widthOfString str)
+                         (send util-doc widthOfString str)
-                           (send util-doc currentLineHeight))))
+                         (send util-doc currentLineHeight))))
                     'printable? (case (car (elems q))
                                   [(#\u00AD) (λ (sig) (memq sig '(end)))]
                                   [(#\space) (λ (sig) (not (memq sig '(start end))))]
@@ -51,7 +51,8 @@
                                  =>
                                  (λ (url-str) (apply as-link doc str url-str (origin q)))]
                                 [else
-                                 (send/apply doc text str (origin q))])))) (elems q)))
+                                 (println str)
+                                 (time-name send-text (send/apply doc text str (origin q)))])))) (elems q)))
 (struct $line $quad () #:transparent)
 (struct $page $quad () #:transparent)
 (struct $doc $quad () #:transparent)
@@ -121,9 +122,9 @@
   (define chars 25)
   (define line-width (* 7.2 chars))
   (define lines-per-page (* 4 line-height))
-  (let* ([x (begin (report 'line-wrap) (time (line-wrap (map charify (atomize qarg)) line-width)))]
+  (let* ([x (time-name line-wrap (line-wrap (map charify (atomize qarg)) line-width))]
-         [x (begin (report 'page-wrap) (time (page-wrap x lines-per-page)))]
+         [x (time-name page-wrap (page-wrap x lines-per-page))]
-         [x (begin (report 'position) (time (position ($doc (hasheq 'origin '(36 36)) x))))])
+         [x (time-name position (position ($doc (hasheq 'origin '(36 36)) x)))])
     x))
 
 
@@ -133,20 +134,20 @@
 (define-macro (mb . ARGS)
   (with-pattern ([PS (syntax-property #'ARGS 'ps)])
     #'(#%module-begin
-       (define q (typeset (qexpr->quad (quad . ARGS))))
+       (let ([doc (time-name make-doc
-       ;q
+                             (make-object PDFDocument
-       (report 'draw)
+                               (hasheq 'compress #t
-       (time (let ([doc (make-object PDFDocument
+                                       'autoFirstPage #f
-                          (hasheq 'compress #t
+                                       'size '(300 200))))])
-                                  'autoFirstPage #f
+         (time-name config-doc
-                                  'size '(300 200)))])
+                    (send* doc
-               (send* doc
+                      [pipe (open-output-file PS #:exists 'replace)]
-                 [pipe (open-output-file PS #:exists 'replace)]
+                      [registerFont "Fira" (path->string fira)]
-                 [registerFont "Fira" (path->string fira)]
+                      [font "Fira"]
-                 [font "Fira"]
+                      [fontSize 12]))
-                 [fontSize 12])
+         (define q (typeset (qexpr->quad (quad . ARGS))))
-               (draw q doc)
+         (time-name draw (draw q doc))
-               (send doc end)))
+         (time-name end-doc (send doc end)))
        (void))))
 
 (module reader syntax/module-reader