next: study block wrapping

quad/qtest/fark.rkt

@@ -1,5 +1,8 @@
 #lang quadwriter/markdown
 
-# And
+text
 
-so
+```
+one
+two
+```

quad/quad/position.rkt

@@ -36,11 +36,11 @@
   (define val (quad-ref q 'font-size current-default-font-size))
   ((if (number? val) values string->number) val))
 
-(define (vertical-baseline-offset q)
+(define (vertical-baseline-offset q [fallback-val 0])
   (cond
-    [(quad-ref q font-path-key #false)
+    [(quad-ref q font-path-key)
      (* (/ (ascender q) (units-per-em q) 1.0) (fontsize q))]
-    [else 0]))
+    [else fallback-val]))
 
 (define (anchor->local-point q anchor)
   ;; calculate the location of the anchor on the bounding box relative to '(0 0) (aka "locally")
@@ -54,7 +54,9 @@
   (match-define (list x y) (size q))
   (pt (coerce-int (* x x-fac))
       (coerce-int (+ (* y y-fac) (match anchor
-                                   [(or 'bi 'bo 'baseline-in 'baseline-out) (vertical-baseline-offset q)]
+                                   [(or 'bi 'bo 'baseline-in 'baseline-out)
+                                    ;; if no font available, match baseline to south edge by passing y as fallback value
+                                    (vertical-baseline-offset q y)]
                                    [_ 0])))))
 
 (define (to-point q)
@@ -76,7 +78,7 @@
 (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-from q))]
+                   [(quad? ref-src) (anchor->global-point ref-src (or (quad-from-parent q) (quad-from q)))]
                    [ref-src] ; for passing explicit points in testing
                    [else (pt 0 0)]))
   (define this-origin (pt- ref-pt (to-point q)))

quad/quad/quad.rkt

@@ -49,8 +49,9 @@
               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)
