diff --git a/quad/quad/wrap.rkt b/quad/quad/wrap.rkt index 349415f5..c31068f3 100644 --- a/quad/quad/wrap.rkt +++ b/quad/quad/wrap.rkt @@ -15,6 +15,7 @@ [else 0])) + (define+provide/contract (wrap xs [target-size (current-wrap-distance)] [debug #f] @@ -31,7 +32,29 @@ #:mandatory-break-proc procedure? #:optional-break-proc procedure? #:finish-wrap-proc procedure?) . ->* . (listof any/c)) - (define (cleanup-wraplist wraps) (dropf-right (append* (reverse wraps)) (λ (x) (equal? x break-val)))) + (wrap-mandatory xs + target-size + debug + break-val + break-before? + break-after? + mandatory-break? + optional-break? + finish-wrap-proc)) + +;; the mandatory breaks can be used to divide the wrap territory into smaller chunks +;; that can be cached, parallelized, etc. +(define (wrap-mandatory xs + target-size + debug + break-val + break-before? + break-after? + mandatory-break? + optional-break? + finish-wrap-proc) + (define break-val-equal? (if (symbol? break-val) eq? equal?)) + (define (cleanup-wraplist xs) (dropf-right (append* (reverse xs)) (λ (x) (break-val-equal? break-val x)))) (define wraps (for/fold ([wraps null] [xs (dropf xs mandatory-break?)] @@ -40,6 +63,7 @@ #:break (null? xs)) (cond [(mandatory-break? (car xs)) + (when debug (report x 'mandatory-break)) (values (cons (list break-val) wraps) (cdr xs))] [else (define-values (head tail) (splitf-at xs (λ (x) (not (mandatory-break? x)))))