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

step

Browse Source
main
Matthew Butterick 5 years ago
parent 91075c820c
commit cee9c92e68
3 changed files with 204 additions and 168 deletions
Show Stats Download Patch File Download Diff File

6
quad/quad/position.rkt
Unescape Escape View File

@ -8,6 +8,12 @@
(define (pt+ . pts) (apply map + pts)) (define (pt+ . pts) (apply map + pts))
(define (pt- . pts) (apply map - pts)) (define (pt- . pts) (apply map - pts))
(define (sum-base qs which)
(for/sum ([q (in-list qs)])
(which (size q))))
(define (sum-y qs) (sum-base qs pt-y))
(define (sum-x qs) (sum-base qs pt-x))
(define valid-anchors '(nw n ne w c e sw s se bi bo)) (define valid-anchors '(nw n ne w c e sw s se bi bo))
(define (coerce-int x) (if (integer? x) (inexact->exact x) x)) (define (coerce-int x) (if (integer? x) (inexact->exact x) x))

337
quad/quad/wrap.rkt
Unescape Escape View File

@ -1,7 +1,7 @@
#lang debug racket #lang debug racket
(require racket/list racket/match sugar/debug sugar/list (require racket/list racket/match sugar/debug sugar/list racket/generator
"param.rkt" "quad.rkt" "atomize.rkt" "position.rkt" "ocm.rkt" "log.rkt") "param.rkt" "quad.rkt" "atomize.rkt" "position.rkt" "ocm.rkt" "log.rkt")
(provide wrap sum-x sum-y) (provide wrap)
(define-syntax (debug-report stx) (define-syntax (debug-report stx)
(syntax-case stx () (syntax-case stx ()
@ -23,12 +23,6 @@
['(()) '()] ; special case ['(()) '()] ; special case
[wraps wraps])) [wraps wraps]))
(define (sum-base xs which)
(for/sum ([x (in-list xs)])
(which (size x))))
(define (sum-y xs) (sum-base xs pt-y))
(define (sum-x xs) (sum-base xs pt-x))
(define (arg->proc arg [arity 1]) (define (arg->proc arg [arity 1])
(match arg (match arg
[(? procedure? proc) proc] [(? procedure? proc) proc]
@ -36,7 +30,7 @@
[val (λ (q) val)])) [val (λ (q) val)]))
(define (wrap qs (define (wrap qs
[max-distance-proc-arg (current-wrap-distance)] [max-distance (current-wrap-distance)]
[debug #f] [debug #f]
;; hard break: must wrap ;; hard break: must wrap
#:hard-break [hard-break-func-arg #false] #:hard-break [hard-break-func-arg #false]
@ -65,14 +59,14 @@
#:finish-wrap [finish-wrap-func default-finish-wrap-func] #:finish-wrap [finish-wrap-func default-finish-wrap-func]
#:nicely [nicely? #f] #:nicely [nicely? #f]
#:footnote-qs [footnote-qs null] #:footnote-qs [footnote-qs null]
#:footnote-start-pred [footnote-start-pred (λ (q) #false)]) #:footnote-leftover-proc [footnote-leftover-proc (λ _ (error 'no-footnote-leftover-proc))]
#:footnote-new-proc [footnote-new-proc (λ _ (error 'no-footnote-new-proc))])
(define wrap-proc (if nicely? wrap-best wrap-first)) (define wrap-proc (if nicely? wrap-best wrap-first))
(define hard-break-func (arg->proc hard-break-func-arg)) (define hard-break-func (arg->proc hard-break-func-arg))
(define soft-break-func (arg->proc soft-break-func-arg)) (define soft-break-func (arg->proc soft-break-func-arg))
(define no-break-func (arg->proc no-break-func-arg)) (define no-break-func (arg->proc no-break-func-arg))
(define (hard-break? x) (and (hard-break-func x) (not (no-break-func x)))) (define (hard-break? x) (and (hard-break-func x) (not (no-break-func x))))
(define (soft-break? x) (and (soft-break-func x) (not (no-break-func x)))) (define (soft-break? x) (and (soft-break-func x) (not (no-break-func x))))
(define max-distance-proc (arg->proc max-distance-proc-arg 2))
; takes quads in wrap, triggering quad, and wrap idx; returns list containing wrap (and maybe other things) ; 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)]) (define (finish-wrap qs previous-wrap-ender wrap-idx [wrap-triggering-q (car qs)])
;; reverse because quads accumulated in reverse ;; reverse because quads accumulated in reverse
@ -83,28 +77,35 @@
;; for instance, a hyphen is `soft-break?` but shouldn't be trimmed. ;; 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)) (finish-wrap-func (reverse (dropf qs nonprinting-at-end?)) previous-wrap-ender wrap-triggering-q wrap-idx))
(wrap-proc qs (wrap-proc qs
footnote-qs max-distance
footnote-start-pred
max-distance-proc
debug debug
hard-break? hard-break?
soft-break? soft-break?
finish-wrap finish-wrap
wrap-count wrap-count
distance-func distance-func
initial-wrap-idx)) initial-wrap-idx
footnote-qs
footnote-leftover-proc
footnote-new-proc))
(define (wrap-first qs (define (wrap-first qs
footnote-qs-in max-distance
footnote-start-pred
max-distance-proc
debug debug
hard-break? hard-break?
soft-break? soft-break?
finish-wrap finish-wrap
wrap-count wrap-count
distance-func distance-func
initial-wrap-idx) initial-wrap-idx
footnote-qs-in
footnote-leftover-proc
footnote-new-proc)
(define has-footnotes? (pair? footnote-qs-in))
(let loop ([wraps null] ; list of (list of quads) (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`) [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?` [next-wrap-head null] ; list of quads ending in previous `soft-break?` or `hard-break?`
@ -113,157 +114,171 @@
[previous-wrap-ender #f] [previous-wrap-ender #f]
[qs qs] ; list of quads [qs qs] ; list of quads
[footnote-qs footnote-qs-in] ; list of footnote quads [footnote-qs footnote-qs-in] ; list of footnote quads
[footnote-next-wrap null]
[footnote-wraps null] ; list of footnote lines wrapped into footnote area for this col [footnote-wraps null] ; list of footnote lines wrapped into footnote area for this col
[footnote-dist 0] ; dist consumed by footnotes in current footnote wrap [footnote-dist 0] ; dist consumed by footnotes in current footnote wrap
; this needs to be tracked separately from current-dist because #false is used to detect start ; this needs to be tracked separately from current-dist because #false is used to detect start
[max-distance max-distance] ; might be reduced by footnotes
) )
#| #|
1) If there are lines left over from a previous footnote, set as many of those lines on the current page as space allows. If the footnote zone is empty, this is a footnote continuation, so start with a continuation break. Loop without making a new column break. 1) If there are lines left over from a previous footnote, set as many of those lines on the current page as space allows. If the footnote zone is empty, this is a footnote continuation, so start with a continuation break. Loop without making a new column break.
|# |#
(match footnote-qs (let-values ([(max-distance footnote-next-wrap footnote-qs)
[(list* (and (not (? footnote-start-pred)) fn-leftovers) ..1 other-fn-lines) ((if has-footnotes?
(define fn-nonblank (dropf fn-leftovers (λ (q) (and (soft-break? q)) (nonprinting-at-start? q)))) footnote-leftover-proc
(define fn-non-blank-height (sum-y fn-nonblank)) values) max-distance footnote-next-wrap footnote-qs)])
(loop
wraps (match qs
wrap-idx [(or (== empty) (list (? hard-break?))) ; ignore single trailing hard break
next-wrap-head (define last-wrap (finish-wrap (append next-wrap-tail next-wrap-head) previous-wrap-ender wrap-idx #f))
next-wrap-tail (finalize-reversed-wraps (cons last-wrap wraps))]
current-dist [(cons q other-qs)
previous-wrap-ender (debug-report q 'next-q)
qs (debug-report (quad-elems q) 'next-q-elems)
other-fn-lines (define would-be-wrap-qs (append (cons q next-wrap-tail) next-wrap-head))
(cons fn-nonblank footnote-wraps) (define (handle-hard-overflow)
fn-non-blank-height)] (cond
[_ (void)]) [(empty? next-wrap-head)
(match qs (define-values (next-wrap-qs other-qs)
[(or (== empty) (list (? hard-break?))) ; ignore single trailing hard break (cond
(define last-wrap (finish-wrap (append next-wrap-tail next-wrap-head) previous-wrap-ender wrap-idx #f)) [(empty? next-wrap-tail)
(finalize-reversed-wraps (cons last-wrap wraps))] ;; degenerate case where q is big enough to trigger a wrap on its own,
[(cons q other-qs) ;; but nothing left in next-wrap-head or next-wrap-tail.
(debug-report q 'next-q) ;; so we put it in its own wrap and recur, because otherwise we can't proceed
(debug-report (quad-elems q) 'next-q-elems) ;; though it will look screwy
(define would-be-wrap-qs (append (cons q next-wrap-tail) next-wrap-head)) (debug-report 'making-the-best-of-a-bad-situation)
(cond (values (list q) (cdr qs))]
[(hard-break? q) [else
(debug-report 'found-hard-break) (debug-report 'would-overflow-hard-without-captured-break)
;; must break. finish the wrap (values next-wrap-tail qs)]))
(loop (cons (finish-wrap would-be-wrap-qs previous-wrap-ender wrap-idx) wraps) (loop (cons (finish-wrap next-wrap-qs previous-wrap-ender wrap-idx) wraps)
(wrap-count wrap-idx q) (wrap-count wrap-idx q)
null null
null null
#false #false
q (car next-wrap-qs)
other-qs other-qs
footnote-qs footnote-qs
footnote-wraps footnote-next-wrap
footnote-dist)] footnote-wraps
[(let ([at-start? (not current-dist)]) at-start?) footnote-dist
(match q max-distance)]
[(and (? soft-break?) (? nonprinting-at-start?)) [else ; finish the wrap & reset the line without consuming a quad
(debug-report q 'skipping-soft-break-at-beginning) (loop (cons (finish-wrap next-wrap-head previous-wrap-ender wrap-idx) wraps)
(loop wraps (wrap-count wrap-idx q)
wrap-idx null
next-wrap-head next-wrap-tail
next-wrap-tail (for/sum ([item (in-list next-wrap-tail)]) (distance item))
current-dist (car next-wrap-head)
previous-wrap-ender qs
other-qs footnote-qs
footnote-qs footnote-next-wrap
footnote-wraps footnote-wraps
footnote-dist)] footnote-dist
[_ (debug-report 'hard-quad-at-start) max-distance)]))
(loop wraps (with-handlers ([symbol? (λ (exn) (handle-hard-overflow))])
wrap-idx (let-values ([(max-distance footnote-next-wrap footnote-qs)
next-wrap-head (if has-footnotes?
(list q) (footnote-new-proc max-distance footnote-next-wrap footnote-qs q)
(distance-func q 0 would-be-wrap-qs) (values max-distance footnote-next-wrap footnote-qs))])
previous-wrap-ender
other-qs
footnote-qs
footnote-wraps
footnote-dist)])]
[else ; cases that require computing distance
(define wrap-distance (distance-func q current-dist would-be-wrap-qs))
(define max-distance (max-distance-proc q wrap-idx))
(define would-overflow? (> wrap-distance max-distance))
(cond
[would-overflow?
(cond (cond
[(and (soft-break? q) (nonprinting-at-end? q)) [(hard-break? q)
(debug-report 'would-overflow-soft-nonprinting) (debug-report 'found-hard-break)
;; a break is inevitable but we want to wait to finish the wrap until we see a hard quad ;; must break. finish the wrap and consume the hard break
;; but we can move the current-partial into the current-wrap (loop (cons (finish-wrap would-be-wrap-qs previous-wrap-ender wrap-idx) wraps)
(loop wraps
wrap-idx
(append (cons q next-wrap-tail) next-wrap-head)
null
wrap-distance
previous-wrap-ender
other-qs
footnote-qs
footnote-wraps
footnote-dist)]
[(empty? next-wrap-head)
(define-values (next-wrap-qs other-qs)
(cond
[(empty? next-wrap-tail)
;; degenerate case where q is big enough to trigger a wrap on its own,
;; but nothing left in next-wrap-head or next-wrap-tail.
;; so we put it in its own wrap and recur, because otherwise we can't proceed
;; though it will look screwy
(debug-report 'making-the-best-of-a-bad-situation)
(values (list q) (cdr qs))]
[else
(debug-report 'would-overflow-hard-without-captured-break)
(values next-wrap-tail qs)]))
(loop (cons (finish-wrap next-wrap-qs previous-wrap-ender wrap-idx) wraps)
(wrap-count wrap-idx q) (wrap-count wrap-idx q)
null null
null null
#false #false
(car next-wrap-qs) q
other-qs other-qs
footnote-qs footnote-qs
footnote-next-wrap
footnote-wraps footnote-wraps
footnote-dist)] footnote-dist
[else ; finish the wrap & reset the line without consuming a quad max-distance)]
(loop (cons (finish-wrap next-wrap-head previous-wrap-ender wrap-idx) wraps) [(let ([at-start? (not current-dist)]) at-start?)
(wrap-count wrap-idx q) (match q
null [(and (? soft-break?) (? nonprinting-at-start?))
next-wrap-tail (debug-report q 'skipping-soft-break-at-beginning)
(for/sum ([item (in-list next-wrap-tail)]) (distance item)) (loop wraps
(car next-wrap-head) wrap-idx
qs next-wrap-head
footnote-qs next-wrap-tail
footnote-wraps current-dist
footnote-dist)])] previous-wrap-ender
[(soft-break? q) other-qs
(debug-report 'would-not-overflow-soft) footnote-qs
;; a soft break that fits, so move it on top of the next-wrap-head with the next-wrap-tail footnote-next-wrap
(loop wraps footnote-wraps
wrap-idx footnote-dist
(append (cons q next-wrap-tail) next-wrap-head) max-distance)]
null [_ (debug-report 'hard-quad-at-start)
wrap-distance (loop wraps
previous-wrap-ender wrap-idx
other-qs next-wrap-head
footnote-qs (list q)
footnote-wraps (distance-func q 0 would-be-wrap-qs)
footnote-dist)] previous-wrap-ender
[else other-qs
(debug-report 'would-not-overflow) footnote-qs
;; add to partial footnote-next-wrap
(loop wraps footnote-wraps
wrap-idx footnote-dist
next-wrap-head max-distance)])]
(cons q next-wrap-tail) [else ; cases that require computing distance
wrap-distance (define wrap-distance (distance-func q current-dist would-be-wrap-qs))
previous-wrap-ender (define would-overflow? (> wrap-distance max-distance))
other-qs (cond
footnote-qs [would-overflow?
footnote-wraps (cond
footnote-dist)])])]))) [(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-idx
(append (cons q next-wrap-tail) next-wrap-head)
null
wrap-distance
previous-wrap-ender
other-qs
footnote-qs
footnote-next-wrap
footnote-wraps
footnote-dist
max-distance)]
[else (handle-hard-overflow)])]
[(soft-break? q)
(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-idx
(append (cons q next-wrap-tail) next-wrap-head)
null
wrap-distance
previous-wrap-ender
other-qs
footnote-qs
footnote-next-wrap
footnote-wraps
footnote-dist
max-distance)]
[else
(debug-report 'would-not-overflow)
;; add to partial
(loop wraps
wrap-idx
next-wrap-head
(cons q next-wrap-tail)
wrap-distance
previous-wrap-ender
other-qs
footnote-qs
footnote-next-wrap
footnote-wraps
footnote-dist
max-distance)])])))]))))
(define last-line-can-be-short? #t) (define last-line-can-be-short? #t)
(define mega-penalty 1e8) (define mega-penalty 1e8)
@ -274,16 +289,14 @@
(vector-ref pieces n))))) (vector-ref pieces n)))))
(define (wrap-best qs (define (wrap-best qs
footnote-qs max-distance
footnote-start-pred?
max-distance-proc
debug debug
hard-break? hard-break?
soft-break? soft-break?
finish-wrap finish-wrap
wrap-count wrap-count
distance-func distance-func
initial-wrap-idx) initial-wrap-idx . _)
(for*/fold ([wrapss null] (for*/fold ([wrapss null]
[wrap-idx initial-wrap-idx] [wrap-idx initial-wrap-idx]
[previous-wrap-ender #f] [previous-wrap-ender #f]
@ -295,11 +308,11 @@
[pieces (values pieces #f)])) [pieces (values pieces #f)]))
(define pieces-vec (list->vector (slicef-after pieces soft-break?))) (define pieces-vec (list->vector (slicef-after pieces soft-break?)))
(define-values (wraps idx ender) (define-values (wraps idx ender)
(wrap-pieces-best pieces-vec wrap-idx previous-wrap-ender last-ender wrap-count distance-func max-distance-proc finish-wrap)) (wrap-pieces-best pieces-vec wrap-idx previous-wrap-ender last-ender wrap-count distance-func max-distance finish-wrap))
(values (cons wraps wrapss) idx last-ender))) (values (cons wraps wrapss) idx last-ender)))
(struct penalty-rec (val idx hyphen-count) #:transparent) (struct penalty-rec (val idx hyphen-count) #:transparent)
(define (wrap-pieces-best pieces-vec starting-wrap-idx previous-last-q last-ender wrap-count distance-func max-distance-proc finish-wrap) (define (wrap-pieces-best pieces-vec starting-wrap-idx previous-last-q last-ender wrap-count distance-func max-distance finish-wrap)
(define (penalty i j) (define (penalty i j)
(cond (cond
[(or (eq? i j) (> j (vector-length pieces-vec))) [(or (eq? i j) (> j (vector-length pieces-vec)))
@ -311,7 +324,7 @@
(define wrap-distance (for/fold ([last-dist 0]) (define wrap-distance (for/fold ([last-dist 0])
([q (in-list would-be-wrap-qs)]) ([q (in-list would-be-wrap-qs)])
(distance-func q last-dist would-be-wrap-qs))) (distance-func q last-dist would-be-wrap-qs)))
(define underflow (- (max-distance-proc (car would-be-wrap-qs) starting-idx) wrap-distance)) (define underflow (- max-distance wrap-distance))
(define new-consecutive-hyphen-count (define new-consecutive-hyphen-count
(if (equal? (quad-elems (car would-be-wrap-qs)) '("\u00AD")) (add1 hyphen-count) 0)) (if (equal? (quad-elems (car would-be-wrap-qs)) '("\u00AD")) (add1 hyphen-count) 0))
(penalty-rec (penalty-rec

29
quad/quadwriter/layout.rkt
Unescape Escape View File

@ -452,10 +452,10 @@
;; next line removes all para-break? quads as a consequence ;; next line removes all para-break? quads as a consequence
(for/list ([qs (in-list (filter-split qs para-break-quad?))]) (for/list ([qs (in-list (filter-split qs para-break-quad?))])
(wrap qs (wrap qs
(λ (q idx) (* (- wrap-size (* (- wrap-size
(quad-ref (car qs) :inset-left 0) (quad-ref (car qs) :inset-left 0)
(quad-ref (car qs) :inset-right 0)) (quad-ref (car qs) :inset-right 0))
permitted-justify-overfill)) permitted-justify-overfill)
#:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap)) #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap))
[(or "best" "kp") #true] [(or "best" "kp") #true]
[_ #false]) [_ #false])
@ -684,7 +684,7 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
;; could do it after, but it would require going back inside each col quad ;; could do it after, but it would require going back inside each col quad
;; which seems overly interdependent, because `insert-blocks` is used to determine break locations. ;; which seems overly interdependent, because `insert-blocks` is used to determine break locations.
;; `col-wrap` should emit quads that are complete. ;; `col-wrap` should emit quads that are complete.
(verbose-quad-printing? #true) (define (footnote-start? fnq) (quad-ref fnq :fn-text-start))
(define cols (wrap lines vertical-height (define cols (wrap lines vertical-height
#:soft-break #true #:soft-break #true
#:hard-break column-break-quad? #:hard-break column-break-quad?
@ -694,7 +694,24 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
(sum-y (insert-blocks (reverse wrap-qs)))) (sum-y (insert-blocks (reverse wrap-qs))))
#:finish-wrap (col-finish-wrap column-quad) #:finish-wrap (col-finish-wrap column-quad)
#:footnote-qs fn-lines #:footnote-qs fn-lines
#:footnote-start-pred (λ (q) (quad-ref q :fn-text-start)))) #:footnote-leftover-proc (λ (ymax leftover-qs fn-qs)
(let loop ([ymax ymax][leftover-qs leftover-qs][fn-qs fn-qs])
(define ydist (and (pair? fn-qs) (pt-y (size (car fn-qs)))))
;; take all fn lines that are not footnote-start?
;; and that fit within ymax remaining
(if (and ydist (not (footnote-start? (car fn-qs))) (<= ydist ymax))
(loop (- ymax ydist) (cons (car fn-qs) leftover-qs) (cdr fn-qs))
(values ymax leftover-qs fn-qs))))
#:footnote-new-proc (λ (ymax leftover-qs fn-qs fn-ref-q)
(define ydist-fn (and (pair? fn-qs)
(footnote-start? (car fn-qs))
(pt-y (size (car fn-qs)))))
(define ydist-ref (pt-y (size fn-ref-q)))
;; only accept the footnote if both the first line of footnote
;; and the line containing the ref will fit.
(if (and ydist-fn (<= (+ ydist-fn ydist-ref) ymax))
(values (- ymax ydist-fn) (cons (car fn-qs) leftover-qs) (cdr fn-qs))
(raise 'boom)))))
(define reversed-fn-lines (define reversed-fn-lines
(from-parent (for/list ([fn-line (in-list (reverse fn-lines))]) (from-parent (for/list ([fn-line (in-list (reverse fn-lines))])
;; position bottom to top, in reverse ;; position bottom to top, in reverse

Write Preview
Loading…
Cancel
Save