|
|
|
@ -33,7 +33,7 @@
|
|
|
|
|
#:hard-break-proc procedure?
|
|
|
|
|
#:soft-break-proc procedure?
|
|
|
|
|
#:finish-wrap-proc procedure?) . ->* . (listof any/c))
|
|
|
|
|
(break-private xs
|
|
|
|
|
(break-hards xs
|
|
|
|
|
target-size
|
|
|
|
|
debug
|
|
|
|
|
break-val
|
|
|
|
@ -45,7 +45,7 @@
|
|
|
|
|
|
|
|
|
|
;; the hard breaks are used to divide the wrap territory into smaller chunks
|
|
|
|
|
;; that can be cached, parallelized, etc.
|
|
|
|
|
(define (break-private xs
|
|
|
|
|
(define (break-hards xs
|
|
|
|
|
target-size
|
|
|
|
|
debug
|
|
|
|
|
break-val
|
|
|
|
@ -54,28 +54,29 @@
|
|
|
|
|
hard-break?
|
|
|
|
|
soft-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 break-val=? (if (symbol? break-val) eq? equal?))
|
|
|
|
|
(define (cleanup-wraplist xs)
|
|
|
|
|
(dropf-right (append* (reverse xs)) (λ (x) (break-val=? break-val x))))
|
|
|
|
|
(define wraps
|
|
|
|
|
(for/fold ([wraps null]
|
|
|
|
|
[xs (dropf xs hard-break?)]
|
|
|
|
|
#:result (map touch wraps))
|
|
|
|
|
[xs xs]
|
|
|
|
|
#:result wraps)
|
|
|
|
|
([i (in-naturals)]
|
|
|
|
|
#:break (null? xs))
|
|
|
|
|
(cond
|
|
|
|
|
[(hard-break? (car xs))
|
|
|
|
|
(match xs
|
|
|
|
|
[(cons (? hard-break?) rest)
|
|
|
|
|
(when debug (report x 'hard-break))
|
|
|
|
|
(values (cons (future (λ () (list break-val))) wraps) (cdr xs))]
|
|
|
|
|
[else
|
|
|
|
|
(define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
|
|
|
|
|
(values (cons (future (λ () (cleanup-wraplist (break-softs head
|
|
|
|
|
(values (cons (list break-val) wraps) rest)]
|
|
|
|
|
[_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
|
|
|
|
|
(values (cons (cleanup-wraplist (break-softs head
|
|
|
|
|
target-size
|
|
|
|
|
debug
|
|
|
|
|
break-val
|
|
|
|
|
soft-break?
|
|
|
|
|
finish-wrap-proc)))) wraps) tail)])))
|
|
|
|
|
(append (if break-before? (list break-val) empty) (cleanup-wraplist wraps) (if break-after? (list break-val) empty)))
|
|
|
|
|
|
|
|
|
|
finish-wrap-proc)) wraps) tail)])))
|
|
|
|
|
(append (if break-before? (list break-val) empty)
|
|
|
|
|
(cleanup-wraplist wraps)
|
|
|
|
|
(if break-after? (list break-val) empty)))
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
@ -90,24 +91,20 @@
|
|
|
|
|
(define (capture-soft-break-k!)
|
|
|
|
|
(when debug (report 'capturing-break))
|
|
|
|
|
(let/cc k (set! last-soft-break-k k) #f))
|
|
|
|
|
(call/prompt ;; continuation boundary for last-soft-break-k
|
|
|
|
|
(thunk
|
|
|
|
|
(let loop ([wraps null][wrap-pieces null][dist-so-far start-signal][xs xs])
|
|
|
|
|
(cond
|
|
|
|
|
[(null? xs)
|
|
|
|
|
(match xs
|
|
|
|
|
[(== empty)
|
|
|
|
|
;; combine the segments into a flat list, and drop any trailing breaks
|
|
|
|
|
;; (on the idea that breaks should separate things, and there's nothing left to separate)
|
|
|
|
|
;; wraps alternate with breaks
|
|
|
|
|
(for/list ([pcs (in-list (cons wrap-pieces wraps))]
|
|
|
|
|
[proc (in-cycle (list
|
|
|
|
|
(for/list ([pcs (in-list (cons wrap-pieces wraps))])
|
|
|
|
|
(match pcs
|
|
|
|
|
[(list (? nonprinting-at-end?)) pcs] ; matches break signals
|
|
|
|
|
;; pieces will have been accumulated in reverse order
|
|
|
|
|
;; dropf drops from beginning of list (representing the end of the wrap)
|
|
|
|
|
|
|
|
|
|
(λ (pcs) (finish-wrap-proc (reverse (dropf pcs (λ (x) (and (soft-break? x) (nonprinting-at-end? x)))))))
|
|
|
|
|
values))])
|
|
|
|
|
(proc pcs))]
|
|
|
|
|
[else
|
|
|
|
|
(define x (car xs))
|
|
|
|
|
;; thus beginning of list represents the end of the wrap
|
|
|
|
|
[(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
|
|
|
|
|
(finish-wrap-proc (reverse rest))]))]
|
|
|
|
|
[(cons x _)
|
|
|
|
|
(define at-start? (eq? dist-so-far start-signal))
|
|
|
|
|
(define underflow? (and (not at-start?) (<= (+ dist-so-far (if (and (quad? x) (printable? x 'end)) (distance x) 0)) target-size)))
|
|
|
|
|
(define (values-for-insert-break [before? #f])
|
|
|
|
@ -168,7 +165,7 @@
|
|
|
|
|
(loop (list* (list break-val) pieces-for-this-wrap wraps)
|
|
|
|
|
null
|
|
|
|
|
start-signal
|
|
|
|
|
next-xs)])])))))
|
|
|
|
|
next-xs)])])))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define x (q (list 'size (pt 1 1)) #\x))
|
|
|
|
|