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 cee9c92e68
commit cf0d86b2a2
3 changed files with 513 additions and 510 deletions
Show Stats Download Patch File Download Diff File

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

@ -5,7 +5,6 @@
'(q ((flow "footnote")(fn-text "0")(font-size-adjust "80%")(line-heightr-adjust "70%")) "Leftover from previous footnote." (q ((break "para"))))
"Hello" '(q ((fn-ref "1")) "*")
'(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"))))

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

@ -68,14 +68,17 @@
(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))))
; 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)] [fn-qs null])
;; reverse because quads accumulated in reverse
;; wrap-triggering-q is ordinarily the last accumulated q
;; unless it's the last wrap, in which case it's #f
;; but we capture it separately because it's likely to get trimmed away by `nonprinting-at-end?`
;; 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))
(define has-footnotes? (pair? footnote-qs))
(apply finish-wrap-func
(reverse (dropf qs nonprinting-at-end?)) previous-wrap-ender wrap-triggering-q wrap-idx
(if has-footnotes? (list fn-qs) null)))
(wrap-proc qs
max-distance
debug
@ -90,7 +93,7 @@
footnote-leftover-proc
footnote-new-proc))
(define (wrap-first qs
(define (wrap-first qs
max-distance
debug
hard-break?
@ -151,7 +154,7 @@
[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)
(loop (cons (finish-wrap next-wrap-qs previous-wrap-ender wrap-idx (car next-wrap-qs) footnote-next-wrap) wraps)
(wrap-count wrap-idx q)
null
null
@ -159,12 +162,12 @@
(car next-wrap-qs)
other-qs
footnote-qs
footnote-next-wrap
null ; reset footnote-next-wrap
footnote-wraps
footnote-dist
0 ; reset footnote-dist
max-distance)]
[else ; finish the wrap & reset the line without consuming a quad
(loop (cons (finish-wrap next-wrap-head previous-wrap-ender wrap-idx) wraps)
(loop (cons (finish-wrap next-wrap-head previous-wrap-ender wrap-idx (car next-wrap-head) footnote-next-wrap) wraps)
(wrap-count wrap-idx q)
null
next-wrap-tail
@ -172,9 +175,9 @@
(car next-wrap-head)
qs
footnote-qs
footnote-next-wrap
null ; reset footnote-next-wrap
footnote-wraps
footnote-dist
0 ; reset footnote-dist
max-distance)]))
(with-handlers ([symbol? (λ (exn) (handle-hard-overflow))])
(let-values ([(max-distance footnote-next-wrap footnote-qs)
@ -280,15 +283,15 @@
footnote-dist
max-distance)])])))]))))
(define last-line-can-be-short? #t)
(define mega-penalty 1e8)
(define hyphen-penalty +inf.0)
(define max-consecutive-hyphens 1)
(define (pieces-sublist pieces i j)
(define last-line-can-be-short? #t)
(define mega-penalty 1e8)
(define hyphen-penalty +inf.0)
(define max-consecutive-hyphens 1)
(define (pieces-sublist pieces i j)
(reverse (apply append (for/list ([n (in-range i j)])
(vector-ref pieces n)))))
(define (wrap-best qs
(define (wrap-best qs
max-distance
debug
hard-break?
@ -311,8 +314,8 @@
(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)))
(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 finish-wrap)
(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 finish-wrap)
(define (penalty i j)
(cond
[(or (eq? i j) (> j (vector-length pieces-vec)))
@ -371,7 +374,7 @@
this-wrap-ender)))
(module+ test
(module+ test
(define q-zero (q #:size (pt 0 0)))
(define q-one (q #:size (pt 1 1) #:printable #t))
(define x (quad-copy q-one [elems '(#\x)]))
@ -441,9 +444,9 @@
lbr)))
(module+ test (require rackunit))
(module+ test (require rackunit))
#;(module+ test
#;(module+ test
(test-case
"kp linebreaking"
(define meg-is-an-ally (list a b c sp a b sp c d sp a b c d x)) ; "Meg is an ally."
@ -458,7 +461,7 @@
;; ally.
(list (list a b c) lbr (list a b sp c d) lbr (list a b c d x)))))
(module+ test
(module+ test
(test-begin
(test-case
"chars"
@ -605,3 +608,4 @@
(check-equal? (linewrap2 (list x x x sp x x) 2) (list (q x x) lbr (q x) lbr (q x x)))
(check-equal? (linewrap2 (list x x x sp x x) 3) (list (q x x x) lbr (q x x))))))

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

@ -654,9 +654,9 @@
(quad-update! q [from-parent (or where (quad-from q))])
(cons q rest)])
(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))])
(define ((col-finish-wrap col-quad) lns q0 ending-q idx [reversed-fn-lines null])
(define fn-lines
(from-parent (for/list ([fn-line (in-list reversed-fn-lines)])
;; position bottom to top, in reverse
(quad-update! fn-line
[from 'nw]
@ -667,7 +667,7 @@
;; 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 (append (from-parent (insert-blocks lns) 'nw) reversed-fn-lines)]))]
[elems (append (from-parent (insert-blocks lns) 'nw) fn-lines)]))]
[_ null]))
#|

Write Preview
Loading…
Cancel
Save