From f714796e3aabef64ee43d360aca01f4319ff3e63 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 13 Mar 2018 22:23:11 -0700
Subject: [PATCH] resume in font sizing

---
 quad/quad/typewriter-test.rkt |  2 +-
 quad/quad/typewriter.rkt      | 28 +++++++++++++++++++++++-----
 2 files changed, 24 insertions(+), 6 deletions(-)

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