type harder

quad/quad/position.rkt

@@ -92,7 +92,7 @@
   ;; recursively calculates coordinates for quad & subquads
   ;; need to position before recurring, so subquads have accurate reference point
   (define positioned-q
-    (quad-copy q
+    (quad-copy quad q
                  [origin (let* ([ref-pt (cond
                                           [(quad? ref-src)
                                            (anchor->global-point ref-src (or (quad-from-parent q) (quad-from q)))]
@@ -107,7 +107,7 @@
     ;; 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.
     ;; akin to `push` a graphics state and then `pop` afterwards.
-    (let ([parent-q (quad-copy positioned-q
+    (let ([parent-q (quad-copy quad positioned-q
                                  [origin (pt+ (quad-origin positioned-q) (quad-shift-elems positioned-q))]
                                  [shift-elems (pt 0 0)])])
       ;; can't use for/list here because previous quads provide context for later ones

quad/quad/quad.rkt

@@ -112,8 +112,6 @@
 
 (define-syntax (quad-copy stx)
   (syntax-case stx ()
-    [(_ ID [K V] ...)
-     #'(quad-copy quad ID [K V] ...)]
     [(_ QUAD-TYPE ID [K V] ...)
      (if (free-identifier=? #'quad #'QUAD-TYPE)
          #'(struct-copy QUAD-TYPE ID

quad/quadwriter/layout.rkt

@@ -230,7 +230,8 @@
                       [else convert-string-quad]))
   (converter q))
 
-(define (draw-debug q doc [fill-color "#f99"] [stroke-color "#fcc"] [stroke-width 0.5])
+(define (draw-debug q doc [fill-color "#f99"] [stroke-color "#fcc"] . _)
+  (define stroke-width 0.5)
   (when (draw-debug?)
     (save doc)
     ;; draw layout box
@@ -248,27 +249,29 @@
     (restore doc)))
 
 
-
-(define q:line (q #:size (pt 0 default-line-height)
-                  #:from 'sw
-                  #:to 'nw
-                  #:printable #true
-                  #:id 'line
-                  #:draw-start (if draw-debug-line? draw-debug void)))
+(define-quad line-quad quad)
+(define q:line (make-quad
+                #:type line-quad
+                #:size (pt 0 default-line-height)
+                #:from 'sw
+                #:to 'nw
+                #:printable #true
+                #:id 'line
+                #:draw-start (if draw-debug-line? draw-debug void)))
 
 (define-quad line-spacer-quad line-break-quad)
 
 (define only-prints-in-middle (λ (q sig) (not (memq sig '(start end)))))
 (define (make-paragraph-spacer maybe-first-line-q key default-val)
   (define arbitrary-width 20)
-  (q #:type line-spacer-quad
-     #:size (pt arbitrary-width (cond
-                                  [(and maybe-first-line-q (quad-ref maybe-first-line-q key))]
-                                  [else default-val]))
-     #:from 'sw
-     #:to 'nw
-     #:printable only-prints-in-middle
-     #:draw-start (if (draw-debug-line?) draw-debug void)))
+  (make-quad #:type line-spacer-quad
+             #:size (pt arbitrary-width (cond
+                                          [(and maybe-first-line-q (quad-ref maybe-first-line-q key))]
+                                          [else default-val]))
+             #:from 'sw
+             #:to 'nw
+             #:printable only-prints-in-middle
+             #:draw-start (if (draw-debug-line?) draw-debug void)))
 
 (define softies (map string '(#\space #\- #\u00AD)))
 
@@ -436,7 +439,7 @@
   (restore doc))
 
 (define (make-hr-quad line-q)
-  (quad-copy line-q [draw-start hr-draw]))
+  (quad-copy line-quad line-q [draw-start hr-draw]))
 
 (define ((line-wrap-finish line-prototype-q default-block-id) wrap-qs q-before q-after idx)
   ;; we curry line-q so that the wrap size can be communicated to this operation
@@ -459,7 +462,7 @@
          [(and (cons elem-first _) elems)
           (match-define (list line-width line-height) (quad-size line-prototype-q))
           (list
-           (quad-copy line-prototype-q
+           (quad-copy line-quad line-prototype-q
                       ;; move block attrs up, so they are visible in col wrap
                       [attrs (let ([h (copy-block-attrs (quad-attrs elem-first) (hash-copy (quad-attrs line-prototype-q)))])
                                ;; we want every group of lines in a paragraph to have a block id
@@ -519,7 +522,7 @@
     (raise-argument-error 'line-wrap "positive number" wrap-size))
   (match qs
     [(cons q _)
-     (define line-q (quad-copy q:line [size (pt wrap-size (quad-ref q :line-height default-line-height))]))
+     (define line-q (quad-copy line-quad q:line [size (pt wrap-size (quad-ref q :line-height default-line-height))]))
      (define permitted-justify-overfill
        (match (quad-ref q :line-align)
          ;; allow justified lines to go wider,
@@ -654,17 +657,17 @@
                               :font-family "text")
                   (resolve-font-path! attrs)
                   attrs))
-  (q #:size (pt 50 default-line-height)
-     #:attrs attrs
-     #:from-parent 'sw
-     #:to 'nw
-     #:elems (or null (hash-ref (current-named-quads) "foo"))
-     #:shift (pt 0 (* 1.5 default-line-height))
-     #:printable #true
-     #:draw-start (λ (q doc)
-                    (when draw-debug-line?
-                      (draw-debug q doc "goldenrod" "goldenrod"))
-                    (draw-page-footer q doc))))
+  (make-quad #:size (pt 50 default-line-height)
+             #:attrs attrs
+             #:from-parent 'sw
+             #:to 'nw
+             #:elems (or null (hash-ref (current-named-quads) "foo"))
+             #:shift (pt 0 (* 1.5 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-quad column-quad quad)
 (define q:column (make-quad
@@ -757,21 +760,24 @@
   (when (draw-debug-block?)
     (draw-debug q doc "#6c6" "#9c9")))
 
+(define-quad block-quad quad)
 (define (lines->block lines)
   (match lines
     [(cons line _)
-     (q #:from 'sw
-        #:to 'nw
-        #:elems (from-parent lines 'nw)
-        #:id 'block
-        #:attrs (quad-attrs line)
-        #:size (delay (pt (pt-x (size line)) ; 
-                          (+ (sum-y lines)
-                             (quad-ref line :inset-top 0)
-                             (quad-ref line :inset-bottom 0))))
-        #:shift-elems (pt 0 (quad-ref line :inset-top 0))
-        #:draw-start (block-draw-start line)
-        #:draw-end (block-draw-end line))]))
+     (make-quad
+      #:type block-quad
+      #:from 'sw
+      #:to 'nw
+      #:elems (from-parent lines 'nw)
+      #:id 'block
+      #:attrs (quad-attrs line)
+      #:size (delay (pt (pt-x (size line)) ; 
+                        (+ (sum-y lines)
+                           (quad-ref line :inset-top 0)
+                           (quad-ref line :inset-bottom 0))))
+      #:shift-elems (pt 0 (quad-ref line :inset-top 0))
+      #:draw-start (block-draw-start line)
+      #:draw-end (block-draw-end line))]))
 
 (define/match (from-parent qs [where #f])
   ;; doesn't change any positioning. doesn't depend on state. can happen anytime.
@@ -792,7 +798,7 @@
   (append
    (match lns
      [(cons line _)
-      (list (quad-copy col-quad
+      (list (quad-copy column-quad col-quad
                        ;; move block attrs up, so they are visible in page wrap
                        [attrs (copy-block-attrs (quad-attrs line)
                                                 (hash-copy (quad-attrs col-quad)))]
@@ -807,7 +813,7 @@ constraint wrapping example
 https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d9656046b/pdf/directory-require.rkt#L51
 |#
 ;; 
-(define (column-wrap lines fn-lines vertical-height column-gap [column-quad q:column])
+(define (column-wrap lines fn-lines vertical-height column-gap [col-quad-proto q:column])
   (unless (positive? vertical-height)
     (raise-argument-error 'column-wrap "positive number" vertical-height))
   
@@ -824,7 +830,7 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
                      #:distance (λ (q dist-so-far wrap-qs)
                                   ;; do trial block insertions
                                   (sum-y (insert-blocks (reverse wrap-qs))))                     
-                     #:finish-wrap (column-wrap-finish column-quad)
+                     #:finish-wrap (column-wrap-finish col-quad-proto)
                      #:footnote-qs fn-lines
                      #:footnote-leftover-proc (λ (ymax leftover-qs fn-qs)
                                                 (let loop ([ymax ymax][leftover-qs leftover-qs][fn-qs fn-qs])

quad/quadwriter/param.rkt

@@ -17,9 +17,9 @@
 
          (define draw-debug? (make-parameter #true))
          (define draw-debug-line? (make-parameter #true))
-         (define draw-debug-block? (make-parameter #true))
+         (define draw-debug-block? (make-parameter #false))
          (define draw-debug-string? (make-parameter #true))
-         (define draw-debug-image? (make-parameter #true))
+         (define draw-debug-image? (make-parameter #false))
 
          (define debug-page-width (make-parameter 400))
          (define debug-page-height (make-parameter 400))

quad/quadwriter/render.rkt

@@ -246,7 +246,7 @@
   (values line-qs fn-line-qs))
 
 (define (make-columns line-qs fn-line-qs line-wrap-size printable-height column-gap)
-  (define col-quad-prototype (quad-copy quad q:column
+  (define col-quad-prototype (quad-copy column-quad q:column
                                         [size (pt line-wrap-size printable-height)]))
   (time-log column-wrap (column-wrap line-qs fn-line-qs printable-height column-gap col-quad-prototype)))
 
@@ -276,10 +276,9 @@
          (for/list ([repeater (in-list repeaters)]
                     #:when (let* ([val (quad-ref repeater :page-repeat)]
                                   [sym (string->symbol val)])
-                             (memq sym (list
-                                        (if (= page-num 1) 'first 'rest)
-                                        page-side
-                                        'all))))
+                             (or (eq? sym 'all)
+                                 (eq? sym page-side)
+                                 (eq? sym (if (= page-num 1) 'first 'rest)))))
                    repeater))
        (when (pair? repeaters-for-this-page)
          (set-quad-elems! page (append repeaters-for-this-page (quad-elems page)))))
@@ -337,16 +336,16 @@
                   (for/list ([repeater (in-list section-repeaters)]
                              #:when (let* ([val (quad-ref repeater :page-repeat)]
                                            [sym (string->symbol (string-trim val #px"section\\s"))])
-                                      (memq sym (list*
-                                                 (if (= page-num 1) 'first 'rest)
-                                                 page-side
-                                                 '(section all)))))
+                                      (or (eq? sym 'section)
+                                          (eq? sym 'all)
+                                          (eq? sym page-side)
+                                          (eq? sym (if (= page-num 1) 'first 'rest)))))
                             repeater))
                 (cond
                   [(null? section-repeaters-for-this-page) page]
                   [else
                    (quad-copy page-quad page
-                                [elems (append section-repeaters-for-this-page (quad-elems page))])])))
+                              [elems (append section-repeaters-for-this-page (quad-elems page))])])))
         
     (begin0
       (cond
@@ -358,11 +357,11 @@
             ;; blank page goes at beginning of current section
             (define page-from-current-section (car section-pages))
             (define blank-page (quad-copy page-quad page-from-current-section [elems null]))
-            (define new-section (quad-copy quad q:section [elems (cons blank-page section-pages)]))
+            (define new-section (quad-copy section-quad q:section [elems (cons blank-page section-pages)]))
             (cons new-section sections-acc)]
            [_ ;; must be 'right
             ;; blank page goes at end of previous section (if it exists)
-            (define new-section (quad-copy quad q:section [elems section-pages]))
+            (define new-section (quad-copy section-quad q:section [elems section-pages]))
             (match sections-acc
               [(cons previous-section other-sections)
                (define previous-section-pages (quad-elems previous-section))
@@ -374,7 +373,7 @@
                                [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]) )
+        [else (define new-section (quad-copy section-quad q:section [elems section-pages]) )
               (cons new-section sections-acc)])
       (section-pages-used (+ (section-pages-used) (length section-pages))))))
 
@@ -383,11 +382,15 @@
   (for* ([(page page-idx) (in-indexed (for*/list ([section (in-list (quad-elems doc))]
                                                   [page (in-list (quad-elems section))])
                                                  page))]
+         #:when (page-quad? page)
          ;; all inner / outer lines are initially filled as if they were right-aligned
          [zero-filler-side (in-value (if (odd? (add1 page-idx)) "inner" "outer"))]
          [col (in-list (quad-elems page))]
+         #:when (column-quad? col)
          [block (in-list (quad-elems col))]
-         [line (in-list (quad-elems block))])
+         #:when (block-quad? block)
+         [line (in-list (quad-elems block))]
+         #:when (line-quad? line))
         (when (equal? zero-filler-side (quad-ref line :line-align))
           (match (quad-elems line)
             ;; collapse the filler quad by setting size to 0