diff --git a/quad/quad/typewriter-test.rkt b/quad/quad/typewriter-test.rkt index 8dd00713..1d0aaf83 100644 --- a/quad/quad/typewriter-test.rkt +++ b/quad/quad/typewriter-test.rkt @@ -1,3 +1,3 @@ #lang quad/typewriter -◊quad[#:link "http://beautfifulracket.com"]{An expression that} is not a value can always 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 +◊quad[#:link "http://beautfifulracket.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 23ae74f8..38205525 100644 --- a/quad/quad/typewriter.rkt +++ b/quad/quad/typewriter.rkt @@ -12,7 +12,8 @@ ($char (hash-set* (attrs q) 'size (hash-ref! char-sizes (car (elems q)) (λ () - (send util-doc fontSize 12) + (send util-doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12"))) + (send util-doc font "Courier") (list (send util-doc widthOfString (apply string (elems q))) (send util-doc currentLineHeight)))) @@ -21,7 +22,7 @@ [(#\space) (λ (sig) (not (memq sig '(start end))))] [else #t]) 'draw (λ (q doc) - (send doc fontSize 12) + (send doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12"))) (let ([str (apply string (elems q))]) (cond [(hash-ref (attrs q) 'link #f) @@ -36,6 +37,23 @@ (define page-count 1) (define (make-break . xs) ($break (hasheq 'printable? #f 'size '(0 0)) xs)) +(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)))) + +(define (consolidate-runs pcs) + (for/fold ([runs empty] + [pcs pcs] + #:result (reverse runs)) + ([i (in-naturals)] + #:break (empty? pcs)) + (define-values (run-pcs rest) (splitf-at pcs (λ (p) (run-attrs-match (car pcs) p)))) + (define new-run ($char (hash-set (attrs (car pcs)) + 'size (delay (apply map + (map size run-pcs)))) + (append-map elems run-pcs))) + (values (cons new-run runs) rest))) + (define line-height 16) (define consolidate-into-runs? #t) (define (line-wrap xs size [debug #f]) @@ -48,7 +66,7 @@ ;; this only works because there's only one run per line ;; that is, it suffices to position the first letter (if consolidate-into-runs? - (list ($char (attrs (car pcs)) (append-map elems pcs))) + (consolidate-runs pcs) pcs)))))) (define (as-link doc str url-str [x 0] [y 0]) @@ -57,7 +75,7 @@ (define width (send doc widthOfString str)) (define height (send doc currentLineHeight)) (send doc text str x y) - (send doc link x y width height "https://beautifulracket.com") + (send doc link x y width height url-str) (send doc restore)) (define pb ($break (hasheq 'printable? #f @@ -66,7 +84,7 @@ (send doc addPage) (send doc fontSize 10) (define str (string-append "page " (number->string page-count))) - (as-link doc str "https://beautifulracket.com" 10 10) + (as-link doc str "https://practicaltypography.com" 10 10) (set! page-count (add1 page-count)))) '(#\page))) (define (page-wrap xs size [debug #f]) (break xs size debug