main
Matthew Butterick 6 years ago
parent d32865a9eb
commit dc898971b0

@ -39,7 +39,7 @@
(define new-exprs (add-between
(for*/list ([expr (in-list exprs)]
[str (in-list (string-split (car (get-elements expr)) "\n"))])
`(,(get-tag expr) ,(get-attrs expr) ,str))
`(,(get-tag expr) ,(get-attrs expr) ,str))
lbr))
(qexpr attrs new-exprs))
@ -139,19 +139,31 @@
(define new-run (struct-copy quad q:string
[attrs (quad-attrs (car pcs))]
[elems (merge-adjacent-strings (apply append (for/list ([pc (in-list run-pcs)])
(quad-elems pc))))]
(quad-elems pc))))]
[size (delay (pt (for/sum ([pc (in-list run-pcs)])
(pt-x (size pc)))
(pt-x (size pc)))
(pt-y (size (car pcs)))))]))
(values (cons new-run runs) rest)))
(struct line-break quad () #:transparent)
(define (line-break-copy x as es)
(struct-copy line-break x
[attrs #:parent quad as]
[elems #:parent quad es]))
(define lbr (q #:type line-break
#:printable #f))
#:copier line-break-copy
#:printable #f
#:elems '("foo bar")))
(struct para-break line-break () #:transparent)
(define (para-break-copy x as es)
(struct-copy para-break x
[attrs #:parent quad as]
[elems #:parent quad es]))
(define pbr (q #:type para-break
#:printable #f))
#:copier para-break-copy
#:printable #f
#:elems '("¶¶")))
(module+ test
(check-true (line-break? (second (quad-elems (q "foo" pbr "bar")))))
@ -169,8 +181,8 @@
(define container-val (hash-ref (quad-attrs (car new-elems)) 'container #f))
(when (and container-val
(for/and ([elem (in-list (cdr new-elems))])
(equal? (hash-ref (quad-attrs elem) 'container #f)
container-val)))
(equal? (hash-ref (quad-attrs elem) 'container #f)
container-val)))
(hash-set! attrs 'container container-val))
attrs)]
[size (let ()
@ -213,7 +225,7 @@
#:elems pcs
#:size (delay (pt (pt-x (size (car pcs)))
(for/sum ([pc (in-list pcs)])
(pt-y (size pc)))))
(pt-y (size pc)))))
#:draw-start (λ (q doc)
(save doc)
(match-define (list left top) (quad-origin q))
@ -260,13 +272,13 @@
;; iow, the lines within a container may be split over multiple pages, each of which should be drawn
;; as a separate container
(for/list ([page (in-list pages)])
(define lns (quad-elems page))
(define groups (contiguous-group-by (λ (x) (hash-ref (quad-attrs x) 'container #f)) lns))
(define lns-and-containers (append* (for/list ([grp (in-list groups)])
(match (hash-ref (quad-attrs (car grp)) 'container #f)
["bq" (list (make-blockquote grp))]
[_ grp]))))
(struct-copy quad page [elems lns-and-containers])))
(define lns (quad-elems page))
(define groups (contiguous-group-by (λ (x) (hash-ref (quad-attrs x) 'container #f)) lns))
(define lns-and-containers (append* (for/list ([grp (in-list groups)])
(match (hash-ref (quad-attrs (car grp)) 'container #f)
["bq" (list (make-blockquote grp))]
[_ grp]))))
(struct-copy quad page [elems lns-and-containers])))
(define (run xs path)
(define pdf (time-name make-pdf (make-pdf #:compress #t

@ -74,7 +74,7 @@
;; also, they will not have any run keys embedded
;; (but they shouldn't need it because they're not part of text runs)
;; overall I am persuaded that `atomize` is very texty and needs a name befitting that role.
(list (make-quad #:attrs next-attrs #:elems (list elem)))]
(list ((quad-copier x) x next-attrs (list elem)))]
[_ (loop elem next-attrs next-key)])))]
[_ (list x)])))

@ -35,6 +35,7 @@
(hashes-equal? (quad-attrs q1) (quad-attrs q2))))
(struct quad (type
copier
attrs
elems
size
@ -72,6 +73,9 @@
;; todo: convert immutable hashes to mutable on input?
(define (make-quad
#:type [type quad]
#:copier [copier (λ (x as es) (struct-copy quad x
[attrs as]
[elems es]))]
#:attrs [attrs (make-hasheq)]
#:elems [elems null]
#:size [size '(0 0)]
@ -94,6 +98,7 @@
[(list elems ..1) (make-quad #:elems elems)]
;; all cases end up below
[null (type type
copier
attrs
elems
size

Loading…
Cancel
Save