From 5f0dd4e0f2f3a39950bea71564622842e2f2369d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 4 Jun 2019 13:02:23 -0700 Subject: [PATCH] test for booleans only --- quad/quadwriter/layout.rkt | 78 ++++++++++++++++++++++---------------- 1 file changed, 45 insertions(+), 33 deletions(-) diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 6da3664d..b5a0c272 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -10,7 +10,8 @@ racket/unsafe/ops "attrs.rkt" "param.rkt" - "font.rkt") + "font.rkt" + "log.rkt") (provide (all-defined-out)) @@ -147,9 +148,9 @@ (define new-run (quad-copy q:string [attrs (quad-attrs strq)] [elems (merge-adjacent-strings (apply append (for/list ([pc (in-list run-pcs)]) - (quad-elems pc))))] + (quad-elems pc))))] [size (delay (pt (for/sum ([pc (in-list run-pcs)]) - (pt-x (size pc))) + (pt-x (size pc))) (pt-y (size strq))))])) (loop (cons new-run runs) rest)] [(cons first rest) (loop (cons first runs) rest)]))) @@ -182,7 +183,7 @@ (define (sum-of-widths qss) (for*/sum ([qs (in-list qss)] [q (in-list qs)]) - (pt-x (size q)))) + (pt-x (size q)))) (define (space-quad? q) (equal? (quad-elems q) (list " "))) @@ -272,7 +273,7 @@ ;; remove unused soft hyphens so they don't affect final shaping (define pcs-printing (for/list ([pc (in-list pcs-in)] #:unless (equal? (quad-elems pc) '("\u00AD"))) - pc)) + pc)) (define new-lines (cond [(empty? pcs-printing) null] @@ -357,19 +358,19 @@ (apply append ;; next line removes all para-break? quads as a consequence (for/list ([qs (in-list (filter-split qs para-break-quad?))]) - (wrap qs - (λ (q idx) (* (- wrap-size - (quad-ref (car qs) :inset-left 0) - (quad-ref (car qs) :inset-right 0)) - permitted-justify-overfill)) - #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap)) - [(or "best" "kp") #true] - [_ #false]) - #:hard-break line-break-quad? - #:soft-break soft-break-for-line? - #:finish-wrap (finish-line-wrap line-q))))])) - -(define (make-nobreak! q) (quad-set! q :no-colbr "true")) ; cooperates with col-wrap + (wrap qs + (λ (q idx) (* (- wrap-size + (quad-ref (car qs) :inset-left 0) + (quad-ref (car qs) :inset-right 0)) + permitted-justify-overfill)) + #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap)) + [(or "best" "kp") #true] + [_ #false]) + #:hard-break line-break-quad? + #:soft-break soft-break-for-line? + #:finish-wrap (finish-line-wrap line-q))))])) + +(define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; cooperates with col-wrap (define (do-keep-with-next! reversed-lines) ;; paints nobreak onto spacers that follow keep-with-next lines @@ -380,8 +381,8 @@ [prev-ln (in-list (cdr reversed-lines))] #:when (and (line-spacer-quad? this-ln) (quad-ref prev-ln :keep-with-next))) - (make-nobreak! this-ln) - (make-nobreak! prev-ln))])) + (make-nobreak! this-ln) + (make-nobreak! prev-ln))])) (define (apply-keeps lines) (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines)) @@ -461,7 +462,7 @@ ;; adjust drawing coordinates for border inset (match-define (list bil bit bir bib) (for/list ([k (in-list (list :border-inset-left :border-inset-top :border-inset-right :border-inset-bottom))]) - (quad-ref first-line k 0))) + (quad-ref first-line k 0))) (match-define (list left top) (pt+ (quad-origin q) (list bil bit))) (match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib)))) ;; fill rect @@ -495,15 +496,26 @@ (quad-ref first-line :border-color-bottom) bw-bottom) (box-side left (+ bottom (half bw-bottom)) left (- top (half bw-top)) (quad-ref first-line :border-color-left) bw-left) - (case (quad-ref first-line :block-clip #false) - [(#true "true") + (case (quad-ref first-line :block-clip) + [(#true) + (when (eq? (log-clipping?) 'warn) + (for ([line (in-list (quad-elems q))]) + (define line-width (pt-x (size line))) + (define line-elem-width (for/sum ([q (in-list (quad-elems line))]) + (pt-x (size q)))) + (when (< line-width line-elem-width) + (define error-str (apply string-append (for/list ([q (in-list (quad-elems line))]) + (match (quad-elems q) + [(list (? string? str)) str] + [_ ""])))) + (log-quadwriter-warning (format "clipping overfull line: ~v" error-str))))) (save doc) (rect doc left top width height) (clip doc)])) (define ((block-draw-end first-line) q doc) - (case (quad-ref first-line :block-clip #false) - [(#true "true") (restore doc)]) + (case (quad-ref first-line :block-clip) + [(#true) (restore doc)]) (when (draw-debug-block?) (draw-debug q doc "#6c6" "#9c9"))) @@ -516,7 +528,7 @@ #:attrs (quad-attrs ln0) #:size (delay (pt (pt-x (size ln0)) ; (+ (for/sum ([line (in-list lines)]) - (pt-y (size line))) + (pt-y (size line))) (quad-ref ln0 :inset-top 0) (quad-ref ln0 :inset-bottom 0)))) #:shift-elems (pt 0 (+ (quad-ref ln0 :inset-top 0))) @@ -555,14 +567,14 @@ #:distance (λ (q dist-so-far wrap-qs) ;; do trial block insertions (for/sum ([x (in-list (insert-blocks wrap-qs))]) - (pt-y (size x)))) + (pt-y (size x)))) #:finish-wrap (col-finish-wrap column-quad)) col-spacer)) (define ((page-finish-wrap page-quad path) cols q0 q page-idx) (define elems - (match (quad-ref (car cols) :footer-display "true") - [(or "false" "none") (from-parent cols 'nw)] + (match (quad-ref (car cols) :footer-display #true) + [(or #false "none") (from-parent cols 'nw)] [_ (cons (make-footer-quad page-idx path) (from-parent cols 'nw))])) (list (quad-copy page-quad [elems elems]))) @@ -575,15 +587,15 @@ #:no-break (λ (q) (quad-ref q :no-pbr)) #:distance (λ (q dist-so-far wrap-qs) (for/sum ([x (in-list wrap-qs)]) - (pt-x (size x)))) + (pt-x (size x)))) #:finish-wrap (page-finish-wrap page-quad (pdf-output-path (current-pdf))))) (define (insert-blocks lines) (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines)) (append* (for/list ([line-group (in-list groups-of-lines)]) - (if (quad-ref (car line-group) :display) - (list (lines->block line-group)) - line-group)))) + (if (quad-ref (car line-group) :display) + (list (lines->block line-group)) + line-group)))) (define-quad first-line-indent-quad quad ())