From 2ea1caae1319195fddcdf70e62aff34300e24cb3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 6 May 2019 21:49:35 -0700 Subject: [PATCH] on at --- quad/qtest/hyphenate.rkt | 4 +- quad/quad/position.rkt | 82 +++++++++++++++++------------------ quad/quad/quad.rkt | 36 ++++++++-------- quad/quadwriter/core.rkt | 91 ++++++++++++++++++++------------------- quad/quadwriter/param.rkt | 2 +- quad/quadwriter/tags.rkt | 6 +-- 6 files changed, 111 insertions(+), 110 deletions(-) diff --git a/quad/qtest/hyphenate.rkt b/quad/qtest/hyphenate.rkt index 492158e3..868d751d 100644 --- a/quad/qtest/hyphenate.rkt +++ b/quad/qtest/hyphenate.rkt @@ -14,9 +14,7 @@ At the command line: We said `raco pkg install hyphenate` dude - -enated. To hyphenate words of -any length, use `#:min-length` `#f`. +All right then. A [list of web colors](https://en.wikipedia.org/wiki/Web_colors). Certain word processors allow users to [insert soft diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 91e41a59..02915df9 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -57,17 +57,17 @@ [(or 'bi 'bo 'baseline-in 'baseline-out) (vertical-baseline-offset q)] [_ 0]))))) -(define (in-point q) +(define (at-point q) ;; calculate absolute location of in-point ;; based on current origin and point type. ;; don't include offset, so location is on bounding box - (anchor->global-point q (quad-in q))) + (anchor->global-point q (quad-at q))) -(define (out-point q) +(define (on-point q) ;; calculate absolute location of out-point ;; based on current origin and point type. ;; don't include offset, so location is on bounding box - (anchor->global-point q (quad-out q))) + (anchor->global-point q (quad-on q))) (define (anchor->global-point q anchor) ;; don't include shift here: it should be baked into origin calculation @@ -76,10 +76,10 @@ (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-out q))] + [(quad? ref-src) (anchor->global-point ref-src (quad-on q))] [ref-src] ; for passing explicit points in testing [else (pt 0 0)])) - (define this-origin (pt- ref-pt (in-point q))) + (define this-origin (pt- ref-pt (at-point q))) (define shifted-origin (pt+ this-origin (quad-shift q))) ;; need to position before recurring, so subquads have accurate reference point (define positioned-q (struct-copy quad q @@ -101,7 +101,7 @@ [(cons x rest) (loop (cons x prev-elems) rest)]))]))) (define (distance q) - (match (pt- (out-point q) (in-point q)) + (match (pt- (on-point q) (at-point q)) [(list-no-order 0 val) val] [(list ∆x ∆y) (sqrt (+ (expt ∆x 2) (expt ∆y 2)))])) @@ -111,14 +111,14 @@ "origins" (define size (pt 10 10)) (define orig (pt 5 5)) - (check-equal? (quad-origin (position (q #:in 'nw #:size size) orig)) (pt 5 5)) - (check-equal? (quad-origin (position (q #:in 'n #:size size) orig)) (pt 0 5)) - (check-equal? (quad-origin (position (q #:in 'ne #:size size) orig)) (pt -5 5)) - (check-equal? (quad-origin (position (q #:in 'e #:size size) orig)) (pt -5 0)) - (check-equal? (quad-origin (position (q #:in 'se #:size size) orig)) (pt -5 -5)) - (check-equal? (quad-origin (position (q #:in 's #:size size) orig)) (pt 0 -5)) - (check-equal? (quad-origin (position (q #:in 'sw #:size size) orig)) (pt 5 -5)) - (check-equal? (quad-origin (position (q #:in 'w #:size size) orig)) (pt 5 0))) + (check-equal? (quad-origin (position (q #:at 'nw #:size size) orig)) (pt 5 5)) + (check-equal? (quad-origin (position (q #:at 'n #:size size) orig)) (pt 0 5)) + (check-equal? (quad-origin (position (q #:at 'ne #:size size) orig)) (pt -5 5)) + (check-equal? (quad-origin (position (q #:at 'e #:size size) orig)) (pt -5 0)) + (check-equal? (quad-origin (position (q #:at 'se #:size size) orig)) (pt -5 -5)) + (check-equal? (quad-origin (position (q #:at 's #:size size) orig)) (pt 0 -5)) + (check-equal? (quad-origin (position (q #:at 'sw #:size size) orig)) (pt 5 -5)) + (check-equal? (quad-origin (position (q #:at 'w #:size size) orig)) (pt 5 0))) (test-case @@ -126,43 +126,43 @@ (define size (pt 10 10)) (define orig (pt 5 5)) (define shift (pt 3 3)) - (check-equal? (quad-origin (position (q #:in 'nw #:size size #:shift shift) orig)) (pt+ (pt 5 5) shift)) - (check-equal? (quad-origin (position (q #:in 'n #:size size #:shift shift) orig)) (pt+ (pt 0 5) shift)) - (check-equal? (quad-origin (position (q #:in 'ne #:size size #:shift shift) orig)) (pt+ (pt -5 5) shift)) - (check-equal? (quad-origin (position (q #:in 'e #:size size #:shift shift) orig)) (pt+ (pt -5 0) shift)) - (check-equal? (quad-origin (position (q #:in 'se #:size size #:shift shift) orig)) (pt+ (pt -5 -5) shift)) - (check-equal? (quad-origin (position (q #:in 's #:size size #:shift shift) orig)) (pt+ (pt 0 -5) shift)) - (check-equal? (quad-origin (position (q #:in 'sw #:size size #:shift shift) orig)) (pt+ (pt 5 -5) shift)) - (check-equal? (quad-origin (position (q #:in 'w #:size size #:shift shift) orig)) (pt+ (pt 5 0) shift))) + (check-equal? (quad-origin (position (q #:at 'nw #:size size #:shift shift) orig)) (pt+ (pt 5 5) shift)) + (check-equal? (quad-origin (position (q #:at 'n #:size size #:shift shift) orig)) (pt+ (pt 0 5) shift)) + (check-equal? (quad-origin (position (q #:at 'ne #:size size #:shift shift) orig)) (pt+ (pt -5 5) shift)) + (check-equal? (quad-origin (position (q #:at 'e #:size size #:shift shift) orig)) (pt+ (pt -5 0) shift)) + (check-equal? (quad-origin (position (q #:at 'se #:size size #:shift shift) orig)) (pt+ (pt -5 -5) shift)) + (check-equal? (quad-origin (position (q #:at 's #:size size #:shift shift) orig)) (pt+ (pt 0 -5) shift)) + (check-equal? (quad-origin (position (q #:at 'sw #:size size #:shift shift) orig)) (pt+ (pt 5 -5) shift)) + (check-equal? (quad-origin (position (q #:at 'w #:size size #:shift shift) orig)) (pt+ (pt 5 0) shift))) (test-case "in points" (define size '(10 10)) (define pos '(5 5)) - (check-equal? (in-point (q #:in 'nw #:size size #:origin pos)) (pt 5 5)) - (check-equal? (in-point (q #:in 'n #:size size #:origin pos)) (pt 10 5)) - (check-equal? (in-point (q #:in 'ne #:size size #:origin pos)) (pt 15 5)) - (check-equal? (in-point (q #:in 'w #:size size #:origin pos)) (pt 5 10)) - (check-equal? (in-point (q #:in 'c #:size size #:origin pos)) (pt 10 10)) - (check-equal? (in-point (q #:in 'e #:size size #:origin pos)) (pt 15 10)) - (check-equal? (in-point (q #:in 'sw #:size size #:origin pos)) (pt 5 15)) - (check-equal? (in-point (q #:in 's #:size size #:origin pos)) (pt 10 15)) - (check-equal? (in-point (q #:in 'se #:size size #:origin pos)) (pt 15 15))) + (check-equal? (at-point (q #:at 'nw #:size size #:origin pos)) (pt 5 5)) + (check-equal? (at-point (q #:at 'n #:size size #:origin pos)) (pt 10 5)) + (check-equal? (at-point (q #:at 'ne #:size size #:origin pos)) (pt 15 5)) + (check-equal? (at-point (q #:at 'w #:size size #:origin pos)) (pt 5 10)) + (check-equal? (at-point (q #:at 'c #:size size #:origin pos)) (pt 10 10)) + (check-equal? (at-point (q #:at 'e #:size size #:origin pos)) (pt 15 10)) + (check-equal? (at-point (q #:at 'sw #:size size #:origin pos)) (pt 5 15)) + (check-equal? (at-point (q #:at 's #:size size #:origin pos)) (pt 10 15)) + (check-equal? (at-point (q #:at 'se #:size size #:origin pos)) (pt 15 15))) (test-case "out points" (define size (pt 10 10)) (define pos (pt 5 5)) - (check-equal? (out-point (q #:out 'nw #:size size #:origin pos)) (pt 5 5)) - (check-equal? (out-point (q #:out 'n #:size size #:origin pos)) (pt 10 5)) - (check-equal? (out-point (q #:out 'ne #:size size #:origin pos)) (pt 15 5)) - (check-equal? (out-point (q #:out 'w #:size size #:origin pos)) (pt 5 10)) - (check-equal? (out-point (q #:out 'c #:size size #:origin pos)) (pt 10 10)) - (check-equal? (out-point (q #:out 'e #:size size #:origin pos)) (pt 15 10)) - (check-equal? (out-point (q #:out 'sw #:size size #:origin pos)) (pt 5 15)) - (check-equal? (out-point (q #:out 's #:size size #:origin pos)) (pt 10 15)) - (check-equal? (out-point (q #:out 'se #:size size #:origin pos)) (pt 15 15))) + (check-equal? (on-point (q #:on 'nw #:size size #:origin pos)) (pt 5 5)) + (check-equal? (on-point (q #:on 'n #:size size #:origin pos)) (pt 10 5)) + (check-equal? (on-point (q #:on 'ne #:size size #:origin pos)) (pt 15 5)) + (check-equal? (on-point (q #:on 'w #:size size #:origin pos)) (pt 5 10)) + (check-equal? (on-point (q #:on 'c #:size size #:origin pos)) (pt 10 10)) + (check-equal? (on-point (q #:on 'e #:size size #:origin pos)) (pt 15 10)) + (check-equal? (on-point (q #:on 'sw #:size size #:origin pos)) (pt 5 15)) + (check-equal? (on-point (q #:on 's #:size size #:origin pos)) (pt 10 15)) + (check-equal? (on-point (q #:on 'se #:size size #:origin pos)) (pt 15 15))) ) diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index 7c80c2c7..d72cb113 100644 --- a/quad/quad/quad.rkt +++ b/quad/quad/quad.rkt @@ -35,7 +35,7 @@ (define (quad=? q1 q2 [recur? #t]) (and ;; exclude attrs from initial comparison - (for/and ([getter (in-list (list quad-elems quad-size quad-in quad-out + (for/and ([getter (in-list (list quad-elems quad-size quad-on-parent quad-on quad-at quad-shift quad-offset quad-on-parent quad-origin quad-printable quad-draw-start quad-draw-end quad-draw))]) (equal? (getter q1) (getter q2))) @@ -50,9 +50,9 @@ ;; 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 - in ; alignment point on this quad that is matched to `out` on previous quad - out ; alignment point on ref quad on-parent ; position on parent quad? + on ; alignment point on ref quad + at ; alignment point on this quad that is matched to `out` on previous quad ;; offset, shift are two-dim pts ;; offset= Similar to `relative` CSS positioning ;; relocation of pen before quad is drawn. Does NOT change layout position. @@ -114,9 +114,9 @@ #:attrs [attrs (make-hasheq)] #:elems [elems null] #:size [size '(0 0)] - #:in [in 'nw] - #:out [out 'nw] #:on-parent [on-parent #false] + #:on [on 'nw] + #:at [at 'nw] #:shift [shift '(0 0)] #:offset [offset '(0 0)] #:origin [origin '(0 0)] @@ -134,19 +134,19 @@ [(list elems ..1) (make-quad #:elems elems)] ;; all cases end up below [null (define args (list - attrs - elems - size - in - out - on-parent - offset - shift - origin - printable - draw-start - draw - draw-end)) + attrs + elems + size + on-parent + on + at + offset + shift + origin + printable + draw-start + draw + draw-end)) (define id (eq-hash-code args)) (apply type (append args (list id)))])) diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index 1afdc6fb..dd3bbfd8 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -46,8 +46,8 @@ [_ #true])) (define q:string (q #:type string-quad - #:out 'bo - #:in 'bi + #:on 'bo + #:at 'bi #:on-parent #false #:printable q:string-printable? #:draw q:string-draw @@ -100,7 +100,7 @@ (stroke doc stroke-color) ;; draw in point & out point (both on layout box) (define point-draw-diameter (+ stroke-width 1.5)) - (for ([which-point (list in-point out-point)]) + (for ([which-point (list at-point on-point)]) (define pt (which-point q)) (circle doc (pt-x pt) (pt-y pt) point-draw-diameter) (fill doc fill-color)) @@ -110,15 +110,15 @@ (restore doc))) (define q:line (q #:size (pt 0 default-line-height) - #:out 'sw - #:in 'nw + #:on 'sw + #:at 'nw #:printable #true #:draw-start (if draw-debug-line? draw-debug void))) (struct line-spacer quad () #:transparent) (define q:line-spacer (q #:type line-spacer #:size (pt 0 (* default-line-height 0.6)) - #:out 'sw + #:on 'sw #:printable (λ (q sig) (not (memq sig '(start end)))) #:draw-start (if (draw-debug-line?) draw-debug void))) @@ -316,7 +316,7 @@ #:type offsetter #:offset (pt (quad-ref elem 'inset-left 0) 0) #:elems elems)))) - (attach-to-parent new-elems 'sw))]))] + (on-parent new-elems 'sw))]))] [_ null])])) (append new-lines (cond [ending-q null] @@ -390,24 +390,29 @@ (scale doc (if zoom-mode? zoom-scale 1) (if zoom-mode? zoom-scale 1))) (define (draw-page-footer q doc) - (define top-margin (pt-y (quad-offset q))) - (define bottom-margin (- (pdf-height doc) top-margin)) + (match-define (list x y) (quad-origin q)) (font-size doc (* .8 default-font-size)) (font doc default-font-face) (fill-color doc "black") - (text doc (format "~a · ~a at ~a" (hash-ref (quad-attrs q) 'page-number) - (hash-ref (quad-attrs q) 'doc-title) + (text doc (format "~a · ~a at ~a" (quad-ref q 'page-number 0) + (quad-ref q 'doc-title "untitled") (date->string (current-date) #t)) - (pt-x (quad-offset q)) - (+ (- (pdf-height doc) bottom-margin) 20))) - -(define (page-draw-end q doc) - #;(draw-page-footer q doc) - (void)) - -(define q:page (q #:offset '(0 0) - #:draw-start page-draw-start - #:draw-end page-draw-end)) + x y)) + +(define q:footer (q #:size (pt 50 default-line-height) + #:on-parent #true + #:on 'sw + #:at 'nw + #:shift (pt 0 default-line-height) + #:printable #true + #:draw-start (λ (q doc) + (when draw-debug-line? + (draw-debug q doc "goldenrod" "goldenrod")) + (draw-page-footer q doc)))) + +(define q:page (q + #:on-parent #true + #:draw-start page-draw-start)) (define q:doc (q #:draw-start (λ (q doc) (start-doc doc)) #:draw-end (λ (q doc) (end-doc doc)))) @@ -452,11 +457,11 @@ (define (block-wrap lines) (define first-line (car lines)) - (q #:out 'sw - #:in 'nw + (q #:on 'sw + #:at 'nw #:on-parent #false #:offset (pt 0 (+ (quad-ref first-line 'inset-top 0))) - #:elems (attach-to-parent lines 'nw) + #:elems (on-parent lines 'nw) #:size (delay (pt (pt-x (size first-line)) ; (+ (for/sum ([line (in-list lines)]) (pt-y (size line))) @@ -484,26 +489,24 @@ (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 (attach-to-parent qs where) +(define/match (on-parent qs [where #f]) ;; doesn't change any positioning. doesn't depend on state. can happen anytime. ;; can be repeated without damage. - (match qs - [(? null?) null] - [(cons q rest) - (cons (struct-copy quad q - [on-parent #true] - [out where]) rest)])) - -(define ((page-finish-wrap page-quad path) lns q0 q idx) + [((? null?) _) null] + [((cons q rest) where) + (cons (struct-copy quad q + [on-parent #true] + [on (or where (quad-on q))]) rest)]) + +(define ((page-finish-wrap page-quad path) lns q0 q page-idx) + (define-values (dir name _) (split-path (path-replace-extension path #""))) + (define footer (struct-copy quad q:footer + [attrs (let ([h (hash-copy (quad-attrs q:footer))]) + (hash-set! h 'page-number page-idx) + (hash-set! h 'doc-title (string-titlecase (path->string name))) + h)])) (list (struct-copy quad page-quad - [attrs (let ([page-number idx] - [h (hash-copy (quad-attrs page-quad))]) - (hash-set! h 'page-number page-number) - (define-values (dir name _) - (split-path (path-replace-extension path #""))) - (hash-set! h 'doc-title (string-titlecase (path->string name))) - h)] - [elems (attach-to-parent (insert-blocks lns) 'nw)]))) + [elems (cons footer (on-parent (insert-blocks lns) 'nw))]))) (define (page-wrap xs vertical-height [page-quad q:page]) (unless (positive? vertical-height) @@ -597,8 +600,8 @@ (make-pdf #:compress #t #:auto-first-page #f #:output-path pdf-path - #:width 350 - #:height 350 + #:width page-width + #:height page-height #:size (quad-ref (car qs) 'page-size default-page-size) #:orientation (quad-ref (car qs) 'page-orientation default-page-orientation)))) @@ -606,7 +609,7 @@ (define default-y-margin (min 72 (floor (* .10 (pdf-width pdf))))) (parameterize ([current-pdf pdf] [verbose-quad-printing? #false] - [draw-debug? #true]) + [draw-debug? #false]) (let* ([qs (time-name hyphenate (handle-hyphenate qs))] [qs (map ->string-quad qs)] [qs (insert-first-line-indents qs)] diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index 445f84a3..b5714693 100644 --- a/quad/quadwriter/param.rkt +++ b/quad/quadwriter/param.rkt @@ -6,5 +6,5 @@ (define draw-debug? (make-parameter #f)) (define draw-debug-line? (make-parameter #t)) -(define draw-debug-block? (make-parameter #f)) +(define draw-debug-block? (make-parameter #t)) (define draw-debug-string? (make-parameter #t)) \ 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))