diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index 605ce718..874532d4 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -99,12 +99,17 @@ Naming guidelines draw width height - position - text + anchor-parent + anchor-from + anchor-from-parent + anchor-to + string color stroke x y + x1 ;; x & y are the top-left pos of the bounding box. + y1 ;; x1 & y1 are the starting points of a line x2 y2)) @@ -228,7 +233,7 @@ Naming guidelines :pdf-subject :pdf-author :pdf-keywords - :text)) #true)) + :string)) #true)) (define (takes-path? k) (and (memq k (list :image-file)) #true)) diff --git a/quad/quadwriter/debug.rkt b/quad/quadwriter/debug.rkt index 9821d089..962202fd 100644 --- a/quad/quadwriter/debug.rkt +++ b/quad/quadwriter/debug.rkt @@ -16,6 +16,7 @@ (define draw-debug-block? (make-parameter #false)) (define draw-debug-string? (make-parameter #true)) (define draw-debug-image? (make-parameter #false)) + (define draw-debug-draw? (make-parameter #false)) (define debug-page-width (make-parameter 400)) (define debug-page-height (make-parameter 400)) @@ -30,6 +31,7 @@ (define draw-debug-block? (make-parameter #true)) (define draw-debug-string? (make-parameter #true)) (define draw-debug-image? (make-parameter #true)) + (define draw-debug-draw? (make-parameter #true)) (define debug-page-width (make-parameter #f)) (define debug-page-height (make-parameter #f)) diff --git a/quad/quadwriter/draw.rkt b/quad/quadwriter/draw.rkt index 30d7b0a1..e775f4cb 100644 --- a/quad/quadwriter/draw.rkt +++ b/quad/quadwriter/draw.rkt @@ -2,9 +2,9 @@ (require "struct.rkt" "string.rkt" "debug.rkt" - "param.rkt" "attrs.rkt" quad/quad + sugar/coerce quad/position pitfall) (provide (all-defined-out)) @@ -14,10 +14,10 @@ (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)) + (define x1 (quad-ref q :x1 0)) + (define y1 (quad-ref q :y1 0)) + (move-to doc x1 y1) + (line-to doc (quad-ref q :x2 x1) (quad-ref q :y2 y1)) (line-width doc (quad-ref q :stroke 1)) (stroke doc (quad-ref q :color "black"))) @@ -25,24 +25,35 @@ (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))) + #:text (quad-ref q :string ""))) (define (convert-draw-quad q) (cond [(memq (quad-tag q) '(line text)) (quad-copy draw-quad q:draw + [from (->symbol (quad-ref q :anchor-from (quad-from q:draw)))] + [from-parent (match (quad-ref q :anchor-from-parent (quad-from-parent q:draw)) + [#false #false] + [str (->symbol str)])] + [to (->symbol (quad-ref q :anchor-to (quad-to q:draw)))] + [elems (quad-elems q)] [tag (quad-tag q)] [attrs (quad-attrs q)] - [size (pt (quad-ref q :width 0) (quad-ref q :height 0))] + [size (match (quad-tag q) + [(== 'text eq?) (make-size-promise-for-string q (quad-ref q :string ""))] + [(== 'line eq?) (pt (abs (- (quad-ref q :x1) (quad-ref q :x2))) + (abs (- (quad-ref q :y1) (quad-ref q :y2))))] + [_ (pt (quad-ref q :width 0) (quad-ref q :height 0))])] + [draw-end (λ (q doc) + (when (draw-debug-draw?) + (draw-debug q doc "red" "red")))] [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))) + (apply translate doc (quad-origin q)) (draw-proc q doc) (restore doc)))])] [else #false])) \ No newline at end of file diff --git a/quad/quadwriter/line.rkt b/quad/quadwriter/line.rkt index 78f7218c..11463568 100644 --- a/quad/quadwriter/line.rkt +++ b/quad/quadwriter/line.rkt @@ -87,8 +87,8 @@ (unless (pair? all-qs) (raise-argument-error 'fill-line-wrap "nonempty list of quads" all-qs)) - ;; remove absolute position quads because they don't affect line layout - (define-values (absolute-qs qs) (partition (λ (q) (equal? (quad-ref q :position) "absolute")) all-qs)) + ;; remove anchored quads because they don't affect line layout + (define-values (absolute-qs qs) (partition (λ (q) (quad-ref q :anchor-parent)) all-qs)) (match-define (and (cons q-first other-qs) (list _ ... q-last)) qs) (define align-value (quad-ref q-first :line-align "left")) diff --git a/quad/quadwriter/page.rkt b/quad/quadwriter/page.rkt index b895a11b..66087fd1 100644 --- a/quad/quadwriter/page.rkt +++ b/quad/quadwriter/page.rkt @@ -4,6 +4,7 @@ "param.rkt" "debug.rkt" "font.rkt" + "string.rkt" quad/base racket/date pitfall) @@ -44,14 +45,15 @@ (define (draw-page-footer q doc) (match-define (list x y) (quad-origin q)) - (font-size doc (* .8 default-font-size)) + (font-size doc (quad-ref q :font-size)) (font doc (path->string (quad-ref q font-path-key default-font-face))) (fill-color doc default-font-color) - (text doc (or (quad-ref q :footer-text) - (format "~a · ~a at ~a" (quad-ref q :page-number 0) - (if (quadwriter-test-mode) "test" (quad-ref q :doc-title "untitled")) - (date->string (if (quadwriter-test-mode) (seconds->date 0 #f) (current-date)) #t))) - x y)) + (define str (or (quad-ref q :footer-text) + (format "~a · ~a at ~a" (quad-ref q :page-number 0) + (if (quadwriter-test-mode) "test" (quad-ref q :doc-title "untitled")) + (date->string (if (quadwriter-test-mode) (seconds->date 0 #f) (current-date)) #t)))) + (text doc str x y) + #;(set-quad-size! q (make-size-promise-for-string q str))) (define (make-footer-quad col-q page-idx path) (define-values (dir name _) (split-path (path-replace-extension path #""))) @@ -60,6 +62,8 @@ :footer-text (quad-ref col-q :footer-text) :page-number (+ (quad-ref col-q :page-number-start (add1 (section-pages-used))) (sub1 page-idx)) :doc-title (string-titlecase (path->string name)) + :font-size (* 0.8 (quad-ref col-q :font-size default-font-size)) + :line-height (quad-ref col-q :line-height default-line-height) :font-family "text") (resolve-font-path! attrs) attrs)) @@ -67,13 +71,13 @@ #:attrs attrs #:from-parent 'sw #:to 'nw - #:elems (or null (hash-ref (current-named-quads) "foo")) + #:elems null #: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)))) + #:draw draw-page-footer + #:draw-end (λ (q doc) + (when draw-debug-line? + (draw-debug q doc "goldenrod" "goldenrod"))))) (define ((page-wrap-finish make-page-quad path) cols q-before q-after page-idx) (define pq (make-page-quad (+ (section-pages-used) page-idx))) diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index 7132d5b1..ff1b91fd 100644 --- a/quad/quadwriter/param.rkt +++ b/quad/quadwriter/param.rkt @@ -4,7 +4,6 @@ (define current-pdf (make-parameter #false)) (define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode (define section-pages-used (make-parameter 0)) -(define current-named-quads (make-parameter #false)) (define quadwriter-test-mode (make-parameter #f)) ; used during rackunit to suppress nondeterministic elements, like timestamp in header diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 42695536..c67a3633 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -159,7 +159,7 @@ [(quad-ref q :image-file) (convert-image-quad q)] [else (convert-string-quad q)])) -(define (extract-defined-quads qs) +#;(define (extract-defined-quads qs) (define (get-define-val q) (quad-ref q 'define)) (define-values (dqs not-dqs) (partition get-define-val qs)) (for ([dq-group (in-list (group-by get-define-val dqs))]) @@ -469,7 +469,7 @@ ;; make it a parameter than endlessly pass it around as an argument. [section-pages-used 0] [verbose-quad-printing? #false] - [current-named-quads (make-hash)]) ; for ease of debugging; not mandatory + #;[current-named-quads (make-hash)]) ; for ease of debugging; not mandatory (define qs (time-log setup-qs (setup-qs qx-arg base-dir))) (setup-pdf-metadata! qs (current-pdf)) ;; all the heavy lifting happens inside `make-sections`