From 84f3dd2c2849dd5df5fd9f1771799f85ac9be61e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 20 Mar 2018 12:43:36 -0700 Subject: [PATCH] whoa that's slow --- quad/quad/position.rkt | 18 ++++++++------ quad/quad/typewriter-test.rkt | 4 ++- quad/quad/typewriter.rkt | 47 ++++++++++++++++++++--------------- 3 files changed, 40 insertions(+), 29 deletions(-) diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index c5926e2f..238f5b43 100644 --- a/quad/quad/position.rkt +++ b/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?)) diff --git a/quad/quad/typewriter-test.rkt b/quad/quad/typewriter-test.rkt index 19678582..7616e317 100644 --- a/quad/quad/typewriter-test.rkt +++ b/quad/quad/typewriter-test.rkt @@ -1,3 +1,5 @@ #lang quad/typewriter -◊quad[#:fontsize "18"]{Hel}◊quad[#:fontsize "32"]{Lo}◊quad[#:fontsize "8"]{ World} \ No newline at end of file +◊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."} \ No newline at end of file diff --git a/quad/quad/typewriter.rkt b/quad/quad/typewriter.rkt index 3120db2b..a0f8ee50 100644 --- a/quad/quad/typewriter.rkt +++ b/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