From 7ef031b978236fb3982e8f9dea4f469861038a66 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 26 Aug 2019 14:02:37 -0700 Subject: [PATCH] start footnote algorithm --- quad/qtest/demo-footnotes.rkt | 8 +-- quad/quad/wrap.rkt | 121 ++++++++++++++++++++++++---------- quad/quadwriter/attrs.rkt | 6 +- quad/quadwriter/layout.rkt | 38 +++++++---- 4 files changed, 122 insertions(+), 51 deletions(-) diff --git a/quad/qtest/demo-footnotes.rkt b/quad/qtest/demo-footnotes.rkt index 7deeb47d..ead6b6a7 100644 --- a/quad/qtest/demo-footnotes.rkt +++ b/quad/qtest/demo-footnotes.rkt @@ -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." \ No newline at end of file diff --git a/quad/quad/wrap.rkt b/quad/quad/wrap.rkt index fb58587e..ea120f8c 100644 --- a/quad/quad/wrap.rkt +++ b/quad/quad/wrap.rkt @@ -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)))) "|")) diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index 19662fce..c48d5670 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -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 diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index a4e4abc3..e3117df7 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -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)