diff --git a/quad/quad/base.rkt b/quad/quad/base.rkt index d8ab042a..1b96bfba 100644 --- a/quad/quad/base.rkt +++ b/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")) \ No newline at end of file + "util.rkt" + "wrap.rkt")) \ No newline at end of file diff --git a/quad/quad/qexpr.rkt b/quad/quad/qexpr.rkt index 6006e75c..60b487ff 100644 --- a/quad/quad/qexpr.rkt +++ b/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 diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index a77ded81..e3d9774f 100644 --- a/quad/quad/quad.rkt +++ b/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 () diff --git a/quad/quadwriter/block.rkt b/quad/quadwriter/block.rkt index 7494e229..e8fd7467 100644 --- a/quad/quadwriter/block.rkt +++ b/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) diff --git a/quad/quadwriter/column.rkt b/quad/quadwriter/column.rkt index 18f509a5..c0385bd3 100644 --- a/quad/quadwriter/column.rkt +++ b/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)) diff --git a/quad/quadwriter/draw.rkt b/quad/quadwriter/draw.rkt index 5d5e79ab..30d7b0a1 100644 --- a/quad/quadwriter/draw.rkt +++ b/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)))) \ No newline at end of file +(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])) \ No newline at end of file diff --git a/quad/quadwriter/image.rkt b/quad/quadwriter/image.rkt index 671f181a..57871df9 100644 --- a/quad/quadwriter/image.rkt +++ b/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)) \ No newline at end of file diff --git a/quad/quadwriter/line.rkt b/quad/quadwriter/line.rkt index 67f1e7c8..78f7218c 100644 --- a/quad/quadwriter/line.rkt +++ b/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 diff --git a/quad/quadwriter/page.rkt b/quad/quadwriter/page.rkt index fbb4b77c..b895a11b 100644 --- a/quad/quadwriter/page.rkt +++ b/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)) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index e3e6bfe2..42695536 100644 --- a/quad/quadwriter/render.rkt +++ b/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)) diff --git a/quad/quadwriter/section.rkt b/quad/quadwriter/section.rkt index 96db1e62..671ee2b2 100644 --- a/quad/quadwriter/section.rkt +++ b/quad/quadwriter/section.rkt @@ -4,4 +4,4 @@ (provide (all-defined-out)) (define q:section (make-quad #:type section-quad - #:id 'section)) + #:tag 'section)) diff --git a/quad/quadwriter/string.rkt b/quad/quadwriter/string.rkt index f938860e..8c3436e3 100644 --- a/quad/quadwriter/string.rkt +++ b/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))