tags not ids

quad/quad/base.rkt

@@ -4,9 +4,11 @@
   "quad.rkt"
   "position.rkt"
   "param.rkt"
-  "util.rkt")
+  "util.rkt"
+  "wrap.rkt")
 
 (provide (all-from-out "quad.rkt"
                        "position.rkt"
                        "param.rkt"
-                       "util.rkt"))
+                       "util.rkt"
+                       "wrap.rkt"))

quad/quad/qexpr.rkt

@@ -75,7 +75,7 @@
     (raise-argument-error 'qexpr->quad "qexpr" x))
   (let loop ([x x])
     (match x
-      [(cons (? valid-tag?) rest)
+      [(cons (? valid-tag? tag) rest)
        (match rest
          [(list (? txexpr-attrs? attrs) (? qexpr? elems) ...)
           (define mheq (make-hasheq)) ; want mutable hash
@@ -88,9 +88,12 @@
                                 [(equal? v "false") #false]
                                 [(string->number v)]
                                 [else v])))
-          (q #:attrs mheq #:elems (map loop elems))]
+          (make-quad #:tag tag
+                     #:attrs mheq
+                     #:elems (map loop elems))]
          [(list (? qexpr? elems) ...)
-          (q #:elems (map loop elems))])]
+          (make-quad #:tag tag
+                     #:elems (map loop elems))])]
       [_ x])))
 
 (module+ test

quad/quad/quad.rkt

@@ -47,7 +47,11 @@
 ;; keep this param here so you don't have to import quad/param to get it
 (define verbose-quad-printing? (make-parameter #f))
 
-(struct quad (attrs ; key-value pairs, arbitrary
+(struct quad (
+              ;; WARNING
+              ;; atomize procedure depends on attrs & elems
+              ;; being first two fields of struct.
+              attrs ; key-value pairs, arbitrary
               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)
@@ -70,15 +74,14 @@
               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
-              )
+              tag) ; from q-expr, maybe
   #:mutable
   #:transparent
   #:property prop:custom-write
   (λ (q p w?) (display
                (format "<~a-~a~a~a>"
+                       (quad-tag q)
                        (object-name q)
-                       (quad-id q)
                        (if (verbose-quad-printing?)
                            (string-join (map ~v (flatten (hash->list (quad-attrs q))))
                                         " " #:before-first "(" #:after-last ")")
@@ -148,10 +151,10 @@
 
 ;; todo: convert immutable hashes to mutable on input?
 (define (make-quad
+         #:tag [tag #false]
          #:type [type quad]
          #:attrs [attrs (make-hasheq)]
          #:elems [elems null]
-         #:id [id #f]
          #:size [size '(0 0)]
          #:from-parent [from-parent #false]
          #:from [from 'ne]
@@ -186,8 +189,8 @@
                         draw-start
                         draw
                         draw-end))
-          (define id-syn (string->symbol (if id (~a id) (~r (eq-hash-code args) #:base 36))))
-          (apply type (append args (list id-syn)))]))
+          (apply type (append args
+                              (list (or tag (string->symbol (~r (eq-hash-code args) #:base 36))))))]))
 
 (define-syntax (define-quad stx)
   (syntax-case stx ()

quad/quadwriter/block.rkt

@@ -84,7 +84,7 @@
       #:from 'sw
       #:to 'nw
       #:elems (from-parent lines 'nw)
-      #:id 'block
+      #:tag 'block
       #:attrs (quad-attrs line)
       #:size (delay (pt (pt-x (size line)) ; 
                         (+ (sum-y lines)

quad/quadwriter/column.rkt

@@ -2,13 +2,12 @@
 (require "attrs.rkt"
          "struct.rkt"
          "block.rkt"
-         quad/base
-         quad/wrap)
+         quad/base)
 (provide (all-defined-out))
 
 (define q:column (make-quad
                   #:type column-quad
-                  #:id 'col
+                  #:tag 'col
                   #:from 'ne
                   #:to 'nw))
 

quad/quadwriter/draw.rkt

@@ -9,30 +9,40 @@
          pitfall)
 (provide (all-defined-out))
 
-(define (convert-draw-quad q)
-  (quad-copy draw-quad q:draw
-             [attrs (quad-attrs q)]
-             [size (pt (quad-ref q :width 0) (quad-ref q :height 0))]))
 
-(define q:draw (make-quad #:type draw-quad
-                          #:from 'bo
-                          #:to 'bi
-                          #:draw (λ (q doc)
-                                   (save doc)
-                                   (apply translate doc (if (equal? (quad-ref q :position) "absolute")
-                                                            (list 0 0)
-                                                            (quad-origin q)))
-                                   (match (quad-ref q :draw)
-                                     ["line"
-                                      (define x0 (quad-ref q :x 0))
-                                      (define y0 (quad-ref q :y 0))
-                                      (move-to doc x0 y0)
-                                      (line-to doc (quad-ref q :x2 x0) (quad-ref q :y2 y0))
-                                      (line-width doc (quad-ref q :stroke 1))
-                                      (stroke doc (quad-ref q :color "black"))]
-                                     ["text" (move-to doc 0 0)
-                                             (q:string-draw q doc
-                                                            #:origin (pt (quad-ref q :x 0) (quad-ref q :y 0))
-                                                            #:text (quad-ref q :text))]
-                                     [_ (void)])
-                                   (restore doc))))
+(define q:draw (make-quad #:type draw-quad))
+
+
+(define (draw-line q doc)
+  (define x0 (quad-ref q :x 0))
+  (define y0 (quad-ref q :y 0))
+  (move-to doc x0 y0)
+  (line-to doc (quad-ref q :x2 x0) (quad-ref q :y2 y0))
+  (line-width doc (quad-ref q :stroke 1))
+  (stroke doc (quad-ref q :color "black")))
+
+(define (draw-text q doc)
+  (move-to doc 0 0)
+  (q:string-draw q doc
+                 #:origin (pt (quad-ref q :x 0) (quad-ref q :y 0))
+                 #:text (quad-ref q :text)))
+
+
+(define (convert-draw-quad q)
+  (cond
+    [(memq (quad-tag q) '(line text))
+     (quad-copy draw-quad q:draw
+                [tag (quad-tag q)]
+                [attrs (quad-attrs q)]
+                [size (pt (quad-ref q :width 0) (quad-ref q :height 0))]
+                [draw (let ([draw-proc (match (quad-tag q)
+                                         [(== 'line eq?) draw-line]
+                                         [(== 'text eq?) draw-text])])
+                        (λ (q doc)
+                          (save doc)
+                          (apply translate doc (if (equal? (quad-ref q :position) "absolute")
+                                                   (list 0 0)
+                                                   (quad-origin q)))
+                          (draw-proc q doc)
+                          (restore doc)))])]
+    [else #false]))

quad/quadwriter/image.rkt

@@ -51,7 +51,7 @@
 (define q:image (q #:type image-quad
                    #:from 'bo
                    #:to 'bi
-                   #:id 'image
+                   #:tag 'image
                    #:printable #true
                    #:draw q:image-draw
                    #:draw-end q:image-draw-end))

quad/quadwriter/line.rkt

@@ -7,7 +7,6 @@
          "string.rkt"
          "attrs.rkt"
          quad/base
-         quad/wrap
          sugar/list
          pitfall
          racket/unsafe/ops)
@@ -33,7 +32,7 @@
                 #:from 'sw
                 #:to 'nw
                 #:printable #true
-                #:id 'line
+                #:tag 'line
                 #:draw-start (if draw-debug-line? draw-debug void)))
 
 (define (render-hyphen qs ending-q)
@@ -115,7 +114,7 @@
 
      (define (make-left-edge-filler [width 0])
        (make-quad #:type filler-quad
-                  #:id 'line-filler
+                  #:tag 'line-filler
                   #:from-parent (quad-from-parent q-first)
                   #:from 'bo
                   #:to 'bi

quad/quadwriter/page.rkt

@@ -4,10 +4,7 @@
          "param.rkt"
          "debug.rkt"
          "font.rkt"
-         "line.rkt"
-         quad/position
-         quad/quad
-         quad/wrap
+         quad/base
          racket/date
          pitfall)
 (provide (all-defined-out))
@@ -25,7 +22,7 @@
 
 (define q:page (make-quad
                 #:type page-quad
-                #:id 'page
+                #:tag 'page
                 #:from-parent 'nw
                 #:draw-start page-draw-start))
 

quad/quadwriter/render.rkt

@@ -153,12 +153,11 @@
   ;; with special typed quads representing those things.
   ;; Because typed quads have their own predicates,
   ;; it's faster to find them in wrapping operations
-  (define converter (cond
-                      [(quad-ref q :break) convert-break-quad]
-                      [(quad-ref q :draw) convert-draw-quad]
-                      [(quad-ref q :image-file) convert-image-quad]
-                      [else convert-string-quad]))
-  (converter q))
+  (cond
+    [(convert-break-quad q)]
+    [(convert-draw-quad q)]
+    [(quad-ref q :image-file) (convert-image-quad q)]
+    [else (convert-string-quad q)]))
 
 (define (extract-defined-quads qs)
   (define (get-define-val q) (quad-ref q 'define))

quad/quadwriter/section.rkt

@@ -4,4 +4,4 @@
 (provide (all-defined-out))
 
 (define q:section (make-quad #:type section-quad
-                             #:id 'section))
+                             #:tag 'section))

quad/quadwriter/string.rkt

@@ -96,7 +96,7 @@
 (define q:string (q #:type string-quad
                     #:from 'bo
                     #:to 'bi
-                    #:id 'str
+                    #:tag 'str
                     #:printable q:string-printable?
                     #:draw q:string-draw
                     #:draw-end q:string-draw-end))