|
|
|
|
@ -18,6 +18,16 @@
|
|
|
|
|
;; drop any soft breaks that wouldn't print (e.g., unused soft hyphens)
|
|
|
|
|
(append partial (dropf wrap nonprinting-soft-break-in-middle?)))
|
|
|
|
|
|
|
|
|
|
(define (default-finish-wrap-func wrap-qs q0 q idx) (list wrap-qs))
|
|
|
|
|
(define ((make-finish-wrap finish-wrap-func) qs previous-wrap-ender wrap-idx [wrap-triggering-q (car qs)])
|
|
|
|
|
;; reverse because quads accumulated in reverse
|
|
|
|
|
;; wrap-triggering-q is ordinarily the last accumulated q
|
|
|
|
|
;; unless it's the last wrap, in which case it's #f
|
|
|
|
|
;; but we capture it separately because it's likely to get trimmed away by `nonprinting-at-end?`
|
|
|
|
|
;; note: we don't trim `soft-break?` or `hard-break?` because that's an orthogonal consideration
|
|
|
|
|
;; for instance, a hyphen is `soft-break?` but shouldn't be trimmed.
|
|
|
|
|
(finish-wrap-func (reverse (dropf qs nonprinting-at-end?)) previous-wrap-ender wrap-triggering-q wrap-idx))
|
|
|
|
|
|
|
|
|
|
(define (wrap qs
|
|
|
|
|
[target-size-proc-arg (current-wrap-distance)]
|
|
|
|
|
[debug #f]
|
|
|
|
|
@ -34,7 +44,7 @@
|
|
|
|
|
(+ last-dist (if (printable? q) (distance q) 0)))]
|
|
|
|
|
;; called when wrap counter increments.
|
|
|
|
|
;; perhaps should reset after paragraph breaks, etc.
|
|
|
|
|
#:wrap-count [wrap-count (λ (idx q) (add1 idx))]
|
|
|
|
|
#:wrap-count [wrap-count (λ (idx wrap-triggering-q) (add1 idx))]
|
|
|
|
|
;; starting value when wrap counter resets.
|
|
|
|
|
;; could use an arbitrary data structure (then incremented with `wrap-count`
|
|
|
|
|
#:initial-wrap-count [initial-wrap-idx 1]
|
|
|
|
|
@ -44,21 +54,14 @@
|
|
|
|
|
;; q that caused this one, or #f at end.
|
|
|
|
|
;; (q0 is not part of this wrap, but q is)
|
|
|
|
|
;; idx is current wrap-count value.
|
|
|
|
|
#:finish-wrap [finish-wrap-func (λ (wrap-qs q0 q idx) (list wrap-qs))])
|
|
|
|
|
#:finish-wrap [finish-wrap-func default-finish-wrap-func])
|
|
|
|
|
(define (hard-break? x) (and (hard-break-func x) (or (not no-break-func) (not (no-break-func x)))))
|
|
|
|
|
(define (soft-break? x) (and (soft-break-func x) (or (not no-break-func) (not (no-break-func x)))))
|
|
|
|
|
(define target-size-proc (match target-size-proc-arg
|
|
|
|
|
[(? procedure? proc) proc]
|
|
|
|
|
[val (λ (q idx) val)]))
|
|
|
|
|
; takes quads in wrap, triggering quad, and wrap idx; returns list containing wrap (and maybe other things)
|
|
|
|
|
(define (finish-wrap qs previous-wrap-ender wrap-idx [wrap-triggering-q (car qs)])
|
|
|
|
|
;; reverse because quads accumulated in reverse
|
|
|
|
|
;; wrap-triggering-q is ordinarily the last accumulated q
|
|
|
|
|
;; unless it's the last wrap, in which case it's #f
|
|
|
|
|
;; but we capture it separately because it's likely to get trimmed away by `nonprinting-at-end?`
|
|
|
|
|
;; note: we don't trim `soft-break?` or `hard-break?` because that's an orthogonal consideration
|
|
|
|
|
;; for instance, a hyphen is `soft-break?` but shouldn't be trimmed.
|
|
|
|
|
(finish-wrap-func (reverse (dropf qs nonprinting-at-end?)) previous-wrap-ender wrap-triggering-q wrap-idx))
|
|
|
|
|
(define finish-wrap (make-finish-wrap finish-wrap-func))
|
|
|
|
|
(let loop ([wraps null] ; list of (list of quads)
|
|
|
|
|
[wrap-idx initial-wrap-idx] ; wrap count (could be (length wraps) but we'd rather avoid `length`)
|
|
|
|
|
[next-wrap-head null] ; list of quads ending in previous `soft-break?` or `hard-break?`
|
|
|
|
|
@ -201,24 +204,43 @@
|
|
|
|
|
;; q that caused this one, or #f at end.
|
|
|
|
|
;; (q0 is not part of this wrap, but q is)
|
|
|
|
|
;; idx is current wrap-count value.
|
|
|
|
|
#:finish-wrap [finish-wrap-func (λ (wrap-qs q0 q idx) (list wrap-qs))])
|
|
|
|
|
|
|
|
|
|
#:finish-wrap [finish-wrap-func default-finish-wrap-func])
|
|
|
|
|
(define (hard-break? x) (and (hard-break-func x) (or (not no-break-func) (not (no-break-func x)))))
|
|
|
|
|
(define (soft-break? x) (and (soft-break-func x) (or (not no-break-func) (not (no-break-func x)))))
|
|
|
|
|
(define finish-wrap (make-finish-wrap finish-wrap-func))
|
|
|
|
|
|
|
|
|
|
(define measure target-size-proc-arg)
|
|
|
|
|
(struct $penalty (val idx) #:transparent)
|
|
|
|
|
(define (penalty i j)
|
|
|
|
|
(define line-width (- j i))
|
|
|
|
|
(define underflow (- measure line-width))
|
|
|
|
|
(+ (ocm-min-value ocm i) ; include penalty so far
|
|
|
|
|
(if (negative? underflow)
|
|
|
|
|
;; overfull line: huge penalty prevents break; multiplier is essential for monotonicity.
|
|
|
|
|
(* underflow -1e8)
|
|
|
|
|
;; standard penalty, optionally also applied to last line (by changing operator)
|
|
|
|
|
(expt underflow 2))))
|
|
|
|
|
|
|
|
|
|
(define ocm (make-ocm penalty))
|
|
|
|
|
(match-define ($penalty last-val last-idx) (ocm-min-value ocm i))
|
|
|
|
|
(cond
|
|
|
|
|
[(> j (vector-length pieces)) ($penalty (- i) last-idx)]
|
|
|
|
|
[else
|
|
|
|
|
(define first-q (vector-ref pieces i))
|
|
|
|
|
(define last-q (vector-ref pieces (sub1 j)))
|
|
|
|
|
(define this-idx (wrap-count last-idx last-q))
|
|
|
|
|
(cond
|
|
|
|
|
[(hard-break? last-q) ($penalty 0 this-idx)]
|
|
|
|
|
[(soft-break? last-q)
|
|
|
|
|
#R (pieces-sublist i j)
|
|
|
|
|
(define line-width (- j i))
|
|
|
|
|
(define underflow (- measure line-width))
|
|
|
|
|
($penalty
|
|
|
|
|
(+ last-val ; include penalty so far
|
|
|
|
|
(if (negative? underflow)
|
|
|
|
|
;; overfull line: huge penalty prevents break; multiplier is essential for monotonicity.
|
|
|
|
|
(* 1e8 (- underflow))
|
|
|
|
|
;; standard penalty
|
|
|
|
|
(expt underflow 2)))
|
|
|
|
|
this-idx)]
|
|
|
|
|
[else ($penalty last-val last-idx)])]))
|
|
|
|
|
|
|
|
|
|
(define ocm (make-ocm penalty ($penalty 0 (sub1 initial-wrap-idx)) $penalty-val))
|
|
|
|
|
;; starting from last position, ask ocm for position of row minimum (= new-pos)
|
|
|
|
|
;; collect this value, and use it as the input next time
|
|
|
|
|
;; until you reach first position.
|
|
|
|
|
(define pieces (list->vector qs))
|
|
|
|
|
(define (pieces-sublist i j) (vector->list (vector-copy pieces i j)))
|
|
|
|
|
(define last-j (vector-length pieces))
|
|
|
|
|
(define bps
|
|
|
|
|
(let loop ([j last-j][bps (list last-j)]) ; start from end
|
|
|
|
|
@ -226,9 +248,16 @@
|
|
|
|
|
(if (zero? i) ; zero means we're at first position, and therefore done
|
|
|
|
|
(cons i bps)
|
|
|
|
|
(loop i (cons i bps)))))
|
|
|
|
|
(for/list ([i (in-list bps)]
|
|
|
|
|
(for/fold ([wraps null]
|
|
|
|
|
[wrap-idx initial-wrap-idx]
|
|
|
|
|
#:result (reverse wraps))
|
|
|
|
|
([i (in-list bps)]
|
|
|
|
|
[j (in-list (cdr bps))])
|
|
|
|
|
(vector->list (vector-copy pieces i j))))
|
|
|
|
|
(define wrap-qs (reverse (pieces-sublist i j))) ; first-fit gets wrap-qs in reverse, so be consistent
|
|
|
|
|
(define previous-wrap-ender (and (positive? i) (vector-ref pieces (sub1 i))))
|
|
|
|
|
(define wrap-triggering-q (and (not (= j (vector-length pieces))) (car wrap-qs)))
|
|
|
|
|
(values (cons (finish-wrap wrap-qs previous-wrap-ender wrap-idx wrap-triggering-q) wraps)
|
|
|
|
|
(wrap-count wrap-idx (car wrap-qs)))))
|
|
|
|
|
|
|
|
|
|
(define q-zero (q #:size (pt 0 0)))
|
|
|
|
|
(define q-one (q #:size (pt 1 1) #:printable #t))
|
|
|
|
|
@ -276,101 +305,6 @@
|
|
|
|
|
(module+ test
|
|
|
|
|
(require rackunit))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"chars"
|
|
|
|
|
(check-equal? (linewrap (list) 1) (list))
|
|
|
|
|
(check-equal? (linewrap (list a) 1) (list (list a)))
|
|
|
|
|
(check-equal? (linewrap (list a b) 1) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a b c) 1) (list (list a) lbr (list b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list a b c) 2) (list (list a b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 2) (list (list x x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 3) (list (list x x x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 1)
|
|
|
|
|
(list (list x) lbr (list x) lbr (list x) lbr (list x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 10) (list (list x x x x x)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"chars and spaces"
|
|
|
|
|
(check-equal? (linewrap (list a sp b) 1) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a b sp c) 2) (list (list a b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list a sp b) 3) (list (list a sp b)))
|
|
|
|
|
(check-equal? (linewrap (list a sp b c) 3) (list (list a) lbr (list b c)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"leading & trailing spaces"
|
|
|
|
|
(check-equal? (linewrap (list sp x) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x sp) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list sp x sp) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x sp sp) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list (list x) lbr (list x)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard hyphens"
|
|
|
|
|
(check-equal? (linewrap (list hyph) 1) (list (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list hyph hyph) 1) (list (list hyph) lbr (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list hyph hyph) 2) (list (list hyph hyph)))
|
|
|
|
|
(check-equal? (linewrap (list hyph hyph hyph) 2) (list (list hyph hyph) lbr (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list x hyph) 1) (list (list x) lbr (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list a b hyph c d) 1)
|
|
|
|
|
(list (list a) lbr (list b) lbr (list hyph) lbr (list c) lbr (list d)))
|
|
|
|
|
(check-equal? (linewrap (list a b hyph c d) 2) (list (list a b) lbr (list hyph c) lbr (list d)))
|
|
|
|
|
(check-equal? (linewrap (list a b hyph c d) 3) (list (list a b hyph) lbr (list c d)))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 4) (list (list x x hyph) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 5) (list (list x x hyph x x)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"soft hyphens"
|
|
|
|
|
(check-equal? (linewrap (list shy) 1) (list))
|
|
|
|
|
(check-equal? (linewrap (list shy shy) 2) (list))
|
|
|
|
|
(check-equal? (linewrap (list shy shy shy) 2) (list))
|
|
|
|
|
(check-equal? (linewrap (list x shy) 1) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x shy shy shy shy) 1) (list (list x)))
|
|
|
|
|
;; todo: degenerate cases that don't work without continuations
|
|
|
|
|
;(check-equal? (linewrap (list x x shy x x) 1) (list x br x br x br x))
|
|
|
|
|
;(check-equal? (linewrap (list x x shy x x) 2) (list x x br x x))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 3) (list (list x x shy) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 4) (list (list x x x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 5) (list (list x x x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x sp x) 4) (list (list x x x) lbr (list x)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"zero width nonbreakers"
|
|
|
|
|
(check-equal? (linewrap (list sp zwx) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list zwx sp) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list sp zwx sp) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp zwx sp sp) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list (list zwx sp sp zwx)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks"
|
|
|
|
|
(check-equal? (linewrap (list lbr) 2) (list)) ;; only insert a break if it's between things
|
|
|
|
|
(check-equal? (linewrap (list a lbr b) 2) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a b lbr) 2) (list (list a b)))
|
|
|
|
|
(check-equal? (linewrap (list a b lbr lbr) 2) (list (list a b) lbr (list)))
|
|
|
|
|
(check-equal? (linewrap (list x lbr x x) 3) (list (list x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x lbr x) 3) (list (list x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 3) (list (list x x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 2) (list (list x x) lbr (list x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 3) (list (list x x x) lbr (list x x)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks and spurious spaces"
|
|
|
|
|
(check-equal? (linewrap (list a sp sp sp lbr b) 2) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a sp lbr sp sp b c sp) 3) (list (list a) lbr (list b c)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x x sp sp lbr sp sp sp x) 3) (list (list x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list a sp b sp sp lbr sp c) 3) (list (list a sp b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 3) (list (list x x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 2) (list (list x x) lbr (list x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 3) (list (list x x x) lbr (list x x)))))
|
|
|
|
|
|
|
|
|
|
(define (visual-wrap str int [debug #f] #:wrapper [wrap-proc wrap])
|
|
|
|
|
(string-join
|
|
|
|
|
(for/list ([x (in-list (linewrap (for/list ([c (in-string str)])
|
|
|
|
|
@ -385,32 +319,6 @@
|
|
|
|
|
(list->string (map car (map quad-elems x))))
|
|
|
|
|
"|"))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"kp linebreaking"
|
|
|
|
|
(check-equal? (visual-wrap "Meg is an ally." 6) "Meg is|an|ally.")
|
|
|
|
|
(check-equal? (visual-wrap "Meg is an ally." 6 #:wrapper wrap-best) "Meg i|s an |ally.")))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"visual breaks"
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 1) "M|y|d|o|g|h|a|s|f|l|e|a|s")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 2) "My|do|g|ha|s|fl|ea|s")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 3) "My|dog|has|fle|as")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 4) "My|dog|has|flea|s")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 5) "My|dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 6) "My dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 7) "My dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 8) "My dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 9) "My dog|has fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 10) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 11) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 12) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 13) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 14) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 15) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 16) "My dog has fleas")))
|
|
|
|
|
|
|
|
|
|
(define (pagewrap xs size [debug #f])
|
|
|
|
|
(add-between
|
|
|
|
|
(wrap (flatten xs) size debug
|
|
|
|
|
@ -420,37 +328,6 @@
|
|
|
|
|
#:printable #false
|
|
|
|
|
#:elems '(#\page)))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(require rackunit)
|
|
|
|
|
(test-case
|
|
|
|
|
"soft page breaks"
|
|
|
|
|
(check-equal? (pagewrap null 2) (list))
|
|
|
|
|
(check-equal? (pagewrap (list x) 2) (list (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x) 2) (list (list x x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 1) (list (list x) pbr (list x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 2) (list (list x x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 3) (list (list x x x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 4) (list (list x x x)))
|
|
|
|
|
(check-equal? (pagewrap (list x lbr x x) 2) (list (list x) pbr (list x x)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard page breaks"
|
|
|
|
|
(check-equal? (pagewrap (list a pbr b c) 2) (list (list a) pbr (list b c)))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr x x) 1) (list (list x) pbr (list x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr pbr x x) 1) (list (list x) pbr (list) pbr (list x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr pbr x x) 2) (list (list x) pbr (list) pbr (list x x)))
|
|
|
|
|
(check-equal? (pagewrap (list lbr x lbr lbr pbr lbr x x lbr) 2) (list (list x) pbr (list x x)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"composed line breaks and page breaks"
|
|
|
|
|
(check-equal? (pagewrap (linewrap null 1) 2) (list))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x) 1) 2) (list (list x)))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x x x) 1) 2) (list (list x lbr x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x x x) 2) 2) (list (list x x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x x x) 2) 1) (list (list x) pbr (list x) pbr (list x)))))
|
|
|
|
|
|
|
|
|
|
(define (linewrap2 xs size [debug #f])
|
|
|
|
|
(add-between
|
|
|
|
|
(wrap xs size debug
|
|
|
|
|
@ -459,14 +336,150 @@
|
|
|
|
|
#:finish-wrap (λ (pcs . _) (list (apply q pcs))))
|
|
|
|
|
lbr))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks and spurious spaces with slugs"
|
|
|
|
|
(check-equal? (linewrap2 (list a sp sp sp lbr b) 2) (list (q a) lbr (q b)))
|
|
|
|
|
(check-equal? (linewrap2 (list x sp lbr sp sp x x sp) 3) (list (q x) lbr (q x x)))
|
|
|
|
|
(check-equal? (linewrap2 (list sp sp x x sp sp lbr sp sp sp x) 3) (list (q x x) lbr (q x)))
|
|
|
|
|
(check-equal? (linewrap2 (list a sp b sp sp lbr sp c) 3) (list (q a sp b) lbr (q c)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x x) 3) (list (q x x x) lbr (q x)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x sp x x) 2) (list (q x x) lbr (q x) lbr (q x x)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x sp x x) 3) (list (q x x x) lbr (q x x)))))
|
|
|
|
|
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-begin
|
|
|
|
|
(test-case
|
|
|
|
|
"chars"
|
|
|
|
|
(check-equal? (linewrap (list) 1) (list))
|
|
|
|
|
(check-equal? (linewrap (list a) 1) (list (list a)))
|
|
|
|
|
(check-equal? (linewrap (list a b) 1) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a b c) 1) (list (list a) lbr (list b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list a b c) 2) (list (list a b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 2) (list (list x x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 3) (list (list x x x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 1)
|
|
|
|
|
(list (list x) lbr (list x) lbr (list x) lbr (list x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 10) (list (list x x x x x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"chars and spaces"
|
|
|
|
|
(check-equal? (linewrap (list a sp b) 1) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a b sp c) 2) (list (list a b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list a sp b) 3) (list (list a sp b)))
|
|
|
|
|
(check-equal? (linewrap (list a sp b c) 3) (list (list a) lbr (list b c))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"leading & trailing spaces"
|
|
|
|
|
(check-equal? (linewrap (list sp x) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x sp) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list sp x sp) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x sp sp) 2) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list (list x) lbr (list x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"hard hyphens"
|
|
|
|
|
(check-equal? (linewrap (list hyph) 1) (list (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list hyph hyph) 1) (list (list hyph) lbr (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list hyph hyph) 2) (list (list hyph hyph)))
|
|
|
|
|
(check-equal? (linewrap (list hyph hyph hyph) 2) (list (list hyph hyph) lbr (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list x hyph) 1) (list (list x) lbr (list hyph)))
|
|
|
|
|
(check-equal? (linewrap (list a b hyph c d) 1)
|
|
|
|
|
(list (list a) lbr (list b) lbr (list hyph) lbr (list c) lbr (list d)))
|
|
|
|
|
(check-equal? (linewrap (list a b hyph c d) 2) (list (list a b) lbr (list hyph c) lbr (list d)))
|
|
|
|
|
(check-equal? (linewrap (list a b hyph c d) 3) (list (list a b hyph) lbr (list c d)))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 4) (list (list x x hyph) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 5) (list (list x x hyph x x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"soft hyphens"
|
|
|
|
|
(check-equal? (linewrap (list shy) 1) (list))
|
|
|
|
|
(check-equal? (linewrap (list shy shy) 2) (list))
|
|
|
|
|
(check-equal? (linewrap (list shy shy shy) 2) (list))
|
|
|
|
|
(check-equal? (linewrap (list x shy) 1) (list (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x shy shy shy shy) 1) (list (list x)))
|
|
|
|
|
;; todo: degenerate cases that don't work without continuations
|
|
|
|
|
;(check-equal? (linewrap (list x x shy x x) 1) (list x br x br x br x))
|
|
|
|
|
;(check-equal? (linewrap (list x x shy x x) 2) (list x x br x x))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 3) (list (list x x shy) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 4) (list (list x x x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 5) (list (list x x x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x sp x) 4) (list (list x x x) lbr (list x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"zero width nonbreakers"
|
|
|
|
|
(check-equal? (linewrap (list sp zwx) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list zwx sp) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list sp zwx sp) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp zwx sp sp) 2) (list (list zwx)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list (list zwx sp sp zwx))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks"
|
|
|
|
|
(check-equal? (linewrap (list lbr) 2) (list)) ;; only insert a break if it's between things
|
|
|
|
|
(check-equal? (linewrap (list a lbr b) 2) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a b lbr) 2) (list (list a b)))
|
|
|
|
|
(check-equal? (linewrap (list a b lbr lbr) 2) (list (list a b) lbr (list)))
|
|
|
|
|
(check-equal? (linewrap (list x lbr x x) 3) (list (list x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x lbr x) 3) (list (list x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 3) (list (list x x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 2) (list (list x x) lbr (list x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 3) (list (list x x x) lbr (list x x))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks and spurious spaces"
|
|
|
|
|
(check-equal? (linewrap (list a sp sp sp lbr b) 2) (list (list a) lbr (list b)))
|
|
|
|
|
(check-equal? (linewrap (list a sp lbr sp sp b c sp) 3) (list (list a) lbr (list b c)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x x sp sp lbr sp sp sp x) 3) (list (list x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list a sp b sp sp lbr sp c) 3) (list (list a sp b) lbr (list c)))
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 3) (list (list x x x) lbr (list x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 2) (list (list x x) lbr (list x) lbr (list x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 3) (list (list x x x) lbr (list x x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"visual breaks"
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 1) "M|y|d|o|g|h|a|s|f|l|e|a|s")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 2) "My|do|g|ha|s|fl|ea|s")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 3) "My|dog|has|fle|as")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 4) "My|dog|has|flea|s")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 5) "My|dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 6) "My dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 7) "My dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 8) "My dog|has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 9) "My dog|has fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 10) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 11) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 12) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 13) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 14) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 15) "My dog has|fleas")
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 16) "My dog has fleas"))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"soft page breaks"
|
|
|
|
|
(check-equal? (pagewrap null 2) (list))
|
|
|
|
|
(check-equal? (pagewrap (list x) 2) (list (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x) 2) (list (list x x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 1) (list (list x) pbr (list x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 2) (list (list x x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 3) (list (list x x x)))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 4) (list (list x x x)))
|
|
|
|
|
(check-equal? (pagewrap (list x lbr x x) 2) (list (list x) pbr (list x x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"hard page breaks"
|
|
|
|
|
(check-equal? (pagewrap (list a pbr b c) 2) (list (list a) pbr (list b c)))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr x x) 1) (list (list x) pbr (list x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr pbr x x) 1) (list (list x) pbr (list) pbr (list x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr pbr x x) 2) (list (list x) pbr (list) pbr (list x x)))
|
|
|
|
|
(check-equal? (pagewrap (list lbr x lbr lbr pbr lbr x x lbr) 2) (list (list x) pbr (list x x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"composed line breaks and page breaks"
|
|
|
|
|
(check-equal? (pagewrap (linewrap null 1) 2) (list))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x) 1) 2) (list (list x)))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x x x) 1) 2) (list (list x lbr x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x x x) 2) 2) (list (list x x) pbr (list x)))
|
|
|
|
|
(check-equal? (pagewrap (linewrap (list x x x) 2) 1) (list (list x) pbr (list x) pbr (list x))))
|
|
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks and spurious spaces with slugs"
|
|
|
|
|
(check-equal? (linewrap2 (list a sp sp sp lbr b) 2) (list (q a) lbr (q b)))
|
|
|
|
|
(check-equal? (linewrap2 (list x sp lbr sp sp x x sp) 3) (list (q x) lbr (q x x)))
|
|
|
|
|
(check-equal? (linewrap2 (list sp sp x x sp sp lbr sp sp sp x) 3) (list (q x x) lbr (q x)))
|
|
|
|
|
(check-equal? (linewrap2 (list a sp b sp sp lbr sp c) 3) (list (q a sp b) lbr (q c)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x x) 3) (list (q x x x) lbr (q x)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x sp x x) 2) (list (q x x) lbr (q x) lbr (q x x)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x sp x x) 3) (list (q x x x) lbr (q x x))))))
|
|
|
|
|
|
|
|
|
|
|
