repo man

quad/qtest/fark.rkt

@@ -1,3 +1,3 @@
-#lang quadwriter
+#lang quadwriter/markdown
 
-Hello world
+Hi there

quad/quad/position.rkt

@@ -57,36 +57,48 @@
                                    [(or 'bi 'bo 'baseline-in 'baseline-out) (vertical-baseline-offset q)]
                                    [_ 0])))))
 
-(define (inner-point q)
-  ;; calculate absolute location of inner-point
-  ;; based on current origin and point type.
-  ;; include offset, because it's intended to adjust inner 
-  (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-position q) (anchor->local-point q (quad-in q))))
+  (anchor->global-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-position q) (anchor->local-point q (quad-out q))))
+  (anchor->global-point q (quad-out q)))
+
+(define (anchor->global-point q anchor)
+  ;; don't include shift here: it should be baked into origin calculation
+  (pt+ (anchor->local-point q anchor) (quad-origin q)))
 
-(define (position q [previous-end-pt (pt 0 0)])
+(define (position q [ref-src #f])
   ;; recursively calculates coordinates for quad & subquads
-  ;; based on starting origin point
-  (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)])]
-        [(cons (? quad? q) rest)
-         (define new-q (position q pt))
-         (loop (out-point new-q) (cons new-q acc) rest)]
-        [(cons x rest) (loop pt (cons x acc) rest)]))))
+  (define ref-pt (cond
+                   [(quad? ref-src) (anchor->global-point ref-src (quad-out q))]
+                   [ref-src] ; for passing explicit points in testing
+                   [else (pt 0 0)]))
+  (define this-origin (pt- ref-pt (in-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
+                                    [origin shifted-origin]
+                                    ;; set shift to zero because it's baked into new origin value
+                                    [shift (pt 0 0)]))
+  (let ([parent-q positioned-q])
+    (struct-copy quad parent-q
+                 [elems
+                  ;; can't use for/list here because previous quads provide context for later ones
+                  (let loop ([prev-elems null] [elems (quad-elems parent-q)])
+                          (match elems
+                            [(? null?) (reverse prev-elems)]
+                            [(cons (? quad? this-q) rest)
+                             (define ref-q (if (or (quad-on-parent this-q) (null? prev-elems))
+                                               parent-q
+                                               (car prev-elems)))
+                             (loop (cons (position this-q ref-q) prev-elems) rest)]
+                            [(cons x rest) (loop (cons x prev-elems) rest)]))])))
 
 (define (distance q)
   (match (pt- (out-point q) (in-point q))
@@ -99,69 +111,60 @@
    "origins"
    (define size (pt 10 10))
    (define orig (pt 5 5))
-   (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)))
+   (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)))
+
+  
+  (test-case
+   "origins with shifts"
+   (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)))
 
   (test-case
    "in points"
    (define size '(10 10))
    (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)))
