catch

quad/qtest/fark.rkt

@@ -1,7 +1,6 @@
 #lang qtest/markdown
 
-Why don't we
+Tenzing
+We
 
-1. list the ways
-
-2. we can
+* whoudl.

quad/qtest/markdown.rkt

@@ -235,9 +235,10 @@
                         border-width-left border-width-right border-width-top border-width-bottom
                         border-color-left border-color-right border-color-top border-color-bottom
                         background-color))
-  (for ([k (in-list block-attrs)])
-    (cond
-      [(hash-ref source-hash k #f) => (λ (val) (hash-set! dest-hash k val))]))
+  (for* ([k (in-list block-attrs)]
+         [v (in-value (hash-ref source-hash k #f))]
+         #:when v)
+    (hash-set! dest-hash k v))
   dest-hash)
 
 (define (line-wrap xs wrap-size)
@@ -246,8 +247,11 @@
                          (quad-ref q 'inset-right 0)))                        
         #:hard-break line-break?
         #:soft-break soft-break-for-line?
+        #:wrap-count (λ (idx q) (if (para-break? q)
+                                    1
+                                    (add1 idx)))
         #:finish-wrap
-        (λ (pcs ending-q idx)
+        (λ (pcs opening-q ending-q idx)
           (append
            (cond
              [(empty? pcs) null]
@@ -266,47 +270,36 @@
                 [(? pair? elems)
                  (define elem (unsafe-car elems))
                  (list (struct-copy quad q:line
+                                    ;; move block attrs up, so they are visible in page wrap
                                     [attrs (copy-block-attrs (quad-attrs elem)
                                                              (hash-copy (quad-attrs q:line)))]
+                                    ;; line width is static
+                                    ;; line height is the max 'line-height value or the natural height of q:line
                                     [size (let ()
                                             (define line-heights
-                                              (filter-map
-                                               (λ (q) (quad-ref q 'line-height))
-                                               pcs))
+                                              (filter-map (λ (q) (quad-ref q 'line-height)) pcs))
                                             (match-define (list w h) (quad-size q:line))
                                             (pt w (if (empty? line-heights) h (apply max line-heights))))]
-                                    [elems (let ()
-                                             ;; problem here is that ending-q tells us the quad that ends the wrap
-                                             ;; but not the quad that started the wrap
-                                             ;; which is what we need to detect whether we are
-                                             ;; in the first line of a list item.
-                                             #R (car elems)
-                                             (append
-                                            (match (and #R ending-q (or #R (para-break? ending-q) #R (not ending-q))
-                                                        (quad-ref elem 'list-index))
+                                    ;; handle list indexes. drop new quad into line to hold list index
+                                    [elems (append
+                                            (match (and (= idx 1) (quad-ref elem 'list-index))
                                               [#false null]
                                               [bullet (list (make-quad
-                                                             #:in 'sw
-                                                             #:out 'sw
-                                                             #:size (pt 10 10)
-                                                             #:draw-end (λ (q doc) (draw-debug q doc "red" "red"))
+                                                             ;; wart: iffy to rely on `(car elems)` here
+                                                             ;; what if first elem is not a string quad?
                                                              #:elems (list (struct-copy quad (car elems)
                                                                                         [elems (list (if (number? bullet)
                                                                                                          (format "~a." bullet)
                                                                                                          bullet))]))))])
                                             (list (make-quad
-                                                   #:in 'nw
-                                                   #:out 'nw
-                                                   #:size (pt 15 15)
-                                                   #:draw-end (λ (q doc) (draw-debug q doc "blue" "blue"))
                                                    #:offset (pt (quad-ref elem 'inset-left 0) 0)
-                                                   #:elems elems))))]))]
+                                                   #:elems elems)))]))]
                 [_ null])])
            (if (and (para-break? ending-q) (not (hr-break? ending-q)))
                (list q:line-spacer)
                null)))))
 
-(define zoom-mode? #t)
+(define zoom-mode? #f)
 (define top-margin 60)
 (define bottom-margin 120)
 (define side-margin 120)
@@ -407,7 +400,7 @@
                      ;; do trial block insertions
                      (for/sum ([x (in-list (insert-blocks wrap-qs))])
                        (pt-y (size x))))                     
-        #:finish-wrap (λ (lns q idx)
+        #:finish-wrap (λ (lns q0 q idx)
                         (list (struct-copy quad q:page
                                            [attrs (let ([page-number idx]
                                                         [h (hash-copy (quad-attrs q:page))])

quad/quad/atomize.rkt

@@ -14,10 +14,13 @@
 (module+ test
   (require rackunit))
 
+(define (update-with! h . update-hashes)
+  (apply hash-union! #:combine (λ (v1 v2) v2) h update-hashes))
+
 (define (update-with base-hash . update-hashes)
   ;; starting with base-hash, add or update keys found in update-hashes
   (define h (make-hasheq))
-  (apply hash-union! #:combine (λ (v1 v2) v2) h base-hash update-hashes)
+  (apply update-with! h base-hash update-hashes)
   h)
 
 (module+ test
@@ -79,7 +82,7 @@
                           null
                           (list (apply x-maker next-attrs (list elem) x-tail)))
                       (loop elem next-attrs next-key))))]
-      [_ (list x)])))
+      [_ ((quad-attrs x) . update-with! . next-attrs) (list x)])))
   #;(trimf atomized-qs (λ (q) (equal? (quad-elems q) '(" "))))
   atomized-qs)
 
@@ -89,7 +92,7 @@
                        (hash-remove! (quad-attrs q) 'run))) qs)
     qs)
   (struct $br quad ())
-  (define br (q #:type $br (hasheq 'br "time")))
+  (define br (q #:type $br (make-hasheq '((br . "time")))))
   (check-equal? (filter-private-keys (atomize (q (q "a b") br (q "x y"))))
                 (list (q "a") (q " ") (q "b") br (q "x") (q " ") (q "y")))  
   (check-equal?

quad/quad/wrap.rkt

@@ -25,29 +25,31 @@
               #:wrap-anywhere? [wrap-anywhere? #f]
               #:distance [distance-func (λ (q last-dist wrap-qs)
                                           (+ last-dist (if (printable? q) (distance q) 0)))]
-              #:finish-wrap [finish-wrap-func (λ (xs q idx) (list xs))])
+              #:wrap-count [wrap-count (λ (idx q) (add1 idx))]
+              #:finish-wrap [finish-wrap-func (λ (xs q0 q idx) (list xs))])
   (define target-size-proc
     (match target-size-proc-arg
       [(? procedure? proc) proc]
       [val (λ (q idx) val)]))
   ; takes quads in wrap, triggering quad, and wrap idx; returns list containing wrap (and maybe other things)
-  (define (finish-wrap qs wrap-idx [wrap-triggering-q (car qs)])
+  (define (finish-wrap qs previous-wrap-ender wrap-idx [wrap-triggering-q (car qs)])
     ;; reverse because quads accumulated in reverse
     ;; wrap-triggering-q is ordinarily the last accumulated q
     ;; unless it's the last wrap, in which case it's #f
     ;; but we capture it separately because it's likely to get trimmed away by `nonprinting-at-end?`
     ;; note: we don't trim `soft-break?` or `hard-break?` because that's an orthogonal consideration
     ;; for instance, a hyphen is `soft-break?` but shouldn't be trimmed.
-    (finish-wrap-func (reverse (dropf qs nonprinting-at-end?)) wrap-triggering-q wrap-idx))
+    (finish-wrap-func (reverse (dropf qs nonprinting-at-end?)) previous-wrap-ender wrap-triggering-q wrap-idx))
   (let loop ([wraps null] ; list of (list of quads)
              [wrap-idx 1] ; wrap count (could be (length wraps) but we'd rather avoid `length`)
              [next-wrap-head null] ; list of quads ending in previous `soft-break?` or `hard-break?`
              [next-wrap-tail null] ; list of unbreakable quads
              [current-dist #false] ; #false (to indicate start) or integer
+             [previous-wrap-ender #f]
              [qs qs]) ; list of quads
     (match qs
       [(or (== empty) (list (? hard-break?))) ; ignore single trailing hard break
-       (define last-wrap (finish-wrap (wrap-append next-wrap-tail next-wrap-head) wrap-idx #f))
+       (define last-wrap (finish-wrap (wrap-append next-wrap-tail next-wrap-head) previous-wrap-ender wrap-idx #f))
        ; append* because `finish-wrap-proc` returns a spliceable list
        ; reverse because wraps accumulated in reverse
        ; as a special case, '(()) is returned as just '()
@@ -62,11 +64,12 @@
          [(hard-break? q)
           (debug-report 'found-hard-break)
           ;; put hard break onto next-wrap-tail, and finish the wrap
-          (loop (cons (finish-wrap would-be-wrap-qs wrap-idx) wraps)
-                (add1 wrap-idx)
+          (loop (cons (finish-wrap would-be-wrap-qs previous-wrap-ender wrap-idx) wraps)
+                (wrap-count wrap-idx q)
                 null
                 null
                 #false
+                q
                 other-qs)]
          [(let ([at-start? (not current-dist)]) at-start?)
           (match q
@@ -77,13 +80,15 @@
                    next-wrap-head
                    next-wrap-tail
                    current-dist
+                   previous-wrap-ender
                    other-qs)]
             [_ (debug-report 'hard-quad-at-start)
                (loop wraps
                      wrap-idx
                      next-wrap-head
                      (list q)
-                     (distance q)
+                     (distance-func q 0 would-be-wrap-qs)
+                     previous-wrap-ender
                      other-qs)])]
          [else ; cases that require computing distance
           (define cumulative-dist (distance-func q current-dist would-be-wrap-qs))
@@ -93,11 +98,12 @@
              (cond
                [wrap-anywhere?
                 (debug-report 'we-can-wrap-anywhere-so-why-not-here)
-                (loop (cons (finish-wrap (wrap-append next-wrap-tail next-wrap-head) wrap-idx) wraps)
-                      (add1 wrap-idx)
+                (loop (cons (finish-wrap (wrap-append next-wrap-tail next-wrap-head) previous-wrap-ender wrap-idx) wraps)
+                      (wrap-count wrap-idx q)
                       null
                       null
                       #false
+                      q
                       qs)]
                [(and (soft-break? q) (nonprinting-at-end? q))
                 (debug-report 'would-overflow-soft-nonprinting)
@@ -108,21 +114,24 @@
                       (wrap-append (cons q next-wrap-tail) next-wrap-head)
                       null
                       cumulative-dist
+                      previous-wrap-ender
                       other-qs)]
                [(empty? next-wrap-head)
                 (debug-report 'would-overflow-hard-without-captured-break)
-                (loop (cons (finish-wrap next-wrap-tail wrap-idx) wraps)
-                      (add1 wrap-idx)
+                (loop (cons (finish-wrap next-wrap-tail previous-wrap-ender wrap-idx) wraps)
+                      (wrap-count wrap-idx q)
                       null
                       null
                       #false
+                      (car next-wrap-tail)
                       qs)]
                [else ; finish the wrap & reset the line without consuming a quad
-                (loop (cons (finish-wrap next-wrap-head wrap-idx) wraps)
-                      (add1 wrap-idx)
+                (loop (cons (finish-wrap next-wrap-head previous-wrap-ender wrap-idx) wraps)
+                      (wrap-count wrap-idx q)
                       null
                       next-wrap-tail
                       (apply + (map distance next-wrap-tail))
+                      (car next-wrap-head)
                       qs)])]         
             [(soft-break? q)
              (debug-report 'would-not-overflow-soft)
@@ -132,6 +141,7 @@
                    (wrap-append (cons q next-wrap-tail) next-wrap-head)
                    null
                    cumulative-dist
+                   previous-wrap-ender
                    other-qs)]
             [else
              (debug-report 'would-not-overflow)
@@ -141,6 +151,7 @@
                    next-wrap-head
                    (cons q next-wrap-tail)
                    cumulative-dist
+                   previous-wrap-ender
                    other-qs)])])])))
 
 (define q-zero (q #:size (pt 0 0)))