anchorage

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))

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))

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]))

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"))

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)))

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
 

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`