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

start footnote algorithm

Browse Source
main
Matthew Butterick 5 years ago
parent c1d749949a
commit 7ef031b978
4 changed files with 122 additions and 51 deletions
Show Stats Download Patch File Download Diff File

8
quad/qtest/demo-footnotes.rkt
Unescape Escape View File

@ -3,12 +3,12 @@
#:page-height "8in"
#:page-width "6in"
"Hello"
"Hello" '(q ((fn-ref "1")) "*")
'(q ((flow "footnote")(font-size-adjust "80%")(line-height-adjust "70%")) "A convertible value in the sense of convertible? is used in a renderer-specific way, but values convertible to 'text renders the same as the resulting string. If a renderer is not able to convert the value to a known format, the value is converted to a string using write." (q ((break "para"))))
'(q ((flow "footnote")(fn-text "1")(font-size-adjust "80%")(line-height-adjust "70%")) (q ((fn-text-start "1")) "*") "A convertible value in the sense of convertible? is used in a renderer-specific way, but values convertible to 'text renders the same as the resulting string. If a renderer is not able to convert the value to a known format, the value is converted to a string using write." (q ((break "para"))))
" world."
" world." '(q ((fn-ref "2")) "†")
'(q ((flow "footnote")(font-size-adjust "80%")(line-height-adjust "70%")) "An instance of link-element has a tag for the target of the link." (q ((break "para"))))
'(q ((flow "footnote")(fn-text "2")(font-size-adjust "80%")(line-heightr-adjust "70%")) (q ((fn-text-start "2")) "†") "An instance of link-element has a tag for the target of the link." (q ((break "para"))))
" I love you."

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

