|
|
|
@ -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)))
|
|
|
|
|