diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index 5acb33e2..f35c0e79 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -179,6 +179,8 @@ Naming guidelines footer-display footer-text + page-repeat + fn-ref fn-text fn-text-start)) diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index d24e6c89..b5e8175e 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -153,22 +153,32 @@ (module+ test (check-equal? (quad-ref (convert-break-quad (qexpr->quad '(q ((break "page") (foo "bar"))))) 'foo) "bar")) +(define-quad draw-quad quad) +(define q:draw (q #:type draw-quad + #:from 'bo + #:to 'bi + #:id 'str + #:printable q:string-printable? + #:draw q:string-draw + #:draw-end q:string-draw-end)) + (define (convert-draw-quad q) - (quad-update! q - [draw (λ (q doc) - (save doc) - (match (quad-ref q :draw) - ["line" - (move-to doc (quad-ref q :x1) (quad-ref q :y1)) - (line-to doc (quad-ref q :x2) (quad-ref q :y2)) - (stroke doc "black")] - ["text" (move-to doc 0 0) - (q:string-draw q doc - #:origin (pt (quad-ref q :x 0) (quad-ref q :y 0)) - #:text (quad-ref q :text))] - [_ (void)]) - (restore doc))] - [size (pt 0 0)])) + (struct-copy draw-quad q:draw + [attrs #:parent quad (quad-attrs q)] + [draw #:parent quad (λ (q doc) + (save doc) + (match (quad-ref q :draw) + ["line" + (move-to doc (quad-ref q :x1) (quad-ref q :y1)) + (line-to doc (quad-ref q :x2) (quad-ref q :y2)) + (stroke doc "black")] + ["text" (move-to doc 0 0) + (q:string-draw q doc + #:origin (pt (quad-ref q :x 0) (quad-ref q :y 0)) + #:text (quad-ref q :text))] + [_ (void)]) + (restore doc))] + [size #:parent quad (pt 0 0)])) (define (convert-image-quad q) (define path-string (quad-ref q :image-file)) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index cb5a6e73..3222a946 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -171,7 +171,7 @@ [qs (time-log hyphenate (apply append (map handle-hyphenate qs)))] [qs (map generic->typed-quad qs)] [qs (drop-leading-breaks qs)] - [qs (extract-defined-quads qs)] + #;[qs (extract-defined-quads qs)] [qs (insert-first-line-indents qs)]) qs)) @@ -263,10 +263,19 @@ [size (pt line-wrap-size printable-height)])) (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype))) -(define (make-sections qs) +(define (apply-doc-repeaters secs repeaters) + secs) + +(define (make-sections all-qs) + (define-values (doc-repeaters nonrepeating-qs) + (partition (λ (q) (member (quad-ref q :page-repeat) '("all" "left" "right" "first" "rest"))) all-qs)) (for/fold ([sections-acc null] - #:result (reverse sections-acc)) - ([qs (in-list (filter-split qs section-break-quad?))]) + #:result (apply-doc-repeaters (reverse sections-acc) doc-repeaters)) + ([all-section-qs (in-list (filter-split nonrepeating-qs section-break-quad?))]) + + (define-values (section-repeaters qs) + (partition (λ (q) (member (quad-ref q :page-repeat) '("section" "section all" "section left" "section right" "section first" "section rest"))) all-section-qs)) + ;; section properties (match-define (list page-width page-height) (parse-page-size (and (pair? qs) (car qs)))) (match-define (list left-margin top-margin right-margin bottom-margin) @@ -292,13 +301,36 @@ (when insert-blank-page? (section-pages-used (add1 (section-pages-used)))) - (define section-pages (make-pages column-qs - left-margin - top-margin - gutter-margin - line-wrap-size - printable-width - printable-height)) + (define section-pages-without-repeaters (make-pages column-qs + left-margin + top-margin + gutter-margin + line-wrap-size + printable-width + printable-height)) + + ;; put in quads that repeat within the section + (define section-pages + (for/list ([page (in-list section-pages-without-repeaters)] + [page-num (in-naturals 1)] + [page-side (in-cycle ((if (eq? section-starting-side 'left) values reverse) '(left right)))]) + ;; the first page of the section is 1, + ;; so all the odd pages are the same side as the starting side + ;; and even pages are the opposite side + (define section-repeaters-for-this-page + (for/list ([repeater (in-list section-repeaters)] + #:when (let* ([val (quad-ref repeater :page-repeat)] + [sym (string->symbol (string-trim val #px"section\\s"))]) + (memq sym (list* + (if (= page-num 1) 'first 'rest) + page-side + '(section all))))) + repeater)) + (cond + [(null? section-repeaters-for-this-page) page] + [else + (quad-copy page + [elems (append section-repeaters-for-this-page (quad-elems page))])]))) (begin0 (cond