on at

quad/qtest/hyphenate.rkt

@@ -14,9 +14,7 @@ At the command line:
 
 We said `raco pkg install hyphenate` dude
 
-
-enated. To hyphenate words of
-any length, use `#:min-length` `#f`.
+All right then.
 
 A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
 Certain word processors allow users to [insert soft

quad/quad/position.rkt

@@ -57,17 +57,17 @@
                                    [(or 'bi 'bo 'baseline-in 'baseline-out) (vertical-baseline-offset q)]
                                    [_ 0])))))
 
-(define (in-point q)
+(define (at-point q)
   ;; calculate absolute location of in-point
   ;; based on current origin and point type.
   ;; don't include offset, so location is on bounding box
-  (anchor->global-point q (quad-in q)))
+  (anchor->global-point q (quad-at q)))
 
-(define (out-point q)
+(define (on-point q)
   ;; calculate absolute location of out-point
   ;; based on current origin and point type.
   ;; don't include offset, so location is on bounding box
-  (anchor->global-point q (quad-out q)))
+  (anchor->global-point q (quad-on q)))
 
 (define (anchor->global-point q anchor)
   ;; don't include shift here: it should be baked into origin calculation
@@ -76,10 +76,10 @@
 (define (position q [ref-src #f])
   ;; recursively calculates coordinates for quad & subquads
   (define ref-pt (cond
-                   [(quad? ref-src) (anchor->global-point ref-src (quad-out q))]
+                   [(quad? ref-src) (anchor->global-point ref-src (quad-on q))]
                    [ref-src] ; for passing explicit points in testing
                    [else (pt 0 0)]))
-  (define this-origin (pt- ref-pt (in-point q)))
+  (define this-origin (pt- ref-pt (at-point q)))
   (define shifted-origin (pt+ this-origin (quad-shift q)))
   ;; need to position before recurring, so subquads have accurate reference point
   (define positioned-q (struct-copy quad q
@@ -101,7 +101,7 @@
                             [(cons x rest) (loop (cons x prev-elems) rest)]))])))
 
 (define (distance q)
-  (match (pt- (out-point q) (in-point q))
+  (match (pt- (on-point q) (at-point q))
     [(list-no-order 0 val) val]
     [(list ∆x ∆y) (sqrt (+ (expt ∆x 2) (expt ∆y 2)))]))
 
@@ -111,14 +111,14 @@
    "origins"
    (define size (pt 10 10))
    (define orig (pt 5 5))
-   (check-equal? (quad-origin (position (q #:in 'nw #:size size) orig)) (pt 5 5))
-   (check-equal? (quad-origin (position (q #:in 'n #:size size) orig)) (pt 0 5))
-   (check-equal? (quad-origin (position (q #:in 'ne #:size size) orig)) (pt -5 5))
-   (check-equal? (quad-origin (position (q #:in 'e #:size size) orig)) (pt -5 0))
-   (check-equal? (quad-origin (position (q #:in 'se #:size size) orig)) (pt -5 -5))
-   (check-equal? (quad-origin (position (q #:in 's #:size size) orig)) (pt 0 -5))
-   (check-equal? (quad-origin (position (q #:in 'sw #:size size) orig)) (pt 5 -5))
-   (check-equal? (quad-origin (position (q #:in 'w #:size size) orig)) (pt 5 0)))
+   (check-equal? (quad-origin (position (q #:at 'nw #:size size) orig)) (pt 5 5))
+   (check-equal? (quad-origin (position (q #:at 'n #:size size) orig)) (pt 0 5))
+   (check-equal? (quad-origin (position (q #:at 'ne #:size size) orig)) (pt -5 5))
+   (check-equal? (quad-origin (position (q #:at 'e #:size size) orig)) (pt -5 0))
+   (check-equal? (quad-origin (position (q #:at 'se #:size size) orig)) (pt -5 -5))
+   (check-equal? (quad-origin (position (q #:at 's #:size size) orig)) (pt 0 -5))
+   (check-equal? (quad-origin (position (q #:at 'sw #:size size) orig)) (pt 5 -5))
+   (check-equal? (quad-origin (position (q #:at 'w #:size size) orig)) (pt 5 0)))
 
   
   (test-case
@@ -126,43 +126,43 @@
    (define size (pt 10 10))
    (define orig (pt 5 5))
    (define shift (pt 3 3))
-   (check-equal? (quad-origin (position (q #:in 'nw #:size size #:shift shift) orig)) (pt+ (pt 5 5) shift))
-   (check-equal? (quad-origin (position (q #:in 'n #:size size #:shift shift) orig)) (pt+ (pt 0 5) shift))
-   (check-equal? (quad-origin (position (q #:in 'ne #:size size #:shift shift) orig)) (pt+ (pt -5 5) shift))
-   (check-equal? (quad-origin (position (q #:in 'e #:size size #:shift shift) orig)) (pt+ (pt -5 0) shift))
-   (check-equal? (quad-origin (position (q #:in 'se #:size size #:shift shift) orig)) (pt+ (pt -5 -5) shift))
-   (check-equal? (quad-origin (position (q #:in 's #:size size #:shift shift) orig)) (pt+ (pt 0 -5) shift))
-   (check-equal? (quad-origin (position (q #:in 'sw #:size size #:shift shift) orig)) (pt+ (pt 5 -5) shift))
-   (check-equal? (quad-origin (position (q #:in 'w #:size size #:shift shift) orig)) (pt+ (pt 5 0) shift)))
+   (check-equal? (quad-origin (position (q #:at 'nw #:size size #:shift shift) orig)) (pt+ (pt 5 5) shift))
+   (check-equal? (quad-origin (position (q #:at 'n #:size size #:shift shift) orig)) (pt+ (pt 0 5) shift))
+   (check-equal? (quad-origin (position (q #:at 'ne #:size size #:shift shift) orig)) (pt+ (pt -5 5) shift))
+   (check-equal? (quad-origin (position (q #:at 'e #:size size #:shift shift) orig)) (pt+ (pt -5 0) shift))
+   (check-equal? (quad-origin (position (q #:at 'se #:size size #:shift shift) orig)) (pt+ (pt -5 -5) shift))
+   (check-equal? (quad-origin (position (q #:at 's #:size size #:shift shift) orig)) (pt+ (pt 0 -5) shift))
+   (check-equal? (quad-origin (position (q #:at 'sw #:size size #:shift shift) orig)) (pt+ (pt 5 -5) shift))
+   (check-equal? (quad-origin (position (q #:at 'w #:size size #:shift shift) orig)) (pt+ (pt 5 0) shift)))
 
   (test-case
    "in points"
    (define size '(10 10))
    (define pos '(5 5))
-   (check-equal? (in-point (q #:in 'nw #:size size #:origin pos)) (pt 5 5))
-   (check-equal? (in-point (q #:in 'n #:size size #:origin pos)) (pt 10 5))
-   (check-equal? (in-point (q #:in 'ne #:size size #:origin pos)) (pt 15 5))
-   (check-equal? (in-point (q #:in 'w #:size size #:origin pos)) (pt 5 10))
-   (check-equal? (in-point (q #:in 'c #:size size #:origin pos)) (pt 10 10))
-   (check-equal? (in-point (q #:in 'e #:size size #:origin pos)) (pt 15 10))
-   (check-equal? (in-point (q #:in 'sw #:size size #:origin pos)) (pt 5 15))
-   (check-equal? (in-point (q #:in 's #:size size #:origin pos)) (pt 10 15))
-   (check-equal? (in-point (q #:in 'se #:size size #:origin pos)) (pt 15 15)))
+   (check-equal? (at-point (q #:at 'nw #:size size #:origin pos)) (pt 5 5))
+   (check-equal? (at-point (q #:at 'n #:size size #:origin pos)) (pt 10 5))
+   (check-equal? (at-point (q #:at 'ne #:size size #:origin pos)) (pt 15 5))
+   (check-equal? (at-point (q #:at 'w #:size size #:origin pos)) (pt 5 10))
+   (check-equal? (at-point (q #:at 'c #:size size #:origin pos)) (pt 10 10))
+   (check-equal? (at-point (q #:at 'e #:size size #:origin pos)) (pt 15 10))
+   (check-equal? (at-point (q #:at 'sw #:size size #:origin pos)) (pt 5 15))
+   (check-equal? (at-point (q #:at 's #:size size #:origin pos)) (pt 10 15))
+   (check-equal? (at-point (q #:at 'se #:size size #:origin pos)) (pt 15 15)))
 
 
   (test-case
    "out points"
    (define size (pt 10 10))
    (define pos (pt 5 5))
-   (check-equal? (out-point (q #:out 'nw #:size size #:origin pos)) (pt 5 5))
-   (check-equal? (out-point (q #:out 'n #:size size #:origin pos)) (pt 10 5))
-   (check-equal? (out-point (q #:out 'ne #:size size #:origin pos)) (pt 15 5))
-   (check-equal? (out-point (q #:out 'w #:size size #:origin pos)) (pt 5 10))
-   (check-equal? (out-point (q #:out 'c #:size size #:origin pos)) (pt 10 10))
-   (check-equal? (out-point (q #:out 'e #:size size #:origin pos)) (pt 15 10))
-   (check-equal? (out-point (q #:out 'sw #:size size #:origin pos)) (pt 5 15))
-   (check-equal? (out-point (q #:out 's #:size size #:origin pos)) (pt 10 15))
-   (check-equal? (out-point (q #:out 'se #:size size #:origin pos)) (pt 15 15)))
+   (check-equal? (on-point (q #:on 'nw #:size size #:origin pos)) (pt 5 5))
+   (check-equal? (on-point (q #:on 'n #:size size #:origin pos)) (pt 10 5))
+   (check-equal? (on-point (q #:on 'ne #:size size #:origin pos)) (pt 15 5))
+   (check-equal? (on-point (q #:on 'w #:size size #:origin pos)) (pt 5 10))
+   (check-equal? (on-point (q #:on 'c #:size size #:origin pos)) (pt 10 10))
+   (check-equal? (on-point (q #:on 'e #:size size #:origin pos)) (pt 15 10))
+   (check-equal? (on-point (q #:on 'sw #:size size #:origin pos)) (pt 5 15))
+   (check-equal? (on-point (q #:on 's #:size size #:origin pos)) (pt 10 15))
+   (check-equal? (on-point (q #:on 'se #:size size #:origin pos)) (pt 15 15)))
 
   )
 

quad/quad/quad.rkt

@@ -35,7 +35,7 @@
 (define (quad=? q1 q2 [recur? #t])
   (and
    ;; exclude attrs from initial comparison
-   (for/and ([getter (in-list (list quad-elems quad-size quad-in quad-out 
+   (for/and ([getter (in-list (list quad-elems quad-size quad-on-parent quad-on quad-at 
                                     quad-shift quad-offset quad-on-parent quad-origin quad-printable
                                     quad-draw-start quad-draw-end quad-draw))])
      (equal? (getter q1) (getter q2)))
@@ -50,9 +50,9 @@
               ;; size is a two-dim pt
               size ; outer size of quad for layout (though not necessarily the bounding box for drawing)
               ;; in, out are phrased in terms of cardinal position
-              in ; alignment point on this quad that is matched to `out` on previous quad
-              out ; alignment point on ref quad
               on-parent ; position on parent quad?
+              on ; alignment point on ref quad
+              at ; alignment point on this quad that is matched to `out` on previous quad
               ;; offset, shift are two-dim pts
               ;; offset= Similar to `relative` CSS positioning
               ;; relocation of pen before quad is drawn. Does NOT change layout position.
@@ -114,9 +114,9 @@
          #:attrs [attrs (make-hasheq)]
          #:elems [elems null]
          #:size [size '(0 0)]
-         #:in [in 'nw]
-         #:out [out 'nw]
          #:on-parent [on-parent #false]
+         #:on [on 'nw]
+         #:at [at 'nw]
          #:shift [shift '(0 0)]
          #:offset [offset '(0 0)]
          #:origin [origin '(0 0)]
@@ -134,19 +134,19 @@
     [(list elems ..1) (make-quad #:elems elems)]
     ;; all cases end up below
     [null (define args (list
-                              attrs
-                              elems
-                              size
-                              in
-                              out
-                              on-parent
-                              offset
-                              shift
-                              origin
-                              printable
-                              draw-start
-                              draw
-                              draw-end))
+                        attrs
+                        elems
+                        size
+                        on-parent
+                        on
+                        at
+                        offset
+                        shift
+                        origin
+                        printable
+                        draw-start
+                        draw
+                        draw-end))
           (define id (eq-hash-code args))
           (apply type (append args (list id)))]))
 

quad/quadwriter/core.rkt

@@ -46,8 +46,8 @@
     [_ #true]))
 
 (define q:string (q #:type string-quad
-                    #:out 'bo
-                    #:in 'bi
+                    #:on 'bo
+                    #:at 'bi
                     #:on-parent #false
                     #:printable q:string-printable?
                     #:draw q:string-draw
@@ -100,7 +100,7 @@
     (stroke doc stroke-color)
     ;; draw in point & out point (both on layout box)
     (define point-draw-diameter (+ stroke-width 1.5))
-    (for ([which-point (list in-point out-point)])
+    (for ([which-point (list at-point on-point)])
       (define pt (which-point q))
       (circle doc (pt-x pt) (pt-y pt) point-draw-diameter)
       (fill doc fill-color))
@@ -110,15 +110,15 @@
     (restore doc)))
 
 (define q:line (q #:size (pt 0 default-line-height)
-                  #:out 'sw
-                  #:in 'nw
+                  #:on 'sw
+                  #:at 'nw
                   #:printable #true
                   #:draw-start (if draw-debug-line? draw-debug void)))
 
 (struct line-spacer quad () #:transparent)
 (define q:line-spacer (q #:type line-spacer
                          #:size (pt 0 (* default-line-height 0.6))
-                         #:out 'sw
+                         #:on 'sw
                          #:printable (λ (q sig) (not (memq sig '(start end))))
                          #:draw-start (if (draw-debug-line?) draw-debug void)))
 
@@ -316,7 +316,7 @@
                          #:type offsetter
                          #:offset (pt (quad-ref elem 'inset-left 0) 0)
                          #:elems elems))))
-               (attach-to-parent new-elems 'sw))]))]
+               (on-parent new-elems 'sw))]))]
          [_ null])]))
   (append new-lines (cond
                       [ending-q null]
@@ -390,24 +390,29 @@
   (scale doc (if zoom-mode? zoom-scale 1) (if zoom-mode? zoom-scale 1)))
 
 (define (draw-page-footer q doc)
-  (define top-margin (pt-y (quad-offset q)))
-  (define bottom-margin (- (pdf-height doc) top-margin))
+  (match-define (list x y) (quad-origin q))
   (font-size doc (* .8 default-font-size))
   (font doc default-font-face)
   (fill-color doc "black")
-  (text doc (format "~a · ~a at ~a" (hash-ref (quad-attrs q) 'page-number)
-                    (hash-ref (quad-attrs q) 'doc-title)
+  (text doc (format "~a · ~a at ~a" (quad-ref q 'page-number 0)
+                    (quad-ref q 'doc-title "untitled")
                     (date->string (current-date) #t))
-        (pt-x (quad-offset q))
-        (+ (- (pdf-height doc) bottom-margin) 20)))
-
-(define (page-draw-end q doc)
-  #;(draw-page-footer q doc)
-  (void))
-
-(define q:page (q #:offset '(0 0)
-                  #:draw-start page-draw-start
-                  #:draw-end page-draw-end))
+        x y))
+
+(define q:footer (q #:size (pt 50 default-line-height)
+                    #:on-parent #true
+                    #:on 'sw
+                    #:at 'nw
+                    #:shift (pt 0 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 q:page (q
+                #:on-parent #true
+                #:draw-start page-draw-start))
 
 (define q:doc (q #:draw-start (λ (q doc) (start-doc doc))
                  #:draw-end (λ (q doc) (end-doc doc))))
@@ -452,11 +457,11 @@
 
 (define (block-wrap lines)
   (define first-line (car lines)) 
-  (q #:out 'sw
-     #:in 'nw
+  (q #:on 'sw
+     #:at 'nw
      #:on-parent #false
      #:offset (pt 0 (+ (quad-ref first-line 'inset-top 0)))
-     #:elems (attach-to-parent lines 'nw)
+     #:elems (on-parent lines 'nw)
      #:size (delay (pt (pt-x (size first-line)) ; 
                        (+ (for/sum ([line (in-list lines)])
                             (pt-y (size line)))
@@ -484,26 +489,24 @@
    (contiguous-group-by values '(1 1 2 2 2 3 4 5 5 6 6 7 8 9))
    '((1 1) (2 2 2) (3) (4) (5 5) (6 6) (7) (8) (9))))
 
-(define (attach-to-parent qs where)
+(define/match (on-parent qs [where #f])
   ;; doesn't change any positioning. doesn't depend on state. can happen anytime.
   ;; can be repeated without damage.
-  (match qs
-    [(? null?) null]
-    [(cons q rest)
-     (cons (struct-copy quad q
-                        [on-parent #true]
-                        [out where]) rest)]))
-
-(define ((page-finish-wrap page-quad path) lns q0 q idx)
+  [((? null?) _) null]
+  [((cons q rest) where)
+   (cons (struct-copy quad q
+                      [on-parent #true]
+                      [on (or where (quad-on q))]) rest)])
+
+(define ((page-finish-wrap page-quad path) lns q0 q page-idx)
+  (define-values (dir name _) (split-path (path-replace-extension path #"")))
+  (define footer (struct-copy quad q:footer
+                              [attrs (let ([h (hash-copy (quad-attrs q:footer))])
+                                       (hash-set! h 'page-number page-idx)
+                                       (hash-set! h 'doc-title (string-titlecase (path->string name)))
+                                       h)]))
   (list (struct-copy quad page-quad
-                     [attrs (let ([page-number idx]
-                                  [h (hash-copy (quad-attrs page-quad))])
-                              (hash-set! h 'page-number page-number)
-                              (define-values (dir name _)
-                                (split-path (path-replace-extension path #"")))
-                              (hash-set! h 'doc-title (string-titlecase (path->string name)))
-                              h)]
-                     [elems (attach-to-parent (insert-blocks lns) 'nw)])))
+                     [elems (cons footer (on-parent (insert-blocks lns) 'nw))])))
 
 (define (page-wrap xs vertical-height [page-quad q:page])
   (unless (positive? vertical-height)
@@ -597,8 +600,8 @@
       (make-pdf #:compress #t
                 #:auto-first-page #f
                 #:output-path pdf-path
-                #:width 350
-                #:height 350
+                #:width page-width
+                #:height page-height
                 #:size (quad-ref (car qs) 'page-size default-page-size)
                 #:orientation (quad-ref (car qs) 'page-orientation default-page-orientation))))
 
@@ -606,7 +609,7 @@
   (define default-y-margin (min 72 (floor (* .10 (pdf-width pdf)))))
   (parameterize ([current-pdf pdf]
                  [verbose-quad-printing? #false]
-                 [draw-debug? #true])
+                 [draw-debug? #false])
     (let* ([qs (time-name hyphenate (handle-hyphenate qs))]
            [qs (map ->string-quad qs)]
            [qs (insert-first-line-indents qs)]

quad/quadwriter/param.rkt

@@ -6,5 +6,5 @@
 
 (define draw-debug? (make-parameter #f))
 (define draw-debug-line? (make-parameter #t))
-(define draw-debug-block? (make-parameter #f))
+(define draw-debug-block? (make-parameter #t))
 (define draw-debug-string? (make-parameter #t))

quad/quadwriter/tags.rkt

@@ -14,9 +14,9 @@
   (qexpr (append `(#;(first-line-indent "12")
                    #;(line-align "center")
                    #;(line-wrap "kp")
-                   #;(page-margin-left "120")
-                   #;(page-margin-top "80")
-                   #;(page-margin-bottom "120")
+                   (page-margin-left "120")
+                   (page-margin-top "80")
+                   (page-margin-bottom "120")
                    (line-height "17")
                    #;(line-align-last "center")) attrs) exprs))