@ -19,9 +19,8 @@
(define (finalize-reversed-wraps wraps)
; append* because `finish-wrap-proc` returns a spliceable list
; reverse because wraps accumulated in reverse
; as a special case, '(()) is returned as just '()
(match (append* (reverse wraps))
[(list (list)) (list)]
['(()) '()] ; special case
[wraps wraps]))
(define (arg->proc arg [arity 1])
@ -58,7 +57,9 @@
;; (q0 is not part of this wrap, but q is)
;; idx is current wrap-count value.
#:finish-wrap [finish-wrap-func default-finish-wrap-func]
#:nicely [nicely? #f])
#:nicely [nicely? #f]
#:footnote-qs [footnote-qs null]
#:footnote-start-pred [footnote-start-pred (λ (q) #false)])
(define wrap-proc (if nicely? wrap-best wrap-first))
(define hard-break-func (arg->proc hard-break-func-arg))
(define soft-break-func (arg->proc soft-break-func-arg))
@ -75,16 +76,44 @@
;; 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))
(wrap-proc qs max-distance-proc debug hard-break? soft-break? finish-wrap wrap-count distance-func initial-wrap-idx))
(define (wrap-first qs max-distance-proc debug hard-break? soft-break? finish-wrap wrap-count distance-func initial-wrap-idx)
(wrap-proc qs
footnote-qs
footnote-start-pred
max-distance-proc
debug
hard-break?
soft-break?
finish-wrap
wrap-count
distance-func
initial-wrap-idx))
(define (wrap-first qs
footnote-qs-in
footnote-start-pred
max-distance-proc
debug
hard-break?
soft-break?
finish-wrap
wrap-count
distance-func
initial-wrap-idx)
(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?`
[next-wrap-tail null] ; list of unbreakable quads
[current-dist #false] ; #false (to indicate start) or integer
[previous-wrap-ender #f]
[qs qs]) ; list of quads
[qs qs]
[footnote-qs footnote-qs-in]
[footnote-wraps null]) ; list of quads
#|
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
[(list* (? footnote-start-pred leftover-lns) ..1 _) #R leftover-lns]
[_ (void)])
(match qs
[(or (== empty) (list (? hard-break?))) ; ignore single trailing hard break
(define last-wrap (finish-wrap (append next-wrap-tail next-wrap-head) previous-wrap-ender wrap-idx #f))
@ -103,7 +132,9 @@
null
#false
q
other-qs)]
other-qs
footnote-qs
footnote-wraps)]
[(let ([at-start? (not current-dist)]) at-start?)
(match q
[(and (? soft-break?) (? nonprinting-at-start?))
@ -114,7 +145,9 @@
next-wrap-tail
current-dist
previous-wrap-ender
other-qs)]
other-qs
footnote-qs
footnote-wraps)]
[_ (debug-report 'hard-quad-at-start)
(loop wraps
wrap-idx
@ -122,7 +155,9 @@
(list q)
(distance-func q 0 would-be-wrap-qs)
previous-wrap-ender
other-qs)])]
other-qs
footnote-qs
footnote-wraps)])]
[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))
@ -140,7 +175,9 @@
null
wrap-distance
previous-wrap-ender
other-qs)]
other-qs
footnote-qs
footnote-wraps)]
[(empty? next-wrap-head)
(define-values (next-wrap-qs other-qs)
(cond
@ -160,7 +197,9 @@
null
#false
(car next-wrap-qs)
other-qs)]
other-qs
footnote-qs
footnote-wraps)]
[else ; finish the wrap & reset the line without consuming a quad
(loop (cons (finish-wrap next-wrap-head previous-wrap-ender wrap-idx) wraps)
(wrap-count wrap-idx q)
@ -168,7 +207,9 @@
next-wrap-tail
(for/sum ([item (in-list next-wrap-tail)]) (distance item))
(car next-wrap-head)
qs)])]
qs
footnote-qs
footnote-wraps)])]
[(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
@ -178,7 +219,9 @@
null
wrap-distance
previous-wrap-ender
other-qs)]
other-qs
footnote-qs
footnote-wraps)]
[else
(debug-report 'would-not-overflow)
;; add to partial
@ -188,7 +231,9 @@
(cons q next-wrap-tail)
wrap-distance
previous-wrap-ender
other-qs)])])])))
other-qs
footnote-qs
footnote-wraps)])])])))
(define last-line-can-be-short? #t)
(define mega-penalty 1e8)
@ -198,7 +243,17 @@
(reverse (apply append (for/list ([n (in-range i j)])
(vector-ref pieces n)))))
(define (wrap-best qs max-distance-proc debug hard-break? soft-break? finish-wrap wrap-count distance-func initial-wrap-idx)
(define (wrap-best qs
footnote-qs
footnote-start-pred?
max-distance-proc
debug
hard-break?
soft-break?
finish-wrap
wrap-count
distance-func
initial-wrap-idx)
(for*/fold ([wrapss null]
[wrap-idx initial-wrap-idx]
[previous-wrap-ender #f]
@ -278,28 +333,28 @@
(define q-one (q #:size (pt 1 1) #:printable #t))
(define x (quad-copy q-one [elems '(#\x)]))
(define zwx (quad-copy q-zero
[printable (λ _ #t)]
[elems '(#\z)]))
[printable (λ _ #t)]
[elems '(#\z)]))
(define hyph (quad-copy q-one [elems '(#\-)]))
(define shy (quad-copy q-one
[printable (λ (q [sig #f])
(case sig
[(end) #t]
[else #f]))]
[elems '(#\-)]))
[printable (λ (q [sig #f])
(case sig
[(end) #t]
[else #f]))]
[elems '(#\-)]))
(define a (quad-copy q-one [elems '(#\a)]))
(define b (quad-copy q-one [elems '(#\b)]))
(define c (quad-copy q-one [elems '(#\c)]))
(define d (quad-copy q-one [elems '(#\d)]))
(define sp (quad-copy q-one
[printable (λ (q [sig #f])
(case sig
[(start end) #f]
[else #t]))]
[elems '(#\space)]))
[printable (λ (q [sig #f])
(case sig
[(start end) #f]
[else #t]))]
[elems '(#\space)]))
(define lbr (quad-copy q-one
[printable (λ _ #f)]
[elems '(#\newline)]))
[printable (λ _ #f)]
[elems '(#\newline)]))
(define (soft-break? q) (memv (car (quad-elems q)) '(#\space #\-)))
@ -318,9 +373,9 @@
(if (equal? (quad-elems atom) '(#\space))
(quad-copy sp)
(quad-copy q-one
[attrs (quad-attrs atom)]
[elems (quad-elems atom)]))) int debug
#:nicely nicely?))]
[attrs (quad-attrs atom)]
[elems (quad-elems atom)]))) int debug
#:nicely nicely?))]
#:when (and (list? x) (andmap quad? x)))
(list->string (map car (map quad-elems x))))
"|"))

6
quad/quadwriter/attrs.rkt
Unescape Escape View File

@ -174,7 +174,11 @@ Naming guidelines
page-margin-right
page-margin-gutter
footer-display))
footer-display
fn-ref
fn-text
fn-text-start))
(define (takes-dimension-string? k)
(and (memq k (list :page-width

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

@ -660,16 +660,27 @@
(quad-update! q [from-parent (or where (quad-from q))])
(cons q rest)])
(define ((col-finish-wrap col-quad) lns . _)
(define ((col-finish-wrap col-quad) lns q0 ending-q idx [fn-lines null])
(define reversed-fn-lines
(from-parent (for/list ([fn-line (in-list (reverse fn-lines))])
;; position bottom to top, in reverse
(quad-update! fn-line
[from 'nw]
[to 'sw])) 'sw))
(match lns
[(cons line _)
(list (quad-copy col-quad
;; move block attrs up, so they are visible in page wrap
[attrs (copy-block-attrs (quad-attrs line)
(hash-copy (quad-attrs col-quad)))]
[elems (from-parent (insert-blocks lns) 'nw)]))]
[elems (append (from-parent (insert-blocks lns) 'nw) reversed-fn-lines)]))]
[_ null]))
#|
constraint wrapping example
https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d9656046b/pdf/directory-require.rkt#L51
|#
;;
(define (column-wrap lines fn-lines vertical-height column-gap [column-quad q:column])
(unless (positive? vertical-height)
(raise-argument-error 'column-wrap "positive number" vertical-height))
@ -679,6 +690,7 @@
;; 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.
;; `col-wrap` should emit quads that are complete.
(verbose-quad-printing? #true)
(define cols (wrap lines vertical-height
#:soft-break #true
#:hard-break column-break-quad?
@ -686,19 +698,19 @@
#:distance (λ (q dist-so-far wrap-qs)
;; do trial block insertions
(sum-y (insert-blocks (reverse wrap-qs))))
#:finish-wrap (col-finish-wrap column-quad)))
(define reversed-fn-lines (match (reverse fn-lines)
[(? null?) null]
[reversed-fn-lines
(quad-update! (car reversed-fn-lines)
[from-parent 'sw])
(for/list ([fn-line (in-list reversed-fn-lines)])
(quad-update! fn-line
[from 'nw]
[to 'sw]))]))
#:finish-wrap (col-finish-wrap column-quad)
#:footnote-qs fn-lines
#:footnote-start-pred (λ (q) (and (quad-ref q :fn-text)
(not (quad-ref q :fn-text-start))))))
(define reversed-fn-lines
(from-parent (for/list ([fn-line (in-list (reverse fn-lines))])
;; position bottom to top, in reverse
(quad-update! fn-line
[from 'nw]
[to 'sw])) 'sw))
(quad-update! (car cols)
[elems (append (quad-elems (car cols)) reversed-fn-lines)])
(define col-spacer (quad-copy q:column-spacer [size (pt column-gap 100)]))
(define col-spacer (quad-copy q:column-spacer [size (pt column-gap (and 'arbitrary-irrelevant-value 100))]))
(add-between cols col-spacer))
(define ((page-finish-wrap make-page-quad path) cols q0 q page-idx)

Write Preview
Loading…
Cancel
Save