From baad58952134a8a3cd45c01875a690342f57480b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 7 May 2019 08:06:58 -0700 Subject: [PATCH] curious --- quad/qtest/fark.rkt | 5 ++- quad/quad/position.rkt | 88 +++++++++++++++++++-------------------- quad/quad/quad.rkt | 22 +++++----- quad/quadwriter/core.rkt | 41 +++++++++--------- quad/quadwriter/param.rkt | 2 +- 5 files changed, 81 insertions(+), 77 deletions(-) diff --git a/quad/qtest/fark.rkt b/quad/qtest/fark.rkt index 9e501288..d564913c 100644 --- a/quad/qtest/fark.rkt +++ b/quad/qtest/fark.rkt @@ -1,3 +1,6 @@ #lang quadwriter/markdown -Hi there \ No newline at end of file +# Hi + + +## There \ No newline at end of file diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 02915df9..c1d0d76c 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -57,17 +57,17 @@ [(or 'bi 'bo 'baseline-in 'baseline-out) (vertical-baseline-offset q)] [_ 0]))))) -(define (at-point q) - ;; calculate absolute location of in-point +(define (to-point q) + ;; calculate absolute location ;; based on current origin and point type. ;; don't include offset, so location is on bounding box - (anchor->global-point q (quad-at q))) + (anchor->global-point q (quad-to q))) -(define (on-point q) - ;; calculate absolute location of out-point +(define (from-point q) + ;; calculate absolute location ;; based on current origin and point type. ;; don't include offset, so location is on bounding box - (anchor->global-point q (quad-on q))) + (anchor->global-point q (quad-from 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-on q))] + [(quad? ref-src) (anchor->global-point ref-src (quad-from q))] [ref-src] ; for passing explicit points in testing [else (pt 0 0)])) - (define this-origin (pt- ref-pt (at-point q))) + (define this-origin (pt- ref-pt (to-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 @@ -94,14 +94,14 @@ (match elems [(? null?) (reverse prev-elems)] [(cons (? quad? this-q) rest) - (define ref-q (if (or (quad-on-parent this-q) (null? prev-elems)) + (define ref-q (if (or (quad-from-parent this-q) (null? prev-elems)) parent-q (car prev-elems))) (loop (cons (position this-q ref-q) prev-elems) rest)] [(cons x rest) (loop (cons x prev-elems) rest)]))]))) (define (distance q) - (match (pt- (on-point q) (at-point q)) + (match (pt- (from-point q) (to-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 #: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))) + (check-equal? (quad-origin (position (q #:to 'nw #:size size) orig)) (pt 5 5)) + (check-equal? (quad-origin (position (q #:to 'n #:size size) orig)) (pt 0 5)) + (check-equal? (quad-origin (position (q #:to 'ne #:size size) orig)) (pt -5 5)) + (check-equal? (quad-origin (position (q #:to 'e #:size size) orig)) (pt -5 0)) + (check-equal? (quad-origin (position (q #:to 'se #:size size) orig)) (pt -5 -5)) + (check-equal? (quad-origin (position (q #:to 's #:size size) orig)) (pt 0 -5)) + (check-equal? (quad-origin (position (q #:to 'sw #:size size) orig)) (pt 5 -5)) + (check-equal? (quad-origin (position (q #:to '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 #: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))) + (check-equal? (quad-origin (position (q #:to 'nw #:size size #:shift shift) orig)) (pt+ (pt 5 5) shift)) + (check-equal? (quad-origin (position (q #:to 'n #:size size #:shift shift) orig)) (pt+ (pt 0 5) shift)) + (check-equal? (quad-origin (position (q #:to 'ne #:size size #:shift shift) orig)) (pt+ (pt -5 5) shift)) + (check-equal? (quad-origin (position (q #:to 'e #:size size #:shift shift) orig)) (pt+ (pt -5 0) shift)) + (check-equal? (quad-origin (position (q #:to 'se #:size size #:shift shift) orig)) (pt+ (pt -5 -5) shift)) + (check-equal? (quad-origin (position (q #:to 's #:size size #:shift shift) orig)) (pt+ (pt 0 -5) shift)) + (check-equal? (quad-origin (position (q #:to 'sw #:size size #:shift shift) orig)) (pt+ (pt 5 -5) shift)) + (check-equal? (quad-origin (position (q #:to '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? (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))) + (check-equal? (to-point (q #:to 'nw #:size size #:origin pos)) (pt 5 5)) + (check-equal? (to-point (q #:to 'n #:size size #:origin pos)) (pt 10 5)) + (check-equal? (to-point (q #:to 'ne #:size size #:origin pos)) (pt 15 5)) + (check-equal? (to-point (q #:to 'w #:size size #:origin pos)) (pt 5 10)) + (check-equal? (to-point (q #:to 'c #:size size #:origin pos)) (pt 10 10)) + (check-equal? (to-point (q #:to 'e #:size size #:origin pos)) (pt 15 10)) + (check-equal? (to-point (q #:to 'sw #:size size #:origin pos)) (pt 5 15)) + (check-equal? (to-point (q #:to 's #:size size #:origin pos)) (pt 10 15)) + (check-equal? (to-point (q #:to 'se #:size size #:origin pos)) (pt 15 15))) (test-case "out points" (define size (pt 10 10)) (define pos (pt 5 5)) - (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))) + (check-equal? (from-point (q #:from 'nw #:size size #:origin pos)) (pt 5 5)) + (check-equal? (from-point (q #:from 'n #:size size #:origin pos)) (pt 10 5)) + (check-equal? (from-point (q #:from 'ne #:size size #:origin pos)) (pt 15 5)) + (check-equal? (from-point (q #:from 'w #:size size #:origin pos)) (pt 5 10)) + (check-equal? (from-point (q #:from 'c #:size size #:origin pos)) (pt 10 10)) + (check-equal? (from-point (q #:from 'e #:size size #:origin pos)) (pt 15 10)) + (check-equal? (from-point (q #:from 'sw #:size size #:origin pos)) (pt 5 15)) + (check-equal? (from-point (q #:from 's #:size size #:origin pos)) (pt 10 15)) + (check-equal? (from-point (q #:from 'se #:size size #:origin pos)) (pt 15 15))) ) diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index d72cb113..d39e2dc3 100644 --- a/quad/quad/quad.rkt +++ b/quad/quad/quad.rkt @@ -35,8 +35,8 @@ (define (quad=? q1 q2 [recur? #t]) (and ;; exclude attrs from initial comparison - (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 + (for/and ([getter (in-list (list quad-elems quad-size quad-from-parent quad-from quad-to + quad-shift quad-offset quad-from-parent quad-origin quad-printable quad-draw-start quad-draw-end quad-draw))]) (equal? (getter q1) (getter q2))) ;; and compare them key-by-key @@ -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 - 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 + from-parent ; position on parent quad? + from ; alignment point on ref quad + to ; alignment point on this quad that is matched to `from` 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)] - #:on-parent [on-parent #false] - #:on [on 'nw] - #:at [at 'nw] + #:from-parent [from-parent #false] + #:from [from 'ne] + #:to [to 'nw] #:shift [shift '(0 0)] #:offset [offset '(0 0)] #:origin [origin '(0 0)] @@ -137,9 +137,9 @@ attrs elems size - on-parent - on - at + from-parent + from + to offset shift origin diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index dd3bbfd8..1aef9336 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -46,9 +46,8 @@ [_ #true])) (define q:string (q #:type string-quad - #:on 'bo - #:at 'bi - #:on-parent #false + #:from 'bo + #:to 'bi #:printable q:string-printable? #:draw q:string-draw #:draw-end q:string-draw-end)) @@ -100,9 +99,12 @@ (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 at-point on-point)]) + (for ([which-point (list to-point from-point)] + [func (list circle circle-squared)]) + ;; if from-point is square, then its edges are still visible + ;; when to-point cricle is drawn on top (define pt (which-point q)) - (circle doc (pt-x pt) (pt-y pt) point-draw-diameter) + (func doc (pt-x pt) (pt-y pt) point-draw-diameter) (fill doc fill-color)) ;; draw inner point (adjusted by offset) #;(rect-centered doc (pt-x (inner-point q)) (pt-y (inner-point q)) point-draw-diameter) @@ -110,15 +112,15 @@ (restore doc))) (define q:line (q #:size (pt 0 default-line-height) - #:on 'sw - #:at 'nw + #:from 'sw + #:to '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)) - #:on 'sw + #:from 'sw #:printable (λ (q sig) (not (memq sig '(start end)))) #:draw-start (if (draw-debug-line?) draw-debug void))) @@ -400,9 +402,9 @@ x y)) (define q:footer (q #:size (pt 50 default-line-height) - #:on-parent #true - #:on 'sw - #:at 'nw + #:from-parent #true + #:from 'sw + #:to 'nw #:shift (pt 0 default-line-height) #:printable #true #:draw-start (λ (q doc) @@ -411,7 +413,7 @@ (draw-page-footer q doc)))) (define q:page (q - #:on-parent #true + #:from-parent #true #:draw-start page-draw-start)) (define q:doc (q #:draw-start (λ (q doc) (start-doc doc)) @@ -457,9 +459,8 @@ (define (block-wrap lines) (define first-line (car lines)) - (q #:on 'sw - #:at 'nw - #:on-parent #false + (q #:from 'sw + #:to 'nw #:offset (pt 0 (+ (quad-ref first-line 'inset-top 0))) #:elems (on-parent lines 'nw) #:size (delay (pt (pt-x (size first-line)) ; @@ -495,8 +496,8 @@ [((? null?) _) null] [((cons q rest) where) (cons (struct-copy quad q - [on-parent #true] - [on (or where (quad-on q))]) rest)]) + [from-parent #true] + [from (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 #""))) @@ -600,8 +601,8 @@ (make-pdf #:compress #t #:auto-first-page #f #:output-path pdf-path - #:width page-width - #:height page-height + #:width #;page-width 400 + #:height #;page-height 400 #:size (quad-ref (car qs) 'page-size default-page-size) #:orientation (quad-ref (car qs) 'page-orientation default-page-orientation)))) @@ -609,7 +610,7 @@ (define default-y-margin (min 72 (floor (* .10 (pdf-width pdf))))) (parameterize ([current-pdf pdf] [verbose-quad-printing? #false] - [draw-debug? #false]) + [draw-debug? #true]) (let* ([qs (time-name hyphenate (handle-hyphenate qs))] [qs (map ->string-quad qs)] [qs (insert-first-line-indents qs)] diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index b5714693..445f84a3 100644 --- a/quad/quadwriter/param.rkt +++ b/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 #t)) +(define draw-debug-block? (make-parameter #f)) (define draw-debug-string? (make-parameter #t)) \ No newline at end of file