From 11846f022ff85b695e827a316426221ecee37c95 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 7 May 2019 13:08:16 -0700 Subject: [PATCH] next: study block wrapping --- quad/qtest/fark.rkt | 7 +++- quad/quad/position.rkt | 12 +++--- quad/quad/quad.rkt | 5 ++- quad/quadwriter/core.rkt | 78 ++++++++++++++++++++------------------- quad/quadwriter/param.rkt | 56 +++++++++++++++++++++------- quad/quadwriter/tags.rkt | 6 +-- 6 files changed, 100 insertions(+), 64 deletions(-) diff --git a/quad/qtest/fark.rkt b/quad/qtest/fark.rkt index 805c54ad..fa6e176e 100644 --- a/quad/qtest/fark.rkt +++ b/quad/qtest/fark.rkt @@ -1,5 +1,8 @@ #lang quadwriter/markdown -# And +text -so \ No newline at end of file +``` +one +two +``` \ No newline at end of file diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 77097e52..e9791772 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -36,11 +36,11 @@ (define val (quad-ref q 'font-size current-default-font-size)) ((if (number? val) values string->number) val)) -(define (vertical-baseline-offset q) +(define (vertical-baseline-offset q [fallback-val 0]) (cond - [(quad-ref q font-path-key #false) + [(quad-ref q font-path-key) (* (/ (ascender q) (units-per-em q) 1.0) (fontsize q))] - [else 0])) + [else fallback-val])) (define (anchor->local-point q anchor) ;; calculate the location of the anchor on the bounding box relative to '(0 0) (aka "locally") @@ -54,7 +54,9 @@ (match-define (list x y) (size q)) (pt (coerce-int (* x x-fac)) (coerce-int (+ (* y y-fac) (match anchor - [(or 'bi 'bo 'baseline-in 'baseline-out) (vertical-baseline-offset q)] + [(or 'bi 'bo 'baseline-in 'baseline-out) + ;; if no font available, match baseline to south edge by passing y as fallback value + (vertical-baseline-offset q y)] [_ 0]))))) (define (to-point q) @@ -76,7 +78,7 @@ (define (position q [ref-src #f]) ;; recursively calculates coordinates for quad & subquads (define ref-pt (cond - [(quad? ref-src) (anchor->global-point ref-src (quad-from q))] + [(quad? ref-src) (anchor->global-point ref-src (or (quad-from-parent q) (quad-from q)))] [ref-src] ; for passing explicit points in testing [else (pt 0 0)])) (define this-origin (pt- ref-pt (to-point q))) diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index 1a98b2f1..2df773d2 100644 --- a/quad/quad/quad.rkt +++ b/quad/quad/quad.rkt @@ -49,8 +49,9 @@ elems ; subquads or text ;; size is a two-dim pt size ; outer size of quad for layout (though not necessarily the bounding box for drawing) - ;; in, out are phrased in terms of cardinal position - from-parent ; position on parent quad? + ;; from-parent, from, to are phrased in terms of cardinal position + from-parent ; alignment point on parent. if not #f, supersedes `from` + ;; (this way, `from` doens't change, so a quad can "remember" its default `from` attachment point) from ; alignment point on ref quad to ; alignment point on this quad that is matched to `from` on previous quad ;; shift-elements, shift are two-dim pts diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index f2d10418..f79e18ac 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -293,26 +293,28 @@ ;; with room for a bullet ;; which we just insert at the front. ;; this is safe because line has already been filled. - (let () - (define new-elems - (append - ;; only put bullet into line if we're at the first line of the list item - (match (and (eq? idx 1) (quad-ref elem 'list-index)) - [#false null] - [bullet - (list (struct-copy - quad q:string ;; copy q:string to get draw routine - ;; borrow attrs from elem - [attrs (quad-attrs elem)] - ;; use bullet as elems - [elems (list (if (number? bullet) (format "~a." bullet) bullet))] - ;; no size because it's inside inset - [size (pt 0 0)]))]) - (list (make-quad - #:type offsetter - #:shift-elements (pt (quad-ref elem 'inset-left 0) 0) - #:elems elems)))) - (on-parent new-elems 'sw))]))] + (append + ;; only put bullet into line if we're at the first line of the list item + (match (and (eq? idx 1) (quad-ref elem 'list-index)) + [#false null] + [bullet + (define bq (struct-copy + quad q:string ;; copy q:string to get draw routine + ;; borrow attrs from elem + [attrs (quad-attrs elem)] + ;; use bullet as elems + [elems (list (if (number? bullet) (format "~a." bullet) bullet))] + ;; size doesn't matter because nothing refers to this quad + ;; just for debugging box + [size (pt 15 (pt-y (size line-q)))])) + (from-parent (list bq) 'sw)]) + (cons (make-quad + #:draw-end q:string-draw-end + #:from-parent 'sw + #:to 'sw + #:size (pt (quad-ref elem 'inset-left 0) 5) + #:type offsetter) + elems))]))] [_ null])])) (append new-lines (cond [ending-q null] @@ -396,8 +398,7 @@ x y)) (define q:footer (q #:size (pt 50 default-line-height) - #:from-parent #true - #:from 'sw + #:from-parent 'sw #:to 'nw #:shift (pt 0 default-line-height) #:printable #true @@ -407,7 +408,7 @@ (draw-page-footer q doc)))) (define q:page (q - #:from-parent #true + #:from-parent 'nw #:draw-start page-draw-start)) (define q:doc (q #:draw-start (λ (q doc) (start-doc doc)) @@ -455,7 +456,7 @@ (define first-line (car lines)) (q #:from 'sw #:to 'nw - #:elems (on-parent lines 'nw) + #:elems (from-parent lines 'nw) #:size (delay (pt (pt-x (size first-line)) ; (+ (for/sum ([line (in-list lines)]) (pt-y (size line))) @@ -484,14 +485,13 @@ (contiguous-group-by values '(1 1 2 2 2 3 4 5 5 6 6 7 8 9)) '((1 1) (2 2 2) (3) (4) (5 5) (6 6) (7) (8) (9)))) -(define/match (on-parent qs [where #f]) +(define/match (from-parent qs [where #f]) ;; doesn't change any positioning. doesn't depend on state. can happen anytime. ;; can be repeated without damage. [((? null?) _) null] [((cons q rest) where) (cons (struct-copy quad q - [from-parent #true] - [from (or where (quad-from q))]) rest)]) + [from-parent (or where (quad-from q))]) rest)]) (define ((page-finish-wrap page-quad path) lns q0 q page-idx) (define-values (dir name _) (split-path (path-replace-extension path #""))) @@ -501,7 +501,7 @@ (hash-set! h 'doc-title (string-titlecase (path->string name))) h)])) (list (struct-copy quad page-quad - [elems (cons footer (on-parent (insert-blocks lns) 'nw))]))) + [elems (cons footer (from-parent (insert-blocks lns) 'nw))]))) (define (page-wrap xs vertical-height [page-quad q:page]) (unless (positive? vertical-height) @@ -585,12 +585,10 @@ ;; page size can be specified by name, or measurements. ;; explicit measurements from page-height and page-width supersede those from page-size. (define pdf - (let () - (match-define (list page-width page-height) - (for/list ([k '(page-width page-height)]) - (match (quad-ref (car qs) k) - [#false #false] - [val (parse-points val 'round)]))) + (match-let ([(list page-width page-height) (for/list ([k '(page-width page-height)]) + (match (quad-ref (car qs) k) + [#false #false] + [val (parse-points val 'round)]))]) ;; `make-pdf` will sort out conflicts among page dimensions (make-pdf #:compress #t #:auto-first-page #f @@ -608,14 +606,18 @@ [qs (map ->string-quad qs)] [qs (insert-first-line-indents qs)] ;; if only left or right margin is provided, copy other value in preference to default margin - [left-margin (quad-ref (car qs) 'page-margin-left (λ () (quad-ref (car qs) 'page-margin-right default-x-margin)))] - [right-margin (quad-ref (car qs) 'page-margin-right (λ () (quad-ref (car qs) 'page-margin-left default-y-margin)))] + [left-margin (or (debug-x-margin) + (quad-ref (car qs) 'page-margin-left (λ () (quad-ref (car qs) 'page-margin-right default-x-margin))))] + [right-margin (or (debug-x-margin) + (quad-ref (car qs) 'page-margin-right (λ () (quad-ref (car qs) 'page-margin-left default-y-margin))))] [line-wrap-size (- (pdf-width pdf) left-margin right-margin)] [qs (time-name line-wrap (line-wrap qs line-wrap-size))] [qs (apply-keeps qs)] ;; if only top or bottom margin is provided, copy other value in preference to default margin - [top-margin (quad-ref (car qs) 'page-margin-top (λ () (quad-ref (car qs) 'page-margin-bottom default-y-margin)))] - [bottom-margin (quad-ref (car qs) 'page-margin-bottom (λ () (quad-ref (car qs) 'page-margin-top default-y-margin)))] + [top-margin (or (debug-y-margin) + (quad-ref (car qs) 'page-margin-top (λ () (quad-ref (car qs) 'page-margin-bottom default-y-margin))))] + [bottom-margin (or (debug-y-margin) + (quad-ref (car qs) 'page-margin-bottom (λ () (quad-ref (car qs) 'page-margin-top default-y-margin))))] [page-wrap-size (- (pdf-height pdf) top-margin bottom-margin)] [page-quad (struct-copy quad q:page [shift (pt left-margin top-margin)] diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index 08efe8df..c285a0d2 100644 --- a/quad/quadwriter/param.rkt +++ b/quad/quadwriter/param.rkt @@ -1,14 +1,42 @@ -#lang debug racket/base -(provide (all-defined-out)) -(define current-doc (make-parameter #false)) -(define current-pdf (make-parameter #false)) -(define current-locale (make-parameter 'us)) - -(define draw-debug? (make-parameter #false)) -(define draw-debug-line? (make-parameter #true)) -(define draw-debug-block? (make-parameter #true)) -(define draw-debug-string? (make-parameter #true)) - -(define debug-page-width (make-parameter #f)) -(define debug-page-height (make-parameter #f)) -(define zoom-factor (make-parameter 1)) \ No newline at end of file +#lang debug racket +(define-for-syntax debug-mode #true) + +(define-syntax (go stx) + (syntax-case stx () + [_ + debug-mode + #'(begin + (provide (all-defined-out)) + (define current-doc (make-parameter #false)) + (define current-pdf (make-parameter #false)) + (define current-locale (make-parameter 'us)) + + (define draw-debug? (make-parameter #t)) + (define draw-debug-line? (make-parameter #true)) + (define draw-debug-block? (make-parameter #true)) + (define draw-debug-string? (make-parameter #true)) + + (define debug-page-width (make-parameter 400)) + (define debug-page-height (make-parameter 400)) + (define debug-x-margin (make-parameter 40)) + (define debug-y-margin (make-parameter 40)) + (define zoom-factor (make-parameter 3)))] + [_ + #'(begin + (provide (all-defined-out)) + (define current-doc (make-parameter #false)) + (define current-pdf (make-parameter #false)) + (define current-locale (make-parameter 'us)) + + (define draw-debug? (make-parameter #false)) + (define draw-debug-line? (make-parameter #true)) + (define draw-debug-block? (make-parameter #true)) + (define draw-debug-string? (make-parameter #true)) + + (define debug-page-width (make-parameter #f)) + (define debug-page-height (make-parameter #f)) + (define debug-x-margin (make-parameter #f)) + (define debug-y-margin (make-parameter 40)) + (define zoom-factor (make-parameter 1)))])) + +(go) \ No newline at end of file diff --git a/quad/quadwriter/tags.rkt b/quad/quadwriter/tags.rkt index 73278842..f42a0814 100644 --- a/quad/quadwriter/tags.rkt +++ b/quad/quadwriter/tags.rkt @@ -14,9 +14,9 @@ (qexpr (append `(#;(first-line-indent "12") #;(line-align "center") #;(line-wrap "kp") - #;(page-margin-left "120") - #;(page-margin-top "80") - #;(page-margin-bottom "120") + (page-margin-left "120") + (page-margin-top "80") + (page-margin-bottom "120") (line-height "17") #;(line-align-last "center")) attrs) exprs))