From 519192194fbc5cd7f761283469863a8391017841 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 3 May 2019 07:27:07 -0700 Subject: [PATCH] introduce quad shift --- quad/quad/position.rkt | 66 ++++++++++++++++++++-------------------- quad/quad/quad.rkt | 22 ++++++++++---- quad/quadwriter/core.rkt | 22 +++++++++----- 3 files changed, 63 insertions(+), 47 deletions(-) diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index b342529e..d6857424 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -61,25 +61,25 @@ ;; calculate absolute location of inner-point ;; based on current origin and point type. ;; include offset, because it's intended to adjust inner - (pt+ (quad-origin q) (anchor->local-point q (or (quad-inner q) (quad-in q))) (quad-offset q))) + (pt+ (quad-position q) (anchor->local-point q (or (quad-inner q) (quad-in q))) (quad-offset q))) (define (in-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 - (pt+ (quad-origin q) (anchor->local-point q (quad-in q)))) + (pt+ (quad-position q) (anchor->local-point q (quad-in q)))) (define (out-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 - (pt+ (quad-origin q) (anchor->local-point q (quad-out q)))) + (pt+ (quad-position q) (anchor->local-point q (quad-out q)))) (define (position q [previous-end-pt (pt 0 0)]) ;; recursively calculates coordinates for quad & subquads ;; based on starting origin point - (define new-origin (pt- previous-end-pt (in-point q))) - (let ([q (struct-copy quad q [origin new-origin])]) + (define new-position (pt+ (pt- previous-end-pt (in-point q)) (quad-shift q))) + (let ([q (struct-copy quad q [position new-position])]) (let loop ([pt (inner-point q)] [acc null] [elems (quad-elems q)]) (match elems [(== empty) (struct-copy quad q [elems (reverse acc)])] @@ -99,42 +99,42 @@ "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-position (position (q #:in 'nw #:size size) orig)) (pt 5 5)) + (check-equal? (quad-position (position (q #:in 'n #:size size) orig)) (pt 0 5)) + (check-equal? (quad-position (position (q #:in 'ne #:size size) orig)) (pt -5 5)) + (check-equal? (quad-position (position (q #:in 'e #:size size) orig)) (pt -5 0)) + (check-equal? (quad-position (position (q #:in 'se #:size size) orig)) (pt -5 -5)) + (check-equal? (quad-position (position (q #:in 's #:size size) orig)) (pt 0 -5)) + (check-equal? (quad-position (position (q #:in 'sw #:size size) orig)) (pt 5 -5)) + (check-equal? (quad-position (position (q #:in 'w #:size size) orig)) (pt 5 0))) (test-case "in points" (define size '(10 10)) - (define origin '(5 5)) - (check-equal? (in-point (q #:in 'nw #:size size #:origin origin)) (pt 5 5)) - (check-equal? (in-point (q #:in 'n #:size size #:origin origin)) (pt 10 5)) - (check-equal? (in-point (q #:in 'ne #:size size #:origin origin)) (pt 15 5)) - (check-equal? (in-point (q #:in 'w #:size size #:origin origin)) (pt 5 10)) - (check-equal? (in-point (q #:in 'c #:size size #:origin origin)) (pt 10 10)) - (check-equal? (in-point (q #:in 'e #:size size #:origin origin)) (pt 15 10)) - (check-equal? (in-point (q #:in 'sw #:size size #:origin origin)) (pt 5 15)) - (check-equal? (in-point (q #:in 's #:size size #:origin origin)) (pt 10 15)) - (check-equal? (in-point (q #:in 'se #:size size #:origin origin)) (pt 15 15))) + (define pos '(5 5)) + (check-equal? (in-point (q #:in 'nw #:size size #:position pos)) (pt 5 5)) + (check-equal? (in-point (q #:in 'n #:size size #:position pos)) (pt 10 5)) + (check-equal? (in-point (q #:in 'ne #:size size #:position pos)) (pt 15 5)) + (check-equal? (in-point (q #:in 'w #:size size #:position pos)) (pt 5 10)) + (check-equal? (in-point (q #:in 'c #:size size #:position pos)) (pt 10 10)) + (check-equal? (in-point (q #:in 'e #:size size #:position pos)) (pt 15 10)) + (check-equal? (in-point (q #:in 'sw #:size size #:position pos)) (pt 5 15)) + (check-equal? (in-point (q #:in 's #:size size #:position pos)) (pt 10 15)) + (check-equal? (in-point (q #:in 'se #:size size #:position pos)) (pt 15 15))) (test-case "out points" (define size (pt 10 10)) - (define origin (pt 5 5)) - (check-equal? (out-point (q #:out 'nw #:size size #:origin origin)) (pt 5 5)) - (check-equal? (out-point (q #:out 'n #:size size #:origin origin)) (pt 10 5)) - (check-equal? (out-point (q #:out 'ne #:size size #:origin origin)) (pt 15 5)) - (check-equal? (out-point (q #:out 'w #:size size #:origin origin)) (pt 5 10)) - (check-equal? (out-point (q #:out 'c #:size size #:origin origin)) (pt 10 10)) - (check-equal? (out-point (q #:out 'e #:size size #:origin origin)) (pt 15 10)) - (check-equal? (out-point (q #:out 'sw #:size size #:origin origin)) (pt 5 15)) - (check-equal? (out-point (q #:out 's #:size size #:origin origin)) (pt 10 15)) - (check-equal? (out-point (q #:out 'se #:size size #:origin origin)) (pt 15 15))) + (define pos (pt 5 5)) + (check-equal? (out-point (q #:out 'nw #:size size #:position pos)) (pt 5 5)) + (check-equal? (out-point (q #:out 'n #:size size #:position pos)) (pt 10 5)) + (check-equal? (out-point (q #:out 'ne #:size size #:position pos)) (pt 15 5)) + (check-equal? (out-point (q #:out 'w #:size size #:position pos)) (pt 5 10)) + (check-equal? (out-point (q #:out 'c #:size size #:position pos)) (pt 10 10)) + (check-equal? (out-point (q #:out 'e #:size size #:position pos)) (pt 15 10)) + (check-equal? (out-point (q #:out 'sw #:size size #:position pos)) (pt 5 15)) + (check-equal? (out-point (q #:out 's #:size size #:position pos)) (pt 10 15)) + (check-equal? (out-point (q #:out 'se #:size size #:position pos)) (pt 15 15))) (test-case "inner points" diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index da6bf2e9..32e89f7c 100644 --- a/quad/quad/quad.rkt +++ b/quad/quad/quad.rkt @@ -29,7 +29,7 @@ (and ;; exclude attrs from initial comparison (for/and ([getter (in-list (list quad-elems quad-size quad-in quad-out quad-inner - quad-offset quad-origin quad-printable + quad-shift quad-offset quad-position quad-printable quad-draw-start quad-draw-end quad-draw))]) (equal? (getter q1) (getter q2))) ;; and compare them key-by-key @@ -45,9 +45,17 @@ in ; alignment point matched to previous quad out ; alignment point matched to next quad inner ; alignment point for elems (might be different from in/out) - ;; offset, origin are two-dim pts - offset ; relocation of pen before quad is drawn - origin ; reference point for all subsequent drawing ops in the quad. Calculated, not set directly + ;; offset, shift are two-dim pts + ;; offset= Similar to `relative` CSS positioning + ;; relocation of pen before quad is drawn. Does NOT change layout position. + ;; meaning, in and out points don't move, just the drawing. + offset + ;; shift = shift between previous out point and current in point. + ;; DOES change the layout position. + shift + ;; reference point (in absolute coordinates) + ;; for all subsequent drawing ops in the quad. Calculated, not set directly + position printable ; whether the quad will print draw-start ; func called at the beginning of every draw event (for setup ops) draw ; func called in the middle of every daw event @@ -99,8 +107,9 @@ #:in [in 'nw] #:out [out 'ne] #:inner [inner #f] + #:shift [shift '(0 0)] #:offset [offset '(0 0)] - #:origin [origin '(0 0)] + #:position [position '(0 0)] #:printable [printable default-printable] #:draw-start [draw-start void] #:draw [draw default-draw] @@ -120,8 +129,9 @@ in out inner + shift offset - origin + position printable draw-start draw diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index ca46f5dd..f4da2b25 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -24,7 +24,7 @@ (font-size doc (quad-ref q 'font-size 12)) (fill-color doc (quad-ref q 'color "black")) (define str (unsafe-car (quad-elems q))) - (match-define (list x y) (quad-origin q)) + (match-define (list x y) (quad-position q)) (text doc str x y #:tracking (quad-ref q 'character-tracking 0) #:bg (quad-ref q 'bg) @@ -86,15 +86,21 @@ [size (make-size-promise q)])])) -(define (draw-debug q doc [fill-color "#f99"] [stroke-color "#fcc"] [the-width 0.5]) +(define (draw-debug q doc [fill-color "#f99"] [stroke-color "#fcc"] [width 0.5]) + ;; ostensibly it would be possible to control draw-debug with a quad attribute + ;; but that would potentially mess up unit tests (because something has to be inserted in the data) + ;; therefore controlling debug state with a parameter is cleaner. (when (draw-debug?) (save doc) - (line-width doc the-width) - (apply rect doc (append (pt+ (quad-origin q) (quad-offset q)) (size q))) + ;; draw layout box + (line-width doc width) + (apply rect doc (append (pt+ (quad-position q)) (size q))) (stroke doc stroke-color) + ;; draw in point & out point (both on layout box) (circle doc (pt-x (in-point q)) (pt-y (in-point q)) 2) (circle doc (pt-x (out-point q)) (pt-y (out-point q)) 2) - (fill doc fill-color) + (fill doc fill-color) + ;; draw inner point (adjusted by offset) (rect-centered doc (pt-x (inner-point q)) (pt-y (inner-point q)) 2) (fill doc stroke-color) (restore doc))) @@ -234,7 +240,7 @@ (define-quad offsetter quad ()) (define (hr-draw dq doc) - (match-define (list left top) (quad-origin dq)) + (match-define (list left top) (quad-position dq)) (match-define (list right bottom) (size dq)) (save doc) (translate doc left (+ top (/ bottom 2))) @@ -400,7 +406,7 @@ (match-define (list bil bit bir bib) (for/list ([k (in-list '(border-inset-left border-inset-top border-inset-right border-inset-bottom))]) (quad-ref first-line k 0))) - (match-define (list left top) (pt+ (quad-origin q) (list bil bit))) + (match-define (list left top) (pt+ (quad-position q) (list bil bit))) (match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib)))) ;; fill rect (cond @@ -592,7 +598,7 @@ [bottom-margin (quad-ref (car qx) 'page-margin-bottom (λ () (quad-ref (car qx) 'page-margin-top default-y-margin)))] [page-wrap-size (- (pdf-height pdf) top-margin bottom-margin)] [page-quad (struct-copy quad q:page - [offset (pt left-margin top-margin)] + [shift #R (pt left-margin top-margin)] [size (pt line-wrap-size page-wrap-size)])] [qx (time-name page-wrap (page-wrap qx page-wrap-size page-quad))] [qx (time-name position (position (struct-copy quad q:doc [elems qx])))])