From a145800a6fe3ddac8e5f05c8405606b3c02bbe23 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 7 Jan 2019 14:28:58 -0800 Subject: [PATCH] lose it --- quad/quad/break.rkt | 99 ++++++++++++++++-------------------------- quad/quad/position.rkt | 5 +++ 2 files changed, 42 insertions(+), 62 deletions(-) diff --git a/quad/quad/break.rkt b/quad/quad/break.rkt index 85704809..fc811f87 100644 --- a/quad/quad/break.rkt +++ b/quad/quad/break.rkt @@ -1,19 +1,13 @@ #lang debug racket (require racket/list racket/match sugar/debug - "param.rkt" "quad.rkt" "position.rkt") + "param.rkt" "quad.rkt" "atomize.rkt" "position.rkt") +(provide break) (define-syntax (debug-report stx) (syntax-case stx () [(_ EXPR ...) (with-syntax ([debug (datum->syntax stx 'debug)]) #'(when debug (report EXPR ...)))])) -(define (distance q) - (match (pt- (out-point q) (in-point q)) - [(list (? zero?) ∆y) ∆y] - [(list ∆x (? zero?)) ∆x] - [(list ∆x ∆y) (sqrt (+ (* ∆x ∆x) (* ∆y ∆y)))])) - -(provide break) (define (break xs [target-size (current-wrap-distance)] [debug #f] @@ -26,34 +20,19 @@ #: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 - hard-break? - soft-break? - finish-wrap-proc)) + (break-hards xs target-size debug hard-break? soft-break? finish-wrap-proc)) ;; the hard breaks are used to divide the wrap territory into smaller chunks ;; that can be cached, parallelized, etc. -(define (break-hards xs - target-size - debug - hard-break? - soft-break? - finish-wrap-proc) - (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 (break-hards qs target-size debug hard-break? soft-break? finish-wrap-proc) + (let loop ([wraps null][qs qs]) + (match qs + [(? null?) (append* (reverse wraps))] + [(or (cons (? hard-break?) rest) rest) + (define-values (head tail) (splitf-at rest (λ (x) (not (hard-break? x))))) + ;; head will be empty (intentionally) if qs starts with two hard breaks + (define next-wrap (break-softs head target-size debug soft-break? finish-wrap-proc)) + (loop (cons next-wrap wraps) tail)]))) (define (nonprinting-at-start? x) (not (printable? x 'start))) @@ -63,10 +42,9 @@ (and (not (printable? x)) (soft-break? x))) (define (wrap-append partial wrap) - (match/values - (values partial wrap) - [((== empty) _) wrap] - [(partial (list (? nonprinting-in-middle-soft-break?) ... rest ...)) (append (or partial null) rest)])) + ;; pieces will have been accumulated in reverse order + ;; thus beginning of list represents the end of the wrap + (append partial (dropf wrap nonprinting-in-middle-soft-break?))) (define (break-softs qs target-size @@ -79,13 +57,10 @@ [current-dist #false] ; #false (to indicate start) or integer [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))]))] + [(== empty) (define last-wrap (wrap-append next-wrap-tail next-wrap-head)) + (append* (reverse + (for/list ([wrap-qs (in-list (cons last-wrap wraps))]) + (finish-wrap-proc (reverse (dropf wrap-qs nonprinting-at-end?))))))] [(cons q other-qs) (debug-report q 'next-q) (debug-report (quad-elems q) 'next-q-elems) @@ -94,23 +69,23 @@ (define would-overflow? (and current-dist (> (+ dist current-dist) target-size))) (cond [at-start? - (cond - [(and (soft-break? q) (nonprinting-at-start? q)) + (match q + [(and (? soft-break?) (? nonprinting-at-start?)) (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)])] + [_ (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)) + (match q + [(and (? soft-break?) (? nonprinting-at-end?)) (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 @@ -119,14 +94,14 @@ 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 + [_ #:when (empty? next-wrap-head) + (debug-report 'would-overflow-hard-without-captured-break) + (loop (cons next-wrap-tail wraps) + null + null + #false + qs)] + [_ ; finish the wrap & reset the line without consuming a quad (loop (cons next-wrap-head wraps) null next-wrap-tail diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index f8a6f299..9c3a10fc 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -81,6 +81,11 @@ (loop (out-point new-q) (cons new-q acc) rest)] [(cons x rest) (loop pt (cons x acc) rest)])))) +(define (distance q) + (match (pt- (out-point q) (in-point q)) + [(list-no-order 0 val) val] + [(list ∆x ∆y) (sqrt (+ (expt ∆x 2) (expt ∆y 2)))])) + (module+ test (require rackunit) (test-case