introduce quad shift

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"

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

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])))])