better break conversion

quad/quadwriter/layout.rkt

@@ -121,18 +121,22 @@
     (list string-size (quad-ref q :line-height default-line-height))))
 
 (define (convert-break-quad q)
-  (define break-quad-type (match (quad-ref q :break)
-                            ["para" para-break-quad]
-                            ["line" line-break-quad]
-                            ["page" page-break-quad]
-                            ["column" column-break-quad]
-                            ["hr" hr-break-quad]
-                            ["section" section-break-quad]
-                            [_ #false]))
-  (if break-quad-type
-      (make-quad #:type break-quad-type
-                 #:attrs (quad-attrs q))
-      q))
+  ;; this is verbose & ugly because `struct-copy` is a macro
+  ;; we want to use break prototypes but also preserve their type
+  (match (quad-ref q :break)
+    ["para" (struct-copy para-break-quad q:para-break
+                         [attrs #:parent quad (quad-attrs q)])]
+    ["line" (struct-copy line-break-quad q:line-break
+                         [attrs #:parent quad (quad-attrs q)])]
+    ["page" (struct-copy page-break-quad q:page-break
+                         [attrs #:parent quad (quad-attrs q)])]
+    ["column" (struct-copy column-break-quad q:column-break
+                           [attrs #:parent quad (quad-attrs q)])]
+    ["hr" (struct-copy hr-break-quad q:hr-break
+                       [attrs #:parent quad (quad-attrs q)])]
+    ["section" (struct-copy section-break-quad q:section-break
+                            [attrs #:parent quad (quad-attrs q)])]
+    [_ q]))
 
 (module+ test
   (check-equal? (quad-ref (convert-break-quad (qexpr->quad '(q ((break "page") (foo "bar"))))) 'foo) "bar"))
@@ -259,15 +263,16 @@
 (define (consolidate-runs pcs ending-q)
   (let loop ([runs empty][pcs pcs])
     (match pcs
-      [(? empty?) (reverse runs)]
       [(cons (? string-quad? strq) rest)
        (define-values (run-pcs rest) (splitf-at pcs (λ (p) (same-run? strq p))))
-       (define new-run (quad-copy q:string
+       (define new-run
+         (quad-copy q:string
                     [attrs (quad-attrs strq)]
                     [elems (merge-adjacent-strings (apply append (map quad-elems run-pcs)))]
                     [size (delay (pt (sum-x run-pcs) (pt-y (size strq))))]))
        (loop (cons new-run runs) rest)]
-      [(cons first rest) (loop (cons first runs) rest)])))
+      [(cons first rest) (loop (cons first runs) rest)]
+      [_ (reverse runs)])))
 
 (define (render-hyphen qs ending-q)
   ;; naive handling of soft hyphen:
@@ -405,12 +410,17 @@
          [(? pair? elems)
           (define elem (unsafe-car elems))
           (match-define (list line-width line-height) (quad-size line-q))
-          (define new-size (let ()
-                             (define line-heights
-                               (filter-map (λ (q) (or (quad-ref q :line-height) (pt-y (size q)))) pcs))
-                             (pt line-width (if (empty? line-heights) line-height (apply max line-heights)))))
+          (define new-size
+            (let ([line-heights
+                   (filter-map
+                    (λ (q) (or (quad-ref q :line-height) (pt-y (size q))))
+                    pcs)])
+              (pt line-width (if (empty? line-heights)
+                                 line-height
+                                 (apply max line-heights)))))
           (list
-           (quad-copy line-q
+           (quad-copy
+            line-q
             ;; move block attrs up, so they are visible in col wrap
             [attrs (copy-block-attrs (quad-attrs elem)
                                      (hash-copy (quad-attrs line-q)))]
@@ -486,6 +496,7 @@
                            (loop rest (cons bq acc))]
                           [(list* (and (not (? para-break-quad?)) nbqs) ... rest)
                            (loop rest (cons nbqs acc))])))
+     (define res
        (apply append
               (for/list ([para-qs (in-list para-qss)])
                         (match para-qs
@@ -502,7 +513,8 @@
                                             [_ #false])
                                  #:hard-break line-break-quad?
                                  #:soft-break soft-break-for-line?
-                         #:finish-wrap (line-wrap-finish line-q))])))]
+                                 #:finish-wrap (line-wrap-finish line-q))]))))
+     res]
     [_ null]))
 
 (module+ test
@@ -789,18 +801,21 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
 (verbose-quad-printing? #t)
 (define ((page-wrap-finish make-page-quad path) cols q0 q page-idx)
   (define page-quad (make-page-quad (+ (section-pages-used) page-idx)))
+  ;; get attrs from cols if we can, otherwise try q or q0
+  (define q-for-attrs (cond
+                        [(pair? cols) (car cols)]
+                        [q]
+                        [q0]))
   (define elems
     (append
-     (match (and (pair? cols) (quad-ref (car cols) :footer-display #true))
+     (match (quad-ref q-for-attrs :footer-display #true)
        [(or #false "none") null]
-       [_ (list (make-footer-quad (car cols) page-idx path))])
+       [_ (list (make-footer-quad q-for-attrs page-idx path))])
      (from-parent cols 'nw)))
   (list (quad-copy page-quad
                    [elems elems]
                    [attrs (copy-block-attrs (cond
-                                              ;; get attrs from cols if we can,
-                                              ;; otherwise try q or q0
-                                              [(or (and (pair? cols) (car cols)) q q0) => quad-attrs]
+                                              [q-for-attrs => quad-attrs]
                                               [else (hash)])
                                             (hash-copy (quad-attrs page-quad)))])))