|
|
|
@ -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,15 +513,16 @@
|
|
|
|
|
[_ #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
|
|
|
|
|
(line-wrap (list (make-quad "foo" #:type string-quad)
|
|
|
|
|
(line-wrap (list (make-quad "foo" #:type string-quad)
|
|
|
|
|
(make-quad #:type column-break-quad)
|
|
|
|
|
(make-quad "foo2" #:type string-quad) ) 10 #t)
|
|
|
|
|
|
|
|
|
|
(line-wrap (list (make-quad "foo" #:type string-quad)
|
|
|
|
|
(line-wrap (list (make-quad "foo" #:type string-quad)
|
|
|
|
|
(make-quad #:type column-break-quad)) 10 #t))
|
|
|
|
|
|
|
|
|
|
(define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; scooperates with col-wrap
|
|
|
|
@ -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)))])))
|
|
|
|
|
|
|
|
|
|