+   (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)))
+
 
   (test-case
    "out points"
    (define size (pt 10 10))
    (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"
-   (define size '(20 20))
-   (define orig '(10 10))
-   (check-equal? (inner-point (position (q #:size size #:inner 'nw) orig)) (pt 10 10))
-   (check-equal? (inner-point (position (q #:size size #:inner 'n) orig)) (pt 20 10))
-   (check-equal? (inner-point (position (q #:size size #:inner 'ne) orig)) (pt 30 10))
-   (check-equal? (inner-point (position (q #:size size #:inner 'e) orig)) (pt 30 20))
-   (check-equal? (inner-point (position (q #:size size #:inner 'se) orig)) (pt 30 30))
-   (check-equal? (inner-point (position (q #:size size #:inner 's) orig)) (pt 20 30))
-   (check-equal? (inner-point (position (q #:size size #:inner 'sw) orig)) (pt 10 30))
-   (check-equal? (inner-point (position (q #:size size #:inner 'w) orig)) (pt 10 20)))
-
-  (test-case
-   "inner points with offsets"
-   (define size (pt 10 10))
-   (define orig (pt 0 0))
-   (define off (pt (random 100) (random 100)))
-   (check-equal? (inner-point (position (q #:size size #:inner 'nw #:offset off) orig)) (pt+ '(0 0) off))
-   (check-equal? (inner-point (position (q #:size size #:inner 'n #:offset off) orig)) (pt+ '(5 0) off))
-   (check-equal? (inner-point (position (q #:size size #:inner 'ne #:offset off) orig)) (pt+ '(10 0) off))
-   (check-equal? (inner-point (position (q #:size size #:inner 'e #:offset off) orig)) (pt+ '(10 5) off))
-   (check-equal? (inner-point (position (q #:size size #:inner 'se #:offset off) orig)) (pt+ '(10 10) off))
-   (check-equal? (inner-point (position (q #:size size #:inner 's #:offset off) orig)) (pt+ '(5 10) off))
-   (check-equal? (inner-point (position (q #:size size #:inner 'sw #:offset off) orig)) (pt+ '(0 10) off))
-   (check-equal? (inner-point (position (q #:size size #:inner 'w #:offset off) orig)) (pt+ '(0 5) off))))
+   (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)))
+
+  )
 
 #;(module+ test
     (require racket/runtime-path fontland/font)

quad/quad/quad.rkt

@@ -30,15 +30,15 @@
 (define (hashes-equal? h1 h2)
   (and (= (length (hash-keys h1)) (length (hash-keys h2)))
        (for/and ([(k v) (in-hash h1)])
-                (and (hash-has-key? h2 k) (equal? (hash-ref h2 k) v)))))
+         (and (hash-has-key? h2 k) (equal? (hash-ref h2 k) v)))))
 
 (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 quad-inner
-                                    quad-shift quad-offset quad-position quad-printable
+   (for/and ([getter (in-list (list quad-elems quad-size quad-in quad-out 
+                                    quad-shift quad-offset quad-on-parent quad-origin quad-printable
                                     quad-draw-start quad-draw-end quad-draw))])
-            (equal? (getter q1) (getter q2)))
+     (equal? (getter q1) (getter q2)))
    ;; and compare them key-by-key
    (hashes-equal? (quad-attrs q1) (quad-attrs q2))))
 
@@ -49,10 +49,10 @@
               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, inner are phrased in terms of cardinal position
-              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)
+              ;; 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?
               ;; offset, shift are two-dim pts
               ;; offset= Similar to `relative` CSS positioning
               ;; relocation of pen before quad is drawn. Does NOT change layout position.
@@ -63,20 +63,22 @@
               shift
               ;; reference point (in absolute coordinates)
               ;; for all subsequent drawing ops in the quad. Calculated, not set directly
-              position 
+              origin 
               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
               draw-end ; func called at the end of every draw event (for teardown ops)
+              id
               )
   #:transparent
   #:property prop:custom-write
   (λ (q p w?) (display
-               (format "<~a~a~a>"
+               (format "<~a-~a~a~a>"
                        (object-name q)
+                       (quad-id q)
                        (if (verbose-quad-printing?)
                            (string-join (map ~v (flatten (hash->list (quad-attrs q))))
-                                    " " #:before-first "(" #:after-last ")")
+                                        " " #:before-first "(" #:after-last ")")
                            "")
                        (match (quad-elems q)
                          [(? pair?) (string-join (map ~v (quad-elems q)) " " #:before-first " ")]
@@ -113,11 +115,11 @@
          #:elems [elems null]
          #:size [size '(0 0)]
          #:in [in 'nw]
-         #:out [out 'ne]
-         #:inner [inner #f]
+         #:out [out 'nw]
+         #:on-parent [on-parent #false]
          #:shift [shift '(0 0)]
          #:offset [offset '(0 0)]
-         #:position [position '(0 0)]
+         #:origin [origin '(0 0)]
          #:printable [printable default-printable]
          #:draw-start [draw-start void]
          #:draw [draw default-draw]
@@ -131,19 +133,22 @@
     [(list (? dict? assocs) elems ...) assocs (make-quad #:attrs (make-hasheq assocs) #:elems elems)]
     [(list elems ..1) (make-quad #:elems elems)]
     ;; all cases end up below
-    [null (type attrs
-                elems
-                size
-                in
-                out
-                inner
-                offset
-                shift
-                position
-                printable
-                draw-start
-                draw
-                draw-end)]))
+    [null (define args (list
+                              attrs
+                              elems
+                              size
+                              in
+                              out
+                              on-parent
+                              offset
+                              shift
+                              origin
+                              printable
+                              draw-start
+                              draw
+                              draw-end))
+          (define id (eq-hash-code args))
+          (apply type (append args (list id)))]))
 
 (define-syntax (define-quad stx)
   (syntax-case stx ()

quad/quadwriter/core.rkt

@@ -25,7 +25,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-position q))
+    (match-define (list x y) (quad-origin q))
     (text doc str x y
           #:tracking (quad-ref q 'character-tracking 0)
           #:bg (quad-ref q 'bg)
@@ -46,8 +46,9 @@
     [_ #true]))
 
 (define q:string (q #:type string-quad
-                    #:in 'baseline-in
-                    #:out 'baseline-out
+                    #:out 'bo
+                    #:in 'bi
+                    #:on-parent #false
                     #:printable q:string-printable?
                     #:draw q:string-draw
                     #:draw-end q:string-draw-end))
@@ -95,7 +96,7 @@
     (save doc)
     ;; draw layout box
     (line-width doc stroke-width)
-    (apply rect doc (append (pt+ (quad-position q)) (size q)))
+    (apply rect doc (append (pt+ (quad-origin q)) (size q)))
     (stroke doc stroke-color)
     ;; draw in point & out point (both on layout box)
     (define point-draw-diameter (+ stroke-width 1.5))
@@ -104,13 +105,13 @@
       (circle doc (pt-x pt) (pt-y pt) point-draw-diameter)
       (fill doc fill-color))
     ;; draw inner point (adjusted by offset)
-    (rect-centered doc (pt-x (inner-point q)) (pt-y (inner-point q)) point-draw-diameter)
-    (fill doc stroke-color)  
+    #;(rect-centered doc (pt-x (inner-point q)) (pt-y (inner-point q)) point-draw-diameter)
+    #;(fill doc stroke-color)  
     (restore doc)))
 
 (define q:line (q #:size (pt 0 default-line-height)
-                  #:inner 'sw
                   #:out 'sw
+                  #:in 'nw
                   #:printable #true
                   #:draw-start (if draw-debug-line? draw-debug void)))
 
@@ -243,7 +244,7 @@
 (define-quad offsetter quad ())
 
 (define (hr-draw dq doc)
-  (match-define (list left top) (quad-position dq))
+  (match-define (list left top) (quad-origin dq))
   (match-define (list right bottom) (size dq))
   (save doc)
   (translate doc left (+ top (/ bottom 2)))
@@ -262,61 +263,64 @@
   (define pcs-printing (for/list ([pc (in-list pcs-in)]
                                   #:unless (equal? (quad-elems pc) '("\u00AD")))
                          pc))
-  (append
-   (cond
-     [(empty? pcs-printing) null]
-     [(hr-break? ending-q) (list (make-hr-quad line-q))]
-     [else
-      ;; render hyphen first so that all printable characters are available for size-dependent ops.
-      (define pcs-with-hyphen (render-hyphen pcs-printing ending-q))
-      ;; fill wrap so that consolidate-runs works properly
-      ;; (justified lines won't be totally consolidated)
-      (define pcs (fill-wrap pcs-with-hyphen ending-q line-q))
-      (match (consolidate-runs pcs ending-q)
-        [(? pair? elems)
-         (define elem (unsafe-car elems))
-         (match-define (list line-width line-height) (quad-size line-q))
-         (define new-size (let ()
-                            (define line-heights
-                              (filter-map (λ (q) (quad-ref q 'line-height)) pcs))
-                            (pt line-width (if (empty? line-heights) line-height (apply max line-heights)))))
-         (list
-          (struct-copy
-           quad line-q
-           ;; move block attrs up, so they are visible in page wrap
-           [attrs (copy-block-attrs (quad-attrs elem)
-                                    (hash-copy (quad-attrs line-q)))]
-           ;; line width is static
-           ;; line height is the max 'line-height value or the natural height of q:line
-           [size new-size]
-           ;; handle list indexes. drop new quad into line to hold list index
-           ;; could also use this for line numbers
-           [elems
-            ;; we assume here that a list item has already had extra inset-left
-            ;; with room for a bullet
-            ;; which we just insert at the front.
-            ;; this is safe because line has already been filled.
-            (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
-                    #:offset (pt (quad-ref elem 'inset-left 0) 0)
-                    #:elems elems)))]))]
-        [_ null])])
-   (cond
-     [ending-q null]
-     [else (list q:line-spacer)])))
+  (define new-lines
+    (cond
+      [(empty? pcs-printing) null]
+      [(hr-break? ending-q) (list (make-hr-quad line-q))]
+      [else
+       ;; render hyphen first so that all printable characters are available for size-dependent ops.
+       (define pcs-with-hyphen (render-hyphen pcs-printing ending-q))
+       ;; fill wrap so that consolidate-runs works properly
+       ;; (justified lines won't be totally consolidated)
+       (define pcs (fill-wrap pcs-with-hyphen ending-q line-q))
+       (match (consolidate-runs pcs ending-q)
+         [(? pair? elems)
+          (define elem (unsafe-car elems))
+          (match-define (list line-width line-height) (quad-size line-q))
+          (define new-size (let ()
+                             (define line-heights
+                               (filter-map (λ (q) (quad-ref q 'line-height)) pcs))
+                             (pt line-width (if (empty? line-heights) line-height (apply max line-heights)))))
+          (list
+           (struct-copy
+            quad line-q
+            ;; move block attrs up, so they are visible in page wrap
+            [attrs (copy-block-attrs (quad-attrs elem)
+                                     (hash-copy (quad-attrs line-q)))]
+            ;; line width is static
+            ;; line height is the max 'line-height value or the natural height of q:line
+            [size new-size]
+            ;; handle list indexes. drop new quad into line to hold list index
+            ;; could also use this for line numbers
+            [elems
+             ;; we assume here that a list item has already had extra inset-left
+             ;; 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
+                         #:offset (pt (quad-ref elem 'inset-left 0) 0)
+                         #:elems elems))))
+               (attach-to-parent new-elems 'sw))]))]
+         [_ null])]))
+  (append new-lines (cond
+                      [ending-q null]
+                      [else (list q:line-spacer)])))
 
 (define (line-wrap qs wrap-size)
   (unless (positive? wrap-size)
@@ -398,7 +402,8 @@
         (+ (- (pdf-height doc) bottom-margin) 20)))
 
 (define (page-draw-end q doc)
-  (draw-page-footer q doc))
+  #;(draw-page-footer q doc)
+  (void))
 
 (define q:page (q #:offset '(0 0)
                   #:draw-start page-draw-start
@@ -412,7 +417,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-position q) (list bil bit)))
+  (match-define (list left top) (pt+ (quad-origin q) (list bil bit)))
   (match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib))))
   ;; fill rect
   (cond 
@@ -447,10 +452,11 @@
 
 (define (block-wrap lines)
   (define first-line (car lines)) 
-  (q #:in 'nw
-     #:out 'sw
+  (q #:out 'sw
+     #:in 'nw
+     #:on-parent #false
      #:offset (pt 0 (+ (quad-ref first-line 'inset-top 0)))
-     #:elems lines
+     #:elems (attach-to-parent lines 'nw)
      #:size (delay (pt (pt-x (size first-line)) ; 
                        (+ (for/sum ([line (in-list lines)])
                             (pt-y (size line)))
@@ -478,6 +484,16 @@
    (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)
+  ;; 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)
   (list (struct-copy quad page-quad
                      [attrs (let ([page-number idx]
@@ -487,7 +503,7 @@
                                 (split-path (path-replace-extension path #"")))
                               (hash-set! h 'doc-title (string-titlecase (path->string name)))
                               h)]
-                     [elems (insert-blocks lns)])))
+                     [elems (attach-to-parent (insert-blocks lns) 'nw)])))
 
 (define (page-wrap xs vertical-height [page-quad q:page])
   (unless (positive? vertical-height)
@@ -581,8 +597,8 @@
       (make-pdf #:compress #t
                 #:auto-first-page #f
                 #:output-path pdf-path
-                #:width page-width
-                #:height page-height
+                #:width 350
+                #:height 350
                 #:size (quad-ref (car qs) 'page-size default-page-size)
                 #:orientation (quad-ref (car qs) 'page-orientation default-page-orientation))))
 
@@ -590,7 +606,7 @@
   (define default-y-margin (min 72 (floor (* .10 (pdf-width pdf)))))
   (parameterize ([current-pdf pdf]
                  [verbose-quad-printing? #false]
-                 [draw-debug? #false])
+                 [draw-debug? #true])
     (let* ([qs (time-name hyphenate (handle-hyphenate qs))]
            [qs (map ->string-quad qs)]
            [qs (insert-first-line-indents qs)]
@@ -605,7 +621,7 @@
            [bottom-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 0 0)]
+                                   [shift (pt left-margin top-margin)]
                                    [size (pt line-wrap-size page-wrap-size)])]
            [qs (time-name page-wrap (page-wrap qs page-wrap-size page-quad))]
            [qs (time-name position (position (struct-copy quad q:doc [elems qs])))])

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 #t))
+(define draw-debug-block? (make-parameter #f))
 (define draw-debug-string? (make-parameter #t))

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