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

to be surprised

Browse Source
main
Matthew Butterick 6 years ago
parent 1241d97dea
commit 5d0ae09c3a
4 changed files with 48 additions and 53 deletions
Show Stats Download Patch File Download Diff File

14
quad/qtest/fark.rkt
Unescape Escape View File

@ -20,23 +20,21 @@ it's a
codeblock!
```
```
it's a
codeblock!
```
> A simple _hyphenation engine_ that uses the Knuth–Liang hyphenation algorithm originally developed for TeX. A simple _hyphenation engine_ that uses the Knuth–Liang hyphenation algorithm originally developed for TeX.
```
it's a
codeblock!
```
enated. To hyphenate words of
any length, use `#:min-length` `#f`.
A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
> A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
Certain word processors allow users to [insert soft
hyphens](http://practicaltypography.com/optional-hyphens.html) in their
text. A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
text.
A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
Certain word processors allow users to [insert soft
hyphens](http://practicaltypography.com/optional-hyphens.html) in their
text. A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).

49
quad/qtest/markdown.rkt
Unescape Escape View File

@ -24,7 +24,7 @@
(define-tag-function (blockquote attrs exprs)
(qexpr (list* '(display "block")
'(background-color "#eee")
'(background-color "#eee")
'(font "fira") '(fontsize "10") '(line-height "15")
'(border-width-top "0.5") '(border-color-top "gray") '(border-inset-top "8")
'(border-width-left "3") '(border-color-left "gray") '(border-inset-left "20")
@ -73,7 +73,7 @@
'(border-inset-top "10")
'(border-width-left "2") '(border-color-left "#669") '(border-inset-left "0")
'(border-inset-right "10") '(border-inset-bottom "-4")
'(inset-left "12") '(inset-right "12") '(inset-top "12") '(inset-bottom "24")
'(inset-left "12") '(inset-right "12") '(inset-top "12") '(inset-bottom "12")
attrs) new-exprs))
(define (list-base attrs exprs [bullet-val #f])
@ -313,14 +313,11 @@
#:out 'sw
#:offset (pt 0 (+ (quad-ref first-line 'inset-top 0)))
#:elems lines
;; this sizing approach doesn't work.
;; can't add inset-top and inset-bottom here because page composition has already happened.
;; therefore, resizing the block quads now will throw off the calculated page breaks.
#:size (pt (pt-x (size first-line)) ;
(+ (for/sum ([line (in-list lines)])
(pt-y (size line)))
(quad-ref first-line 'inset-top 0)
(quad-ref first-line 'inset-bottom 0)))
#:size (delay (pt (pt-x (size first-line)) ;
(+ (for/sum ([line (in-list lines)])
(pt-y (size line)))
(quad-ref first-line 'inset-top 0)
(quad-ref first-line 'inset-bottom 0))))
#:draw-start (λ (q doc)
;; adjust drawing coordinates for border inset
(match-define (list bil bit bir bib)
@ -357,7 +354,8 @@
(box-side (+ right (half bw-right)) bottom (- left (half bw-left)) bottom
(quad-ref first-line 'border-color-bottom) bw-bottom)
(box-side left (+ bottom (half bw-bottom)) left (- top (half bw-top))
(quad-ref first-line 'border-color-left) bw-left))))
(quad-ref first-line 'border-color-left) bw-left))
#:draw-end (λ (q doc) (draw-debug q doc "#6c6" "#9c9"))))
(define (contiguous-group-by pred xs)
@ -381,6 +379,10 @@
(wrap xs vertical-height
#:soft-break line-spacer?
#:wrap-anywhere? #t
#:distance (λ (q dist-so-far wrap-qs)
;; do trial block insertions
(for/sum ([x (in-list (insert-blocks wrap-qs))])
(pt-y (size x))))
#:finish-wrap (λ (lns q idx)
(list (struct-copy quad q:page
[attrs (let ([page-number idx]
@ -390,21 +392,15 @@
(split-path (path-replace-extension path #"")))
(hash-set! h 'doc-title (string-titlecase (path->string name)))
h)]
[elems lns])))))
(define (insert-blocks pages)
;; block recomposition happens after page composition because page breaks can happen between lines.
;; iow, the lines within a block may be split over multiple pages, each of which should be drawn
;; as a separate block
(for/list ([page (in-list pages)])
(define lines (quad-elems page))
(define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x 'display)) lines))
(define lines-and-blocks
(append* (for/list ([lines (in-list groups-of-lines)])
(match (quad-ref (car lines) 'display)
["block" (list (block-wrap lines))]
[_ lines]))))
(struct-copy quad page [elems lines-and-blocks])))
[elems (insert-blocks lns)])))))
(define (insert-blocks lines)
(define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x 'display)) lines))
(append* (for/list ([line-group (in-list groups-of-lines)])
(match (quad-ref (car line-group) 'display)
["block" (list (block-wrap line-group))]
[_ line-group]))))
(define (run xs path)
(define pdf (time-name make-pdf (make-pdf #:compress #t
@ -418,7 +414,6 @@
[x (time-name ->string-quad (map (λ (x) (->string-quad pdf x)) x))]
[x (time-name line-wrap (line-wrap x line-width))]
[x (time-name page-wrap (page-wrap x vertical-height path))]
[x (time-name insert-containers (insert-blocks x))]
[x (time-name position (position (struct-copy quad q:doc [elems x])))])
(time-name draw (draw x pdf))))

4
quad/qtest/typewriter.rkt
Unescape Escape View File

@ -32,7 +32,7 @@
[else #true]))
#:draw (λ (q doc)
(set! draw-counter (add1 draw-counter ))
(font-size doc (string->number (hash-ref (quad-attrs q) 'fontsize "12")))
(font-size doc (hash-ref (quad-attrs q) 'fontsize 12))
(let ([str (car (quad-elems q))])
(cond
[(hash-has-key? (quad-attrs q) 'link)
@ -51,7 +51,7 @@
[attrs (let ([h (quad-attrs q)]) (hash-set! h 'font charter) h)]
[elems (quad-elems q)]
[size (delay
(define fontsize (string->number (hash-ref (quad-attrs q) 'fontsize "12")))
(define fontsize (hash-ref (quad-attrs q) 'fontsize 12))
(define str (car (quad-elems q)))
(font-size doc fontsize)
(font doc (path->string charter))

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

@ -23,7 +23,9 @@
#:hard-break [hard-break? (λ (x) #f)]
#:soft-break [soft-break? (λ (x) #f)]
#:wrap-anywhere? [wrap-anywhere? #f]
#:finish-wrap [finish-wrap-proc (λ (xs q idx) (list xs))])
#:distance [distance-func (λ (q last-dist wrap-qs)
(+ last-dist (if (printable? q) (distance q) 0)))]
#:finish-wrap [finish-wrap-func (λ (xs q idx) (list xs))])
(define target-size-proc
(match target-size-proc-arg
[(? procedure? proc) proc]
@ -36,7 +38,7 @@
;; 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-proc (reverse (dropf qs nonprinting-at-end?)) wrap-triggering-q wrap-idx))
(finish-wrap-func (reverse (dropf qs nonprinting-at-end?)) wrap-triggering-q wrap-idx))
(let loop ([wraps null] ; list of (list of quads)
[wrap-idx 1] ; 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?`
@ -55,12 +57,12 @@
[(cons q other-qs)
(debug-report q 'next-q)
(debug-report (quad-elems q) 'next-q-elems)
(define would-be-wrap-qs (wrap-append (cons q next-wrap-tail) next-wrap-head))
(cond
[(hard-break? q)
(debug-report 'found-hard-break)
;; put hard break onto next-wrap-tail, and finish the wrap
(define wrap-qs (wrap-append (cons q next-wrap-tail) next-wrap-head))
(loop (cons (finish-wrap wrap-qs wrap-idx) wraps)
(loop (cons (finish-wrap would-be-wrap-qs wrap-idx) wraps)
(add1 wrap-idx)
null
null
@ -84,8 +86,8 @@
(distance q)
other-qs)])]
[else ; cases that require computing distance
(define dist (if (printable? q) (distance q) 0))
(define would-overflow? (and current-dist (> (+ dist current-dist) (target-size-proc q wrap-idx))))
(define cumulative-dist (distance-func q current-dist would-be-wrap-qs))
(define would-overflow? (> cumulative-dist (target-size-proc q wrap-idx)))
(cond
[would-overflow?
(cond
@ -105,7 +107,7 @@
wrap-idx
(wrap-append (cons q next-wrap-tail) next-wrap-head)
null
(+ dist current-dist)
cumulative-dist
other-qs)]
[(empty? next-wrap-head)
(debug-report 'would-overflow-hard-without-captured-break)
@ -129,7 +131,7 @@
wrap-idx
(wrap-append (cons q next-wrap-tail) next-wrap-head)
null
(+ dist current-dist)
cumulative-dist
other-qs)]
[else
(debug-report 'would-not-overflow)
@ -138,7 +140,7 @@
wrap-idx
next-wrap-head
(cons q next-wrap-tail)
(+ dist current-dist)
cumulative-dist
other-qs)])])])))
(define q-zero (q #:size (pt 0 0)))
@ -285,14 +287,14 @@
(define (visual-wrap str int [debug #f])
(string-join
(for/list ([x (in-list (linewrap (for/list ([c (in-string str)])
(define atom (q c))
(if (equal? (quad-elems atom) '(#\space))
(struct-copy quad sp)
(struct-copy quad q-one
[attrs (quad-attrs atom)]
[elems (quad-elems atom)]))) int debug))]
(define atom (q c))
(if (equal? (quad-elems atom) '(#\space))
(struct-copy quad sp)
(struct-copy quad q-one
[attrs (quad-attrs atom)]
[elems (quad-elems atom)]))) int debug))]
#:when (and (list? x) (andmap quad? x)))
(list->string (map car (map quad-elems x))))
(list->string (map car (map quad-elems x))))
"|"))
(module+ test

Write Preview
Loading…
Cancel
Save