mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

so wrong

Browse Source
main
Matthew Butterick 6 years ago
parent 54e4b81a43
commit 4188f8d2c8
1 changed files with 39 additions and 28 deletions
Show Stats Download Patch File Download Diff File

67
quad/quad/break.rkt
Unescape Escape View File

@ -87,13 +87,10 @@
soft-break? soft-break?
finish-wrap-proc) finish-wrap-proc)
(define start-signal (gensym)) (define start-signal (gensym))
(define last-soft-break-k #f)
(define (capture-soft-break-k!)
(when debug (report 'capturing-break))
(let/cc k (set! last-soft-break-k k) #f))
(let loop ([wraps null][wrap-pieces null][dist-so-far start-signal][xs xs]) (let loop ([wraps null][wrap-pieces null][dist-so-far start-signal][xs xs])
(match xs (match xs
[(== empty) [(== empty)
(when debug (report x 'end-of-the-line))
;; combine the segments into a flat list, and drop any trailing breaks ;; 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) ;; (on the idea that breaks should separate things, and there's nothing left to separate)
;; wraps alternate with breaks ;; wraps alternate with breaks
@ -105,8 +102,13 @@
[(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...) [(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
(finish-wrap-proc (reverse rest))]))] (finish-wrap-proc (reverse rest))]))]
[(cons x _) [(cons x _)
(when debug (report x 'one-x))
(define at-start? (eq? dist-so-far start-signal)) (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 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]) (define (values-for-insert-break [before? #f])
;; a break can be inserted before or after the current quad. ;; a break can be inserted before or after the current quad.
;; At an ordinary break (hard or soft) it goes after the wrap point. ;; At an ordinary break (hard or soft) it goes after the wrap point.
@ -116,18 +118,19 @@
;; The wrap signal will not consume the quad (rather, it will become the first quad in the next wrap) ;; The wrap signal will not consume the quad (rather, it will become the first quad in the next wrap)
;; (we do this by resetting next-xs to the whole xs list) ;; (we do this by resetting next-xs to the whole xs list)
;; In both cases, the `finish-wrap` proc will strip off any trailing white breaks from the new segment. ;; In both cases, the `finish-wrap` proc will strip off any trailing white breaks from the new segment.
(set! last-soft-break-k #f) ;; prevents continuation loop
(if before? (if before?
(values wrap-pieces xs) (values wrap-pieces xs)
; omit nonprinting quad ; omit nonprinting quad
(values (if (and (quad? x) (nonprinting-at-end? x)) wrap-pieces (cons x wrap-pieces)) (cdr xs)))) (values (if (and (quad? x) (nonprinting-at-end? x))
wrap-pieces
(cons x wrap-pieces)) (cdr xs))))
(cond (cond
[(and at-start? (soft-break? x) (nonprinting-at-start? x)) [(and at-start? (soft-break? x) (nonprinting-at-start? x))
(when debug (report x 'skipping-soft-break-at-beginning)) (when debug (report x 'skipping-soft-break-at-beginning))
;; skip it ;; skip it
(loop wraps null dist-so-far (cdr xs))] (loop wraps null dist-so-far (cdr xs))]
[(and underflow? (soft-break? x) (capture-soft-break-k!)) [(and underflow? (soft-break? x))
(when debug (report x 'resuming-break-from-continuation)) (when debug (report x 'underflow-soft-break))
(define-values (pieces-for-this-wrap next-xs) (values-for-insert-break)) (define-values (pieces-for-this-wrap next-xs) (values-for-insert-break))
(loop (list* (list break-val) pieces-for-this-wrap wraps) (loop (list* (list break-val) pieces-for-this-wrap wraps)
null null
@ -151,11 +154,7 @@
(cdr xs))] (cdr xs))]
;; the previous branch will catch all `underflow?` cases ;; the previous branch will catch all `underflow?` cases
;; therefore, in these last two cases, we have overflow ;; therefore, in these last two cases, we have overflow
[last-soft-break-k ;; overflow implied
;; if we have an soft break stored, we jump back and use it
;; now that we know we need it.
(when debug (report x 'invoking-last-breakpoint))
(last-soft-break-k #t)]
[else ;; overflow implied [else ;; overflow implied
;; if we don't have an soft break stored, we need to just end the wrap and move on ;; if we don't have an soft break stored, we need to just end the wrap and move on
;; we insert the break `before` so that the current quad is moved to the next wrap ;; we insert the break `before` so that the current quad is moved to the next wrap
@ -192,10 +191,14 @@
#:hard-break-proc (λ (q) (and (quad? q) (memv (car (elems q)) '(#\newline)))) #:hard-break-proc (λ (q) (and (quad? q) (memv (car (elems q)) '(#\newline))))
#:soft-break-proc soft-break?)) #:soft-break-proc soft-break?))
(module+ test
(check-equal? (linewrap (list a sp b) 3 #true) (list a sp b)))
(module+ test (module+ test
(require rackunit) (require rackunit))
(module+ test
(test-case (test-case
"chars" "chars"
(check-equal? (linewrap (list) 1) null) (check-equal? (linewrap (list) 1) null)
@ -206,25 +209,27 @@
(check-equal? (linewrap (list x x x x) 2) (list x x 'lb x x)) (check-equal? (linewrap (list x x x x) 2) (list x x 'lb x x))
(check-equal? (linewrap (list x x x x x) 3) (list x x x 'lb x x)) (check-equal? (linewrap (list x x x x x) 3) (list x x x 'lb x x))
(check-equal? (linewrap (list x x x x x) 1) (list x 'lb x 'lb x 'lb x 'lb x)) (check-equal? (linewrap (list x x x x x) 1) (list x 'lb x 'lb x 'lb x 'lb x))
(check-equal? (linewrap (list x x x x x) 10) (list x x x x x))) (check-equal? (linewrap (list x x x x x) 10) (list x x x x x))))
#;(module+ test
(test-case (test-case
"chars and spaces" "chars and spaces"
(check-equal? (linewrap (list x sp x) 1) (list x 'lb x)) (check-equal? (linewrap (list x sp x) 1) (list x 'lb x))
(check-equal? (linewrap (list x x sp x) 2) (list x x 'lb x)) (check-equal? (linewrap (list x x sp x) 2) (list x x 'lb x))
(check-equal? (linewrap (list a sp b) 3) (list a sp b)) (check-equal? (linewrap (list a sp b) 3) (list a sp b))
(check-equal? (linewrap (list x sp x x) 3) (list x 'lb x x))) (check-equal? (linewrap (list x sp x x) 3) (list x 'lb x x))))
(module+ test
(test-case (test-case
"leading & trailing spaces" "leading & trailing spaces"
(check-equal? (linewrap (list sp x) 2) (list x)) (check-equal? (linewrap (list sp x) 2) (list x))
(check-equal? (linewrap (list x sp) 2) (list x)) (check-equal? (linewrap (list x sp) 2) (list x))
(check-equal? (linewrap (list sp x sp) 2) (list x)) (check-equal? (linewrap (list sp x sp) 2) (list x))
(check-equal? (linewrap (list sp sp x sp sp) 2) (list x)) (check-equal? (linewrap (list sp sp x sp sp) 2) (list x))
(check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list x 'lb x))) (check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list x 'lb x))))
#;(module+ test
(test-case (test-case
"hard hyphens" "hard hyphens"
(check-equal? (linewrap (list hyph) 1) (list hyph)) (check-equal? (linewrap (list hyph) 1) (list hyph))
@ -236,8 +241,9 @@
(check-equal? (linewrap (list x x hyph x x) 2) (list x x 'lb hyph x 'lb x)) (check-equal? (linewrap (list x x hyph x x) 2) (list x x 'lb hyph x 'lb x))
(check-equal? (linewrap (list x x hyph x x) 3) (list x x hyph 'lb x x)) (check-equal? (linewrap (list x x hyph x x) 3) (list x x hyph 'lb x x))
(check-equal? (linewrap (list x x hyph x x) 4) (list x x hyph 'lb x x)) (check-equal? (linewrap (list x x hyph x x) 4) (list x x hyph 'lb x x))
(check-equal? (linewrap (list x x hyph x x) 5) (list x x hyph x x))) (check-equal? (linewrap (list x x hyph x x) 5) (list x x hyph x x))))
#;(module+ test
(test-case (test-case
"soft hyphens" "soft hyphens"
(check-equal? (linewrap (list shy) 1) (list)) (check-equal? (linewrap (list shy) 1) (list))
@ -250,16 +256,18 @@
(check-equal? (linewrap (list x x shy x x) 3) (list x x shy 'lb x x)) (check-equal? (linewrap (list x x shy x x) 3) (list x x shy 'lb x x))
(check-equal? (linewrap (list x x shy x x) 4) (list x x x x)) (check-equal? (linewrap (list x x shy x x) 4) (list x x x x))
(check-equal? (linewrap (list x x shy x x) 5) (list x x x x)) (check-equal? (linewrap (list x x shy x x) 5) (list x x x x))
(check-equal? (linewrap (list x x shy x sp x) 4) (list x x x 'lb x))) (check-equal? (linewrap (list x x shy x sp x) 4) (list x x x 'lb x))))
#;(module+ test
(test-case (test-case
"zero width nonbreakers" "zero width nonbreakers"
(check-equal? (linewrap (list sp zwx) 2) (list zwx)) (check-equal? (linewrap (list sp zwx) 2) (list zwx))
(check-equal? (linewrap (list zwx sp) 2) (list zwx)) (check-equal? (linewrap (list zwx sp) 2) (list zwx))
(check-equal? (linewrap (list sp zwx sp) 2) (list zwx)) (check-equal? (linewrap (list sp zwx sp) 2) (list zwx))
(check-equal? (linewrap (list sp sp zwx sp sp) 2) (list zwx)) (check-equal? (linewrap (list sp sp zwx sp sp) 2) (list zwx))
(check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list zwx sp sp zwx))) (check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list zwx sp sp zwx))))
(module+ test
(test-case (test-case
"hard breaks" "hard breaks"
(check-equal? (linewrap (list br) 2) (list)) ;; only insert a break if it's between things (check-equal? (linewrap (list br) 2) (list)) ;; only insert a break if it's between things
@ -270,8 +278,9 @@
(check-equal? (linewrap (list x x br x) 3) (list x x 'lb x)) (check-equal? (linewrap (list x x br x) 3) (list x x 'lb x))
(check-equal? (linewrap (list x x x x) 3) (list x x x 'lb x)) (check-equal? (linewrap (list x x x x) 3) (list x x x 'lb x))
(check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x)) (check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x))
(check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))) (check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
#;(module+ test
(test-case (test-case
"hard breaks and spurious spaces" "hard breaks and spurious spaces"
(check-equal? (linewrap (list a sp sp sp br b) 2) (list a 'lb b)) (check-equal? (linewrap (list a sp sp sp br b) 2) (list a 'lb b))
@ -289,7 +298,7 @@
(cond (cond
[(quad? b) (car (elems b))] [(quad? b) (car (elems b))]
[else #\|])))) [else #\|]))))
(module+ test #;(module+ test
(test-case (test-case
"visual breaks" "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" 1) "M|y|d|o|g|h|a|s|f|l|e|a|s")
@ -328,16 +337,18 @@
(check-equal? (pagewrap (list x x x) 2) (list 'pb x x 'pb x)) (check-equal? (pagewrap (list x x x) 2) (list 'pb x x 'pb x))
(check-equal? (pagewrap (list x x x) 3) (list 'pb x x x)) (check-equal? (pagewrap (list x x x) 3) (list 'pb x x x))
(check-equal? (pagewrap (list x x x) 4) (list 'pb x x x)) (check-equal? (pagewrap (list x x x) 4) (list 'pb x x x))
(check-equal? (pagewrap (list x 'lb x x) 2) (list 'pb x 'pb x x))) (check-equal? (pagewrap (list x 'lb x x) 2) (list 'pb x 'pb x x))))
(module+ test
(test-case (test-case
"hard page breaks" "hard page breaks"
(check-equal? (pagewrap (list x pbr x x) 2) (list 'pb x 'pb x x)) (check-equal? (pagewrap (list x pbr x x) 2) (list 'pb x 'pb x x))
(check-equal? (pagewrap (list x pbr x x) 1) (list 'pb x 'pb x 'pb x)) (check-equal? (pagewrap (list x pbr x x) 1) (list 'pb x 'pb x 'pb x))
(check-equal? (pagewrap (list x pbr pbr x x) 1) (list 'pb x 'pb 'pb x 'pb x)) (check-equal? (pagewrap (list x pbr pbr x x) 1) (list 'pb x 'pb 'pb x 'pb x))
(check-equal? (pagewrap (list x pbr pbr x x) 2) (list 'pb x 'pb 'pb x x)) (check-equal? (pagewrap (list x pbr pbr x x) 2) (list 'pb x 'pb 'pb x x))
(check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list 'pb x 'pb x x))) (check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list 'pb x 'pb x x))))
#;(module+ test
(test-case (test-case
"composed line breaks and page breaks" "composed line breaks and page breaks"
(check-equal? (pagewrap (linewrap null 1) 2) '(pb) ) (check-equal? (pagewrap (linewrap null 1) 2) '(pb) )
@ -355,7 +366,7 @@
#:soft-break-proc soft-break? #:soft-break-proc soft-break?
#:finish-wrap-proc (λ (pcs) (list ($slug #f pcs))))) #:finish-wrap-proc (λ (pcs) (list ($slug #f pcs)))))
(module+ test #;(module+ test
(test-case (test-case
"hard breaks and spurious spaces with slugs" "hard breaks and spurious spaces with slugs"
(check-equal? (linewrap2 (list a sp sp sp br b) 2) (list (slug a) 'lb (slug b))) (check-equal? (linewrap2 (list a sp sp sp br b) 2) (list (slug a) 'lb (slug b)))
@ -364,4 +375,4 @@
(check-equal? (linewrap2 (list a sp b sp sp br sp c) 3) (list (slug a sp b) 'lb (slug c))) (check-equal? (linewrap2 (list a sp b sp sp br sp c) 3) (list (slug a sp b) 'lb (slug c)))
(check-equal? (linewrap2 (list x x x x) 3) (list (slug x x x) 'lb (slug x))) (check-equal? (linewrap2 (list x x x x) 3) (list (slug x x x) 'lb (slug x)))
(check-equal? (linewrap2 (list x x x sp x x) 2) (list (slug x x) 'lb (slug x) 'lb (slug x x))) (check-equal? (linewrap2 (list x x x sp x x) 2) (list (slug x x) 'lb (slug x) 'lb (slug x x)))
(check-equal? (linewrap2 (list x x x sp x x) 3) (list (slug x x x) 'lb (slug x x))))) (check-equal? (linewrap2 (list x x x sp x x) 3) (list (slug x x x) 'lb (slug x x)))))

Write Preview
Loading…
Cancel
Save