From d5fd81b2744f8b2f5ab2e0b48eaf2aa8688f779d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 24 Jan 2019 14:40:12 -0800 Subject: [PATCH] catch --- quad/qtest/fark.rkt | 7 +++--- quad/qtest/markdown.rkt | 47 ++++++++++++++++++----------------------- quad/quad/atomize.rkt | 9 +++++--- quad/quad/wrap.rkt | 37 ++++++++++++++++++++------------ 4 files changed, 53 insertions(+), 47 deletions(-) diff --git a/quad/qtest/fark.rkt b/quad/qtest/fark.rkt index 40f44374..ba342f78 100644 --- a/quad/qtest/fark.rkt +++ b/quad/qtest/fark.rkt @@ -1,7 +1,6 @@ #lang qtest/markdown -Why don't we +Tenzing +We -1. list the ways - -2. we can \ No newline at end of file +* whoudl. \ No newline at end of file diff --git a/quad/qtest/markdown.rkt b/quad/qtest/markdown.rkt index c3400369..d27de92d 100644 --- a/quad/qtest/markdown.rkt +++ b/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))]) diff --git a/quad/quad/atomize.rkt b/quad/quad/atomize.rkt index 336e7329..c274e7bc 100644 --- a/quad/quad/atomize.rkt +++ b/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? diff --git a/quad/quad/wrap.rkt b/quad/quad/wrap.rkt index 8532b5dc..f96319d9 100644 --- a/quad/quad/wrap.rkt +++ b/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)))