and more

quad/quad/position.rkt

@@ -84,17 +84,19 @@
 
 (define (position-one q ref-src)
   ;; recursively calculates coordinates for quad & subquads
-  (define ref-pt (cond
-                   [(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)))
-  (define shifted-origin (pt+ this-origin (quad-shift q)))
   ;; need to position before recurring, so subquads have accurate reference point
-  (define positioned-q (quad-copy q
-                                  [origin shifted-origin]
-                                  ;; set shift to zero because it's baked into new origin value
-                                  [shift (pt 0 0)]))
+  (define positioned-q
+    (quad-copy q
+               [origin (let* ([ref-pt (cond
+                                        [(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)])]
+                              [this-origin (pt- ref-pt (to-point q))]
+                              [shifted-origin (pt+ this-origin (quad-shift q))])
+                         shifted-origin)]
+               ;; set shift to zero because it's baked into new origin value
+               [shift (pt 0 0)]))
   (define positioned-elems
     ;; for purposes of positioning the elements, we want to also bake in the `shift-elements` value
     ;; but we don't want this origin to be permanent on the parent.
@@ -112,7 +114,7 @@
                              (car prev-elems)))
            (loop (cons (position-one this-q ref-q) prev-elems) rest)]
           [(cons x rest) (loop (cons x prev-elems) rest)]))))
-  (quad-copy positioned-q [elems positioned-elems]))
+  (quad-update! positioned-q [elems positioned-elems]))
 
 (define (distance q)
   (match (pt- (from-point q) (to-point q))
@@ -133,11 +135,9 @@
   (append min-origin max-outer-pt))
 
 (define (attach-to from-q from-pt to-q to-pt)
-  (quad-copy from-q
-             [elems (cons (quad-copy to-q
-                                     [from-parent from-pt]
-                                     [to to-pt])
-                          (quad-elems from-q))]))
+  (quad-update! to-q
+                [from-parent from-pt]
+                [to to-pt]))
 
 (module+ test
   (require rackunit)

quad/quad/quad.rkt

@@ -93,8 +93,6 @@
 (define-syntax-rule (quad-copy QID [K V] ...)
   (struct-copy quad QID [K V] ...))
 
-(define-syntax-rule (quad-clone QID [K V] ...)
-  (struct-copy quad QID [K V] ... [attrs (hash-copy (quad-attrs QID))]))
 
 (define (quad-ref q key [default-val #f])
   (hash-ref (quad-attrs q) key (match default-val
@@ -105,6 +103,15 @@
   (hash-set! (quad-attrs q) key val)
   q)
 
+(define-syntax (quad-update! stx)
+  (syntax-case stx ()
+    [(_ ID [K V] ...)
+     (with-syntax ([(K-SETTER ...) (for/list ([kstx (in-list (syntax->list #'(K ...)))])
+                                     (format-id kstx "set-quad-~a!" kstx))])
+       #'(let ([q ID])
+           (K-SETTER q V) ...
+           q))]))
+
 (define (default-printable q [sig #f]) #t)
 
 (define (default-draw q surface)

quad/quadwriter/layout.rkt

@@ -226,9 +226,9 @@
      (define str (car (quad-elems last-q)))
      (define str+hyphen (string-append str "-"))
      (append head
-             (list (quad-copy last-q
-                              [elems (list str+hyphen)]
-                              [size (make-size-promise last-q str+hyphen)])))]
+             (list (quad-update! last-q
+                                 [elems (list str+hyphen)]
+                                 [size (make-size-promise last-q str+hyphen)])))]
     [_ qs]))
 
 
@@ -314,9 +314,7 @@
                                  #:size (pt (* end-hspace space-multiplier) 0)
                                  #:attrs (quad-attrs (car qs))))
            (list* fq
-                  (let ([q (car qs)])
-                    (set-quad-from-parent! q #f)
-                    q)
+                  (quad-update! (car qs) [from-parent #f])
                   (cdr qs))])])]))
 
 (define-quad offsetter-quad quad ())
@@ -361,43 +359,43 @@
                              (pt line-width (if (empty? line-heights) line-height (apply max line-heights)))))
           (list
            (quad-copy line-q
-            ;; move block attrs up, so they are visible in col 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
-                 (define bq (quad-copy 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)])
-              (from-parent
-               (match (quad-ref elem :inset-left 0)
-                 [0 elems]
-                 [inset-val
-                  (cons (make-quad
-                         #:draw-end q:string-draw-end
-                         #:to 'sw
-                         #:size (pt inset-val 5)
-                         #:type offsetter-quad)
-                        elems)]) 'sw))]))]
+                      ;; move block attrs up, so they are visible in col 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
+                           (define bq (quad-copy 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)])
+                        (from-parent
+                         (match (quad-ref elem :inset-left 0)
+                           [0 elems]
+                           [inset-val
+                            (cons (make-quad
+                                   #:draw-end q:string-draw-end
+                                   #:to 'sw
+                                   #:size (pt inset-val 5)
+                                   #:type offsetter-quad)
+                                  elems)]) 'sw))]))]
          [_ null])]))
   (define maybe-first-line (match new-lines [(cons line0 _) line0][_ #false]))
   (append (match opening-q
@@ -632,9 +630,8 @@
   ;; can be repeated without damage.
   [((? null?) _) null]
   [((cons q rest) where)
-   (set-quad-from-parent! q (or where (quad-from q)))
-   (cons q rest)
-   #;(cons (quad-copy q [from-parent (or where (quad-from q))]) rest)])
+   (quad-update! q [from-parent (or where (quad-from q))])
+   (cons q rest)])
 
 (define ((col-finish-wrap col-quad) lns . _)
   (match lns

quad/quadwriter/render.rkt

@@ -227,15 +227,15 @@
         (define line-qs (time-log line-wrap (apply-keeps (line-wrap qs line-wrap-size))))
     
         (define col-quad-prototype (quad-copy q:column
-                                                [size (pt line-wrap-size printable-height)]))
+                                              [size (pt line-wrap-size printable-height)]))
         (define column-qs (time-log column-wrap (column-wrap line-qs printable-height column-gap col-quad-prototype)))
 
         (define page-quad-prototype
           (λ (page-count)
             (define left-shift (+ left-margin (if (odd? page-count) gutter-margin 0)))
             (quad-copy q:page
-                         [shift (pt left-shift top-margin)]
-                         [size (pt line-wrap-size printable-height)])))
+                       [shift (pt left-shift top-margin)]
+                       [size (pt line-wrap-size printable-height)])))
 
         (define section-starting-side (string->symbol (quad-ref (car qs) :page-side-start "right")))
         (define insert-blank-page?
@@ -272,10 +272,10 @@
                    ;; we know previous section has pages because we ignore empty sections
                    (define page-from-previous-section (car previous-section-pages))
                    (define blank-page (quad-copy page-from-previous-section [elems null]))
-                   (define revised-previous-section
-                     (quad-copy previous-section
-                                  [elems (append previous-section-pages (list blank-page))]))
-                   (list* new-section revised-previous-section other-sections)]
+                   (define updated-previous-section
+                     (quad-update! previous-section
+                                   [elems (append previous-section-pages (list blank-page))]))
+                   (list* new-section updated-previous-section other-sections)]
                   [_ (list new-section)])])]
             [else (define new-section (quad-copy q:section [elems section-pages]) )
                   (cons new-section sections-acc)])