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

a step

Browse Source
main
Matthew Butterick 6 years ago
parent 3e64c7dc96
commit 54e4b81a43
1 changed files with 111 additions and 114 deletions
Show Stats Download Patch File Download Diff File

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

@ -33,49 +33,50 @@
#:hard-break-proc procedure? #:hard-break-proc procedure?
#:soft-break-proc procedure? #:soft-break-proc procedure?
#:finish-wrap-proc procedure?) . ->* . (listof any/c)) #:finish-wrap-proc procedure?) . ->* . (listof any/c))
(break-private xs (break-hards xs
target-size target-size
debug debug
break-val break-val
break-before? break-before?
break-after? break-after?
hard-break? hard-break?
soft-break? soft-break?
finish-wrap-proc)) finish-wrap-proc))
;; the hard breaks are used to divide the wrap territory into smaller chunks ;; the hard breaks are used to divide the wrap territory into smaller chunks
;; that can be cached, parallelized, etc. ;; that can be cached, parallelized, etc.
(define (break-private xs (define (break-hards xs
target-size target-size
debug debug
break-val break-val
break-before? break-before?
break-after? break-after?
hard-break? hard-break?
soft-break? soft-break?
finish-wrap-proc) finish-wrap-proc)
(define break-val-equal? (if (symbol? break-val) eq? equal?)) (define break-val=? (if (symbol? break-val) eq? equal?))
(define (cleanup-wraplist xs) (dropf-right (append* (reverse xs)) (λ (x) (break-val-equal? break-val x)))) (define (cleanup-wraplist xs)
(dropf-right (append* (reverse xs)) (λ (x) (break-val=? break-val x))))
(define wraps (define wraps
(for/fold ([wraps null] (for/fold ([wraps null]
[xs (dropf xs hard-break?)] [xs xs]
#:result (map touch wraps)) #:result wraps)
([i (in-naturals)] ([i (in-naturals)]
#:break (null? xs)) #:break (null? xs))
(cond (match xs
[(hard-break? (car xs)) [(cons (? hard-break?) rest)
(when debug (report x 'hard-break)) (when debug (report x 'hard-break))
(values (cons (future (λ () (list break-val))) wraps) (cdr xs))] (values (cons (list break-val) wraps) rest)]
[else [_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
(define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x))))) (values (cons (cleanup-wraplist (break-softs head
(values (cons (future (λ () (cleanup-wraplist (break-softs head target-size
target-size debug
debug break-val
break-val soft-break?
soft-break? finish-wrap-proc)) wraps) tail)])))
finish-wrap-proc)))) wraps) tail)]))) (append (if break-before? (list break-val) empty)
(append (if break-before? (list break-val) empty) (cleanup-wraplist wraps) (if break-after? (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-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-at-end? x) (if (quad? x) (not (printable? x 'end)) #t))
@ -90,85 +91,81 @@
(define (capture-soft-break-k!) (define (capture-soft-break-k!)
(when debug (report 'capturing-break)) (when debug (report 'capturing-break))
(let/cc k (set! last-soft-break-k k) #f)) (let/cc k (set! last-soft-break-k k) #f))
(call/prompt ;; continuation boundary for last-soft-break-k (let loop ([wraps null][wrap-pieces null][dist-so-far start-signal][xs xs])
(thunk (match xs
(let loop ([wraps null][wrap-pieces null][dist-so-far start-signal][xs xs]) [(== empty)
(cond ;; combine the segments into a flat list, and drop any trailing breaks
[(null? xs) ;; (on the idea that breaks should separate things, and there's nothing left to separate)
;; combine the segments into a flat list, and drop any trailing breaks ;; wraps alternate with breaks
;; (on the idea that breaks should separate things, and there's nothing left to separate) (for/list ([pcs (in-list (cons wrap-pieces wraps))])
;; wraps alternate with breaks (match pcs
(for/list ([pcs (in-list (cons wrap-pieces wraps))] [(list (? nonprinting-at-end?)) pcs] ; matches break signals
[proc (in-cycle (list ;; pieces will have been accumulated in reverse order
;; pieces will have been accumulated in reverse order ;; thus beginning of list represents the end of the wrap
;; dropf drops from beginning of list (representing the end of the wrap) [(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
(finish-wrap-proc (reverse rest))]))]
(λ (pcs) (finish-wrap-proc (reverse (dropf pcs (λ (x) (and (soft-break? x) (nonprinting-at-end? x))))))) [(cons x _)
values))]) (define at-start? (eq? dist-so-far start-signal))
(proc pcs))] (define underflow? (and (not at-start?) (<= (+ dist-so-far (if (and (quad? x) (printable? x 'end)) (distance x) 0)) target-size)))
[else (define (values-for-insert-break [before? #f])
(define x (car xs)) ;; a break can be inserted before or after the current quad.
(define at-start? (eq? dist-so-far start-signal)) ;; At an ordinary break (hard or soft) it goes after the wrap point.
(define underflow? (and (not at-start?) (<= (+ dist-so-far (if (and (quad? x) (printable? x 'end)) (distance x) 0)) target-size))) ;; The wrap signal consumes the break if it's nonprinting (e.g., word space or hard break)
(define (values-for-insert-break [before? #f]) ;; but not if it's printing (e.g., hyphen).
;; a break can be inserted before or after the current quad. ;; But if no ordinary break can be found for a line, the wrap will happen before the quad.
;; At an ordinary break (hard or soft) it goes after the wrap point. ;; The wrap signal will not consume the quad (rather, it will become the first quad in the next wrap)
;; The wrap signal consumes the break if it's nonprinting (e.g., word space or hard break) ;; (we do this by resetting next-xs to the whole xs list)
;; but not if it's printing (e.g., hyphen). ;; In both cases, the `finish-wrap` proc will strip off any trailing white breaks from the new segment.
;; But if no ordinary break can be found for a line, the wrap will happen before the quad. (set! last-soft-break-k #f) ;; prevents continuation loop
;; The wrap signal will not consume the quad (rather, it will become the first quad in the next wrap) (if before?
;; (we do this by resetting next-xs to the whole xs list) (values wrap-pieces xs)
;; In both cases, the `finish-wrap` proc will strip off any trailing white breaks from the new segment. ; omit nonprinting quad
(set! last-soft-break-k #f) ;; prevents continuation loop (values (if (and (quad? x) (nonprinting-at-end? x)) wrap-pieces (cons x wrap-pieces)) (cdr xs))))
(if before? (cond
(values wrap-pieces xs) [(and at-start? (soft-break? x) (nonprinting-at-start? x))
; omit nonprinting quad (when debug (report x 'skipping-soft-break-at-beginning))
(values (if (and (quad? x) (nonprinting-at-end? x)) wrap-pieces (cons x wrap-pieces)) (cdr xs)))) ;; skip it
(cond (loop wraps null dist-so-far (cdr xs))]
[(and at-start? (soft-break? x) (nonprinting-at-start? x)) [(and underflow? (soft-break? x) (capture-soft-break-k!))
(when debug (report x 'skipping-soft-break-at-beginning)) (when debug (report x 'resuming-break-from-continuation))
;; skip it (define-values (pieces-for-this-wrap next-xs) (values-for-insert-break))
(loop wraps null dist-so-far (cdr xs))] (loop (list* (list break-val) pieces-for-this-wrap wraps)
[(and underflow? (soft-break? x) (capture-soft-break-k!)) null
(when debug (report x 'resuming-break-from-continuation)) start-signal
(define-values (pieces-for-this-wrap next-xs) (values-for-insert-break)) next-xs)]
(loop (list* (list break-val) pieces-for-this-wrap wraps) ;; the easy case of accumulating quads in the middle of a wrap
null [(or (and underflow? (when debug (report x 'add-underflow)) #t)
start-signal ;; assume printing (nonprinting were handled in first case)
next-xs)] ;; this branch reached if the first quad on the line causes an overflow
;; the easy case of accumulating quads in the middle of a wrap ;; That sounds weird, but maybe it's just really big.
[(or (and underflow? (when debug (report x 'add-underflow)) #t) (and at-start? (when debug (report x 'add-at-start)) #t)
;; assume printing (nonprinting were handled in first case) ;; we do want to accumulate nonprinting soft breaks (like wordspaces and soft hyphens) in the middle.
;; this branch reached if the first quad on the line causes an overflow ;; in case we eventually encounter a printing quad that fits on the line.
;; That sounds weird, but maybe it's just really big. ;; if we don't (ie. the line overflows) then they will get stripped by `finish-wrap`
(and at-start? (when debug (report x 'add-at-start)) #t) (and (soft-break? x) (nonprinting-at-end? x) (when debug (report x 'add-nonprinting-soft-break)) #t))
;; we do want to accumulate nonprinting soft breaks (like wordspaces and soft hyphens) in the middle. (define printable (and (quad? x) (printable? x (and at-start? 'start))))
;; in case we eventually encounter a printing quad that fits on the line. (define dist (and printable (distance x)))
;; if we don't (ie. the line overflows) then they will get stripped by `finish-wrap` (loop wraps
(and (soft-break? x) (nonprinting-at-end? x) (when debug (report x 'add-nonprinting-soft-break)) #t)) (if (and (quad? x) (not printable)) wrap-pieces (cons x wrap-pieces)) ; omit nonprinting quad
(define printable (and (quad? x) (printable? x (and at-start? 'start)))) (if at-start? (or dist start-signal) (+ dist-so-far (or dist 0)))
(define dist (and printable (distance x))) (cdr xs))]
(loop wraps ;; the previous branch will catch all `underflow?` cases
(if (and (quad? x) (not printable)) wrap-pieces (cons x wrap-pieces)) ; omit nonprinting quad ;; therefore, in these last two cases, we have overflow
(if at-start? (or dist start-signal) (+ dist-so-far (or dist 0))) [last-soft-break-k ;; overflow implied
(cdr xs))] ;; if we have an soft break stored, we jump back and use it
;; the previous branch will catch all `underflow?` cases ;; now that we know we need it.
;; therefore, in these last two cases, we have overflow (when debug (report x 'invoking-last-breakpoint))
[last-soft-break-k ;; overflow implied (last-soft-break-k #t)]
;; if we have an soft break stored, we jump back and use it [else ;; overflow implied
;; now that we know we need it. ;; if we don't have an soft break stored, we need to just end the wrap and move on
(when debug (report x 'invoking-last-breakpoint)) ;; we insert the break `before` so that the current quad is moved to the next wrap
(last-soft-break-k #t)] ;; no, it's not going to look good, but if we reach this point, we are in weird conditions
[else ;; overflow implied (when debug (report x 'falling-back))
;; if we don't have an soft break stored, we need to just end the wrap and move on (define-values (pieces-for-this-wrap next-xs) (values-for-insert-break 'before))
;; we insert the break `before` so that the current quad is moved to the next wrap (loop (list* (list break-val) pieces-for-this-wrap wraps)
;; no, it's not going to look good, but if we reach this point, we are in weird conditions null
(when debug (report x 'falling-back)) start-signal
(define-values (pieces-for-this-wrap next-xs) (values-for-insert-break 'before)) next-xs)])])))
(loop (list* (list break-val) pieces-for-this-wrap wraps)
null
start-signal
next-xs)])])))))
(define x (q (list 'size (pt 1 1)) #\x)) (define x (q (list 'size (pt 1 1)) #\x))

Write Preview
Loading…
Cancel
Save