-              ;; in, out are phrased in terms of cardinal position
-              from-parent ; position on parent quad?
+              ;; from-parent, from, to are phrased in terms of cardinal position
+              from-parent ; alignment point on parent. if not #f, supersedes `from`
+              ;; (this way, `from` doens't change, so a quad can "remember" its default `from` attachment point)
               from ; alignment point on ref quad
               to ; alignment point on this quad that is matched to `from` on previous quad
               ;; shift-elements, shift are two-dim pts

quad/quadwriter/core.rkt

@@ -293,26 +293,28 @@
              ;; with room for a bullet
              ;; which we just insert at the front.
              ;; this is safe because line has already been filled.
-             (let ()
-               (define new-elems
-                 (append
-                  ;; only put bullet into line if we're at the first line of the list item
-                  (match (and (eq? idx 1) (quad-ref elem 'list-index))
-                    [#false null]
-                    [bullet
-                     (list (struct-copy
-                            quad q:string ;; copy q:string to get draw routine
-                            ;; borrow attrs from elem
-                            [attrs (quad-attrs elem)]
-                            ;; use bullet as elems
-                            [elems (list (if (number? bullet) (format "~a." bullet) bullet))]
-                            ;; no size because it's inside inset
-                            [size (pt 0 0)]))])
-                  (list (make-quad
-                         #:type offsetter
-                         #:shift-elements (pt (quad-ref elem 'inset-left 0) 0)
-                         #:elems elems))))
-               (on-parent new-elems 'sw))]))]
+             (append
+              ;; only put bullet into line if we're at the first line of the list item
+              (match (and (eq? idx 1) (quad-ref elem 'list-index))
+                [#false null]
+                [bullet
+                 (define bq (struct-copy
+                             quad q:string ;; copy q:string to get draw routine
+                             ;; borrow attrs from elem
+                             [attrs (quad-attrs elem)]
+                             ;; use bullet as elems
+                             [elems (list (if (number? bullet) (format "~a." bullet) bullet))]
+                             ;; size doesn't matter because nothing refers to this quad
+                             ;; just for debugging box
+                             [size (pt 15 (pt-y (size line-q)))]))
+                 (from-parent (list bq) 'sw)])
+              (cons (make-quad
+                     #:draw-end q:string-draw-end
+                     #:from-parent 'sw
+                     #:to 'sw
+                     #:size (pt (quad-ref elem 'inset-left 0) 5)
+                     #:type offsetter)
+                    elems))]))]
          [_ null])]))
   (append new-lines (cond
                       [ending-q null]
@@ -396,8 +398,7 @@
         x y))
 
 (define q:footer (q #:size (pt 50 default-line-height)
-                    #:from-parent #true
-                    #:from 'sw
+                    #:from-parent 'sw
                     #:to 'nw
                     #:shift (pt 0 default-line-height)
                     #:printable #true
@@ -407,7 +408,7 @@
                                    (draw-page-footer q doc))))
 
 (define q:page (q
-                #:from-parent #true
+                #:from-parent 'nw
                 #:draw-start page-draw-start))
 
 (define q:doc (q #:draw-start (λ (q doc) (start-doc doc))
@@ -455,7 +456,7 @@
   (define first-line (car lines)) 
   (q #:from 'sw
      #:to 'nw
-     #:elems (on-parent lines 'nw)
+     #:elems (from-parent lines 'nw)
      #:size (delay (pt (pt-x (size first-line)) ; 
                        (+ (for/sum ([line (in-list lines)])
                             (pt-y (size line)))
@@ -484,14 +485,13 @@
    (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/match (on-parent qs [where #f])
+(define/match (from-parent qs [where #f])
   ;; doesn't change any positioning. doesn't depend on state. can happen anytime.
   ;; can be repeated without damage.
   [((? null?) _) null]
   [((cons q rest) where)
    (cons (struct-copy quad q
-                      [from-parent #true]
-                      [from (or where (quad-from q))]) rest)])
+                      [from-parent (or where (quad-from q))]) rest)])
 
 (define ((page-finish-wrap page-quad path) lns q0 q page-idx)
   (define-values (dir name _) (split-path (path-replace-extension path #"")))
@@ -501,7 +501,7 @@
                                        (hash-set! h 'doc-title (string-titlecase (path->string name)))
                                        h)]))
   (list (struct-copy quad page-quad
-                     [elems (cons footer (on-parent (insert-blocks lns) 'nw))])))
+                     [elems (cons footer (from-parent (insert-blocks lns) 'nw))])))
 
 (define (page-wrap xs vertical-height [page-quad q:page])
   (unless (positive? vertical-height)
@@ -585,12 +585,10 @@
   ;; page size can be specified by name, or measurements.
   ;; explicit measurements from page-height and page-width supersede those from page-size.
   (define pdf
-    (let ()
-      (match-define (list page-width page-height)
-        (for/list ([k '(page-width page-height)])
-          (match (quad-ref (car qs) k)
-            [#false #false]
-            [val (parse-points val 'round)])))
+    (match-let ([(list page-width page-height) (for/list ([k '(page-width page-height)])
+                                                 (match (quad-ref (car qs) k)
+                                                   [#false #false]
+                                                   [val (parse-points val 'round)]))])
       ;; `make-pdf` will sort out conflicts among page dimensions
       (make-pdf #:compress #t
                 #:auto-first-page #f
@@ -608,14 +606,18 @@
            [qs (map ->string-quad qs)]
            [qs (insert-first-line-indents qs)]
            ;; if only left or right margin is provided, copy other value in preference to default margin
-           [left-margin (quad-ref (car qs) 'page-margin-left (λ () (quad-ref (car qs) 'page-margin-right default-x-margin)))]
-           [right-margin (quad-ref (car qs) 'page-margin-right (λ () (quad-ref (car qs) 'page-margin-left default-y-margin)))]
+           [left-margin (or (debug-x-margin)
+                            (quad-ref (car qs) 'page-margin-left (λ () (quad-ref (car qs) 'page-margin-right default-x-margin))))]
+           [right-margin (or (debug-x-margin)
+                             (quad-ref (car qs) 'page-margin-right (λ () (quad-ref (car qs) 'page-margin-left default-y-margin))))]
            [line-wrap-size (- (pdf-width pdf) left-margin right-margin)]
            [qs (time-name line-wrap (line-wrap qs line-wrap-size))]
            [qs (apply-keeps qs)]
            ;; if only top or bottom margin is provided, copy other value in preference to default margin
-           [top-margin (quad-ref (car qs) 'page-margin-top (λ () (quad-ref (car qs) 'page-margin-bottom default-y-margin)))]
-           [bottom-margin (quad-ref (car qs) 'page-margin-bottom (λ () (quad-ref (car qs) 'page-margin-top default-y-margin)))]
+           [top-margin (or (debug-y-margin)
+                           (quad-ref (car qs) 'page-margin-top (λ () (quad-ref (car qs) 'page-margin-bottom default-y-margin))))]
+           [bottom-margin (or (debug-y-margin)
+                              (quad-ref (car qs) 'page-margin-bottom (λ () (quad-ref (car qs) 'page-margin-top default-y-margin))))]
            [page-wrap-size (- (pdf-height pdf) top-margin bottom-margin)]
            [page-quad (struct-copy quad q:page
                                    [shift (pt left-margin top-margin)]

quad/quadwriter/param.rkt

@@ -1,14 +1,42 @@
-#lang debug racket/base
-(provide (all-defined-out))
-(define current-doc (make-parameter #false))
-(define current-pdf (make-parameter #false))
-(define current-locale (make-parameter 'us))
-
-(define draw-debug? (make-parameter #false))
-(define draw-debug-line? (make-parameter #true))
-(define draw-debug-block? (make-parameter #true))
-(define draw-debug-string? (make-parameter #true))
-
-(define debug-page-width (make-parameter #f))
-(define debug-page-height (make-parameter #f))
-(define zoom-factor (make-parameter 1))
+#lang debug racket
+(define-for-syntax debug-mode #true)
+
+(define-syntax (go stx)
+  (syntax-case stx ()
+    [_
+     debug-mode
+     #'(begin
+         (provide (all-defined-out))
+         (define current-doc (make-parameter #false))
+         (define current-pdf (make-parameter #false))
+         (define current-locale (make-parameter 'us))
+
+         (define draw-debug? (make-parameter #t))
+         (define draw-debug-line? (make-parameter #true))
+         (define draw-debug-block? (make-parameter #true))
+         (define draw-debug-string? (make-parameter #true))
+
+         (define debug-page-width (make-parameter 400))
+         (define debug-page-height (make-parameter 400))
+         (define debug-x-margin (make-parameter 40))
+         (define debug-y-margin (make-parameter 40))
+         (define zoom-factor (make-parameter 3)))]
+    [_
+     #'(begin
+         (provide (all-defined-out))
+         (define current-doc (make-parameter #false))
+         (define current-pdf (make-parameter #false))
+         (define current-locale (make-parameter 'us))
+
+         (define draw-debug? (make-parameter #false))
+         (define draw-debug-line? (make-parameter #true))
+         (define draw-debug-block? (make-parameter #true))
+         (define draw-debug-string? (make-parameter #true))
+
+         (define debug-page-width (make-parameter #f))
+         (define debug-page-height (make-parameter #f))
+         (define debug-x-margin (make-parameter #f))
+         (define debug-y-margin (make-parameter 40))
+         (define zoom-factor (make-parameter 1)))]))
+
+(go)

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