From 1d09780840aa364149229709d159056ec2e8357a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 7 Jan 2019 08:38:13 -0800 Subject: [PATCH] refac --- quad/quad/break.rkt | 197 ++++++++++++++++++++++---------------------- 1 file changed, 100 insertions(+), 97 deletions(-) diff --git a/quad/quad/break.rkt b/quad/quad/break.rkt index 039e0070..9b8e3693 100644 --- a/quad/quad/break.rkt +++ b/quad/quad/break.rkt @@ -19,9 +19,15 @@ (define (break xs [target-size (current-wrap-distance)] [debug #f] - #:hard-break-proc [hard-break? (λ xs #f)] - #:soft-break-proc [soft-break? (λ xs #f)] + #:hard-break-proc [hard-break? (λ (x) #f)] + #:soft-break-proc [soft-break? (λ (x) #f)] #:finish-wrap-proc [finish-wrap-proc list]) + #;((listof quad?) + (real? + any/c + #:hard-break-proc (any/c . -> . any/c) + #:soft-break-proc (any/c . -> . any/c) + #:finish-wrap-proc ((listof any/c) . -> . (listof any/c))) . ->* . (listof any/c)) (break-hards xs target-size debug @@ -37,26 +43,26 @@ hard-break? soft-break? finish-wrap-proc) - (define (cleanup-wraplist xs) - (append* (reverse xs))) - (define wraps - (let loop ([wraps null][xs xs]) - (match xs - [(? null?) wraps] - [(cons (? hard-break?) rest) - (debug-report x 'hard-break) - (loop wraps rest)] - [_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x))))) - (loop (cons (cleanup-wraplist (break-softs head - target-size - debug - soft-break? - finish-wrap-proc)) wraps) tail)]))) - (cleanup-wraplist wraps)) - -(define (nonprinting-at-start? x) (if (quad? x) (not (printable? x 'start)) #t)) -(define (nonprinting-at-end? x) (if (quad? x) (not (printable? x 'end)) #t)) -(define (nonprinting-in-middle-soft-break? x) (and (quad? x) (not (printable? x)) (soft-break? x))) + (define (cleanup-wraplist xs) (append* (reverse xs))) + (let loop ([wraps null][xs xs]) + (match xs + [(? null?) (cleanup-wraplist wraps)] + [(cons (? hard-break?) rest) + (debug-report x 'hard-break) + (loop wraps rest)] + [_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x))))) + (loop (cons (cleanup-wraplist (break-softs head + target-size + debug + soft-break? + finish-wrap-proc)) wraps) tail)]))) + +(define (nonprinting-at-start? x) + (not (printable? x 'start))) +(define (nonprinting-at-end? x) + (not (printable? x 'end))) +(define (nonprinting-in-middle-soft-break? x) + (and (not (printable? x)) (soft-break? x))) (define (wrap-append partial wrap) (match/values @@ -64,89 +70,86 @@ [((== empty) _) wrap] [(partial (list (? nonprinting-in-middle-soft-break?) ... rest ...)) (append (or partial null) rest)])) - (define (break-softs qs target-size debug soft-break? finish-wrap-proc) - (for/fold ([wraps null] ; list of (list of quads) + (let loop ([wraps null] ; list of (list of quads) [next-wrap-head null] ; list of quads ending in previous `soft-break?` [next-wrap-tail null] ; list of unbreakable quads [current-dist #false] ; #false (to indicate start) or integer - [qs qs] ; list of quads - #:result (let () - (define last-wrap (wrap-append #false (wrap-append next-wrap-tail next-wrap-head))) - (define finished-wraps - (for/list ([wrap (in-list (cons last-wrap wraps))]) - (match wrap - [(list (? nonprinting-at-end?)) wrap] ; matches break signals - ;; pieces will have been accumulated in reverse order - ;; thus beginning of list represents the end of the wrap - [(list (and (? soft-break?) (? nonprinting-at-end?)) ... rest ...) - (finish-wrap-proc (reverse rest))]))) - finished-wraps)) - ([i (in-naturals)] - #:break (empty? qs)) - (match-define (cons q other-qs) qs) - (debug-report q 'next-q) - (debug-report (quad-elems q) 'next-q-elems) - (define at-start? (not current-dist)) - (define dist (if (and (quad? q) (printable? q)) (distance q) 0)) - (define would-overflow? (and current-dist (> (+ dist current-dist) target-size))) - (cond - [(and at-start? (soft-break? q) (nonprinting-at-start? q)) - (debug-report q 'skipping-soft-break-at-beginning) - (values wraps - next-wrap-head - next-wrap-tail - current-dist - other-qs)] - [at-start? - (debug-report 'hard-quad-at-start) - (values wraps - next-wrap-head - (list q) - (distance q) - other-qs)] - [(and would-overflow? (soft-break? q) (nonprinting-at-end? q)) - (debug-report 'would-overflow-soft-nonprinting) - ;; a break is inevitable but we want to wait to finish the wrap until we see a hard quad - ;; but we can move the current-partial into the current-wrap - (values wraps - (wrap-append (cons q next-wrap-tail) next-wrap-head) - null - (+ dist current-dist) - other-qs)] - [(and would-overflow? (empty? next-wrap-head)) - (debug-report 'would-overflow-hard-without-captured-break) - (values (cons next-wrap-tail wraps) - null - null - #false - qs)] - [would-overflow? ; finish the wrap & reset the line without consuming a quad - (values (cons next-wrap-head wraps) - null - next-wrap-tail - (apply + (map distance next-wrap-tail)) - qs)] - [(soft-break? q) ; printing soft break, like a hyphen - (debug-report 'would-not-overflow-soft) - ;; a soft break that fits, so move it on top of the next-wrap-head with the next-wrap-tail - (values wraps - (wrap-append (cons q next-wrap-tail) next-wrap-head) - null - (+ dist current-dist) - other-qs)] - [else - (debug-report 'would-not-overflow) - ;; add to partial - (values wraps - next-wrap-head - (cons q next-wrap-tail) - (+ dist current-dist) - other-qs)]))) + [qs qs]) ; list of quads + (match qs + [(== empty) (define last-wrap (wrap-append #false (wrap-append next-wrap-tail next-wrap-head))) + (for/list ([wrap (in-list (cons last-wrap wraps))]) + ;; pieces will have been accumulated in reverse order + ;; thus beginning of list represents the end of the wrap + (match wrap + [(list (and (? soft-break?) (? nonprinting-at-end?)) ... rest ...) + (finish-wrap-proc (reverse rest))]))] + [(cons q other-qs) + (debug-report q 'next-q) + (debug-report (quad-elems q) 'next-q-elems) + (define at-start? (not current-dist)) + (define dist (if (and (quad? q) (printable? q)) (distance q) 0)) + (define would-overflow? (and current-dist (> (+ dist current-dist) target-size))) + (cond + [at-start? + (cond + [(and (soft-break? q) (nonprinting-at-start? q)) + (debug-report q 'skipping-soft-break-at-beginning) + (loop wraps + next-wrap-head + next-wrap-tail + current-dist + other-qs)] + [else (debug-report 'hard-quad-at-start) + (loop wraps + next-wrap-head + (list q) + (distance q) + other-qs)])] + [would-overflow? + (cond + [(and (soft-break? q) (nonprinting-at-end? q)) + (debug-report 'would-overflow-soft-nonprinting) + ;; a break is inevitable but we want to wait to finish the wrap until we see a hard quad + ;; but we can move the current-partial into the current-wrap + (loop wraps + (wrap-append (cons q next-wrap-tail) next-wrap-head) + null + (+ dist current-dist) + other-qs)] + [(empty? next-wrap-head) + (debug-report 'would-overflow-hard-without-captured-break) + (loop (cons next-wrap-tail wraps) + null + null + #false + qs)] + [else ; finish the wrap & reset the line without consuming a quad + (loop (cons next-wrap-head wraps) + null + next-wrap-tail + (apply + (map distance next-wrap-tail)) + qs)])] + [(soft-break? q) ; printing soft break, like a hyphen + (debug-report 'would-not-overflow-soft) + ;; a soft break that fits, so move it on top of the next-wrap-head with the next-wrap-tail + (loop wraps + (wrap-append (cons q next-wrap-tail) next-wrap-head) + null + (+ dist current-dist) + other-qs)] + [else + (debug-report 'would-not-overflow) + ;; add to partial + (loop wraps + next-wrap-head + (cons q next-wrap-tail) + (+ dist current-dist) + other-qs)])]))) (define q-zero (q #:size (pt 0 0)))