diff --git a/quad/qtest/fark.rkt b/quad/qtest/fark.rkt index 6ba07418..9e501288 100644 --- a/quad/qtest/fark.rkt +++ b/quad/qtest/fark.rkt @@ -1,3 +1,3 @@ -#lang quadwriter +#lang quadwriter/markdown -Hello world \ 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 d6857424..91e41a59 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -57,36 +57,48 @@ [(or 'bi 'bo 'baseline-in 'baseline-out) (vertical-baseline-offset q)] [_ 0]))))) -(define (inner-point q) - ;; calculate absolute location of inner-point - ;; based on current origin and point type. - ;; include offset, because it's intended to adjust inner - (pt+ (quad-position q) (anchor->local-point q (or (quad-inner q) (quad-in q))) (quad-offset q))) - (define (in-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 - (pt+ (quad-position q) (anchor->local-point q (quad-in q)))) + (anchor->global-point q (quad-in q))) (define (out-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 - (pt+ (quad-position q) (anchor->local-point q (quad-out q)))) + (anchor->global-point q (quad-out q))) + +(define (anchor->global-point q anchor) + ;; don't include shift here: it should be baked into origin calculation + (pt+ (anchor->local-point q anchor) (quad-origin q))) -(define (position q [previous-end-pt (pt 0 0)]) +(define (position q [ref-src #f]) ;; recursively calculates coordinates for quad & subquads - ;; based on starting origin point - (define new-position (pt+ (pt- previous-end-pt (in-point q)) (quad-shift q))) - (let ([q (struct-copy quad q [position new-position])]) - (let loop ([pt (inner-point q)] [acc null] [elems (quad-elems q)]) - (match elems - [(== empty) (struct-copy quad q [elems (reverse acc)])] - [(cons (? quad? q) rest) - (define new-q (position q pt)) - (loop (out-point new-q) (cons new-q acc) rest)] - [(cons x rest) (loop pt (cons x acc) rest)])))) + (define ref-pt (cond + [(quad? ref-src) (anchor->global-point ref-src (quad-out q))] + [ref-src] ; for passing explicit points in testing + [else (pt 0 0)])) + (define this-origin (pt- ref-pt (in-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 + [origin shifted-origin] + ;; set shift to zero because it's baked into new origin value + [shift (pt 0 0)])) + (let ([parent-q positioned-q]) + (struct-copy quad parent-q + [elems + ;; can't use for/list here because previous quads provide context for later ones + (let loop ([prev-elems null] [elems (quad-elems parent-q)]) + (match elems + [(? null?) (reverse prev-elems)] + [(cons (? quad? this-q) rest) + (define ref-q (if (or (quad-on-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- (out-point q) (in-point q)) @@ -99,69 +111,60 @@ "origins" (define size (pt 10 10)) (define orig (pt 5 5)) - (check-equal? (quad-position (position (q #:in 'nw #:size size) orig)) (pt 5 5)) - (check-equal? (quad-position (position (q #:in 'n #:size size) orig)) (pt 0 5)) - (check-equal? (quad-position (position (q #:in 'ne #:size size) orig)) (pt -5 5)) - (check-equal? (quad-position (position (q #:in 'e #:size size) orig)) (pt -5 0)) - (check-equal? (quad-position (position (q #:in 'se #:size size) orig)) (pt -5 -5)) - (check-equal? (quad-position (position (q #:in 's #:size size) orig)) (pt 0 -5)) - (check-equal? (quad-position (position (q #:in 'sw #:size size) orig)) (pt 5 -5)) - (check-equal? (quad-position (position (q #:in 'w #:size size) orig)) (pt 5 0))) + (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))) + + + (test-case + "origins with shifts" + (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))) (test-case "in points" (define size '(10 10)) (define pos '(5 5)) - (check-equal? (in-point (q #:in 'nw #:size size #:position pos)) (pt 5 5)) - (check-equal? (in-point (q #:in 'n #:size size #:position pos)) (pt 10 5)) - (check-equal? (in-point (q #:in 'ne #:size size #:position pos)) (pt 15 5)) - (check-equal? (in-point (q #:in 'w #:size size #:position pos)) (pt 5 10)) - (check-equal? (in-point (q #:in 'c #:size size #:position pos)) (pt 10 10)) - (check-equal? (in-point (q #:in 'e #:size size #:position pos)) (pt 15 10)) - (check-equal? (in-point (q #:in 'sw #:size size #:position pos)) (pt 5 15)) - (check-equal? (in-point (q #:in 's #:size size #:position pos)) (pt 10 15)) - (check-equal? (in-point (q #:in 'se #:size size #:position pos)) (pt 15 15))) + (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))) + (test-case "out points" (define size (pt 10 10)) (define pos (pt 5 5)) - (check-equal? (out-point (q #:out 'nw #:size size #:position pos)) (pt 5 5)) - (check-equal? (out-point (q #:out 'n #:size size #:position pos)) (pt 10 5)) - (check-equal? (out-point (q #:out 'ne #:size size #:position pos)) (pt 15 5)) - (check-equal? (out-point (q #:out 'w #:size size #:position pos)) (pt 5 10)) - (check-equal? (out-point (q #:out 'c #:size size #:position pos)) (pt 10 10)) - (check-equal? (out-point (q #:out 'e #:size size #:position pos)) (pt 15 10)) - (check-equal? (out-point (q #:out 'sw #:size size #:position pos)) (pt 5 15)) - (check-equal? (out-point (q #:out 's #:size size #:position pos)) (pt 10 15)) - (check-equal? (out-point (q #:out 'se #:size size #:position pos)) (pt 15 15))) - - (test-case - "inner points" - (define size '(20 20)) - (define orig '(10 10)) - (check-equal? (inner-point (position (q #:size size #:inner 'nw) orig)) (pt 10 10)) - (check-equal? (inner-point (position (q #:size size #:inner 'n) orig)) (pt 20 10)) - (check-equal? (inner-point (position (q #:size size #:inner 'ne) orig)) (pt 30 10)) - (check-equal? (inner-point (position (q #:size size #:inner 'e) orig)) (pt 30 20)) - (check-equal? (inner-point (position (q #:size size #:inner 'se) orig)) (pt 30 30)) - (check-equal? (inner-point (position (q #:size size #:inner 's) orig)) (pt 20 30)) - (check-equal? (inner-point (position (q #:size size #:inner 'sw) orig)) (pt 10 30)) - (check-equal? (inner-point (position (q #:size size #:inner 'w) orig)) (pt 10 20))) - - (test-case - "inner points with offsets" - (define size (pt 10 10)) - (define orig (pt 0 0)) - (define off (pt (random 100) (random 100))) - (check-equal? (inner-point (position (q #:size size #:inner 'nw #:offset off) orig)) (pt+ '(0 0) off)) - (check-equal? (inner-point (position (q #:size size #:inner 'n #:offset off) orig)) (pt+ '(5 0) off)) - (check-equal? (inner-point (position (q #:size size #:inner 'ne #:offset off) orig)) (pt+ '(10 0) off)) - (check-equal? (inner-point (position (q #:size size #:inner 'e #:offset off) orig)) (pt+ '(10 5) off)) - (check-equal? (inner-point (position (q #:size size #:inner 'se #:offset off) orig)) (pt+ '(10 10) off)) - (check-equal? (inner-point (position (q #:size size #:inner 's #:offset off) orig)) (pt+ '(5 10) off)) - (check-equal? (inner-point (position (q #:size size #:inner 'sw #:offset off) orig)) (pt+ '(0 10) off)) - (check-equal? (inner-point (position (q #:size size #:inner 'w #:offset off) orig)) (pt+ '(0 5) off)))) + (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))) + + ) #;(module+ test (require racket/runtime-path fontland/font) diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index 74c71163..7c80c2c7 100644 --- a/quad/quad/quad.rkt +++ b/quad/quad/quad.rkt @@ -30,15 +30,15 @@ (define (hashes-equal? h1 h2) (and (= (length (hash-keys h1)) (length (hash-keys h2))) (for/and ([(k v) (in-hash h1)]) - (and (hash-has-key? h2 k) (equal? (hash-ref h2 k) v))))) + (and (hash-has-key? h2 k) (equal? (hash-ref h2 k) v))))) (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 quad-inner - quad-shift quad-offset quad-position quad-printable + (for/and ([getter (in-list (list quad-elems quad-size quad-in quad-out + quad-shift quad-offset quad-on-parent quad-origin quad-printable quad-draw-start quad-draw-end quad-draw))]) - (equal? (getter q1) (getter q2))) + (equal? (getter q1) (getter q2))) ;; and compare them key-by-key (hashes-equal? (quad-attrs q1) (quad-attrs q2)))) @@ -49,10 +49,10 @@ 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, inner are phrased in terms of cardinal position - in ; alignment point matched to previous quad - out ; alignment point matched to next quad - inner ; alignment point for elems (might be different from in/out) + ;; 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? ;; offset, shift are two-dim pts ;; offset= Similar to `relative` CSS positioning ;; relocation of pen before quad is drawn. Does NOT change layout position. @@ -63,20 +63,22 @@ shift ;; reference point (in absolute coordinates) ;; for all subsequent drawing ops in the quad. Calculated, not set directly - position + origin printable ; whether the quad will print draw-start ; func called at the beginning of every draw event (for setup ops) draw ; func called in the middle of every daw event draw-end ; func called at the end of every draw event (for teardown ops) + id ) #:transparent #:property prop:custom-write (λ (q p w?) (display - (format "<~a~a~a>" + (format "<~a-~a~a~a>" (object-name q) + (quad-id q) (if (verbose-quad-printing?) (string-join (map ~v (flatten (hash->list (quad-attrs q)))) - " " #:before-first "(" #:after-last ")") + " " #:before-first "(" #:after-last ")") "") (match (quad-elems q) [(? pair?) (string-join (map ~v (quad-elems q)) " " #:before-first " ")] @@ -113,11 +115,11 @@ #:elems [elems null] #:size [size '(0 0)] #:in [in 'nw] - #:out [out 'ne] - #:inner [inner #f] + #:out [out 'nw] + #:on-parent [on-parent #false] #:shift [shift '(0 0)] #:offset [offset '(0 0)] - #:position [position '(0 0)] + #:origin [origin '(0 0)] #:printable [printable default-printable] #:draw-start [draw-start void] #:draw [draw default-draw] @@ -131,19 +133,22 @@ [(list (? dict? assocs) elems ...) assocs (make-quad #:attrs (make-hasheq assocs) #:elems elems)] [(list elems ..1) (make-quad #:elems elems)] ;; all cases end up below - [null (type attrs - elems - size - in - out - inner - offset - shift - position - printable - draw-start - draw - draw-end)])) + [null (define args (list + attrs + elems + size + in + out + on-parent + offset + shift + origin + printable + draw-start + draw + draw-end)) + (define id (eq-hash-code args)) + (apply type (append args (list id)))])) (define-syntax (define-quad stx) (syntax-case stx () diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index 14b5fc43..1afdc6fb 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -25,7 +25,7 @@ (font-size doc (quad-ref q 'font-size 12)) (fill-color doc (quad-ref q 'color "black")) (define str (unsafe-car (quad-elems q))) - (match-define (list x y) (quad-position q)) + (match-define (list x y) (quad-origin q)) (text doc str x y #:tracking (quad-ref q 'character-tracking 0) #:bg (quad-ref q 'bg) @@ -46,8 +46,9 @@ [_ #true])) (define q:string (q #:type string-quad - #:in 'baseline-in - #:out 'baseline-out + #:out 'bo + #:in 'bi + #:on-parent #false #:printable q:string-printable? #:draw q:string-draw #:draw-end q:string-draw-end)) @@ -95,7 +96,7 @@ (save doc) ;; draw layout box (line-width doc stroke-width) - (apply rect doc (append (pt+ (quad-position q)) (size q))) + (apply rect doc (append (pt+ (quad-origin q)) (size q))) (stroke doc stroke-color) ;; draw in point & out point (both on layout box) (define point-draw-diameter (+ stroke-width 1.5)) @@ -104,13 +105,13 @@ (circle 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) - (fill doc stroke-color) + #;(rect-centered doc (pt-x (inner-point q)) (pt-y (inner-point q)) point-draw-diameter) + #;(fill doc stroke-color) (restore doc))) (define q:line (q #:size (pt 0 default-line-height) - #:inner 'sw #:out 'sw + #:in 'nw #:printable #true #:draw-start (if draw-debug-line? draw-debug void))) @@ -243,7 +244,7 @@ (define-quad offsetter quad ()) (define (hr-draw dq doc) - (match-define (list left top) (quad-position dq)) + (match-define (list left top) (quad-origin dq)) (match-define (list right bottom) (size dq)) (save doc) (translate doc left (+ top (/ bottom 2))) @@ -262,61 +263,64 @@ (define pcs-printing (for/list ([pc (in-list pcs-in)] #:unless (equal? (quad-elems pc) '("\u00AD"))) pc)) - (append - (cond - [(empty? pcs-printing) null] - [(hr-break? ending-q) (list (make-hr-quad line-q))] - [else - ;; render hyphen first so that all printable characters are available for size-dependent ops. - (define pcs-with-hyphen (render-hyphen pcs-printing ending-q)) - ;; fill wrap so that consolidate-runs works properly - ;; (justified lines won't be totally consolidated) - (define pcs (fill-wrap pcs-with-hyphen ending-q line-q)) - (match (consolidate-runs pcs ending-q) - [(? pair? elems) - (define elem (unsafe-car elems)) - (match-define (list line-width line-height) (quad-size line-q)) - (define new-size (let () - (define line-heights - (filter-map (λ (q) (quad-ref q 'line-height)) pcs)) - (pt line-width (if (empty? line-heights) line-height (apply max line-heights))))) - (list - (struct-copy - quad line-q - ;; move block attrs up, so they are visible in page wrap - [attrs (copy-block-attrs (quad-attrs elem) - (hash-copy (quad-attrs line-q)))] - ;; line width is static - ;; line height is the max 'line-height value or the natural height of q:line - [size new-size] - ;; handle list indexes. drop new quad into line to hold list index - ;; could also use this for line numbers - [elems - ;; we assume here that a list item has already had extra inset-left - ;; with room for a bullet - ;; which we just insert at the front. - ;; this is safe because line has already been filled. - (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 - #:offset (pt (quad-ref elem 'inset-left 0) 0) - #:elems elems)))]))] - [_ null])]) - (cond - [ending-q null] - [else (list q:line-spacer)]))) + (define new-lines + (cond + [(empty? pcs-printing) null] + [(hr-break? ending-q) (list (make-hr-quad line-q))] + [else + ;; render hyphen first so that all printable characters are available for size-dependent ops. + (define pcs-with-hyphen (render-hyphen pcs-printing ending-q)) + ;; fill wrap so that consolidate-runs works properly + ;; (justified lines won't be totally consolidated) + (define pcs (fill-wrap pcs-with-hyphen ending-q line-q)) + (match (consolidate-runs pcs ending-q) + [(? pair? elems) + (define elem (unsafe-car elems)) + (match-define (list line-width line-height) (quad-size line-q)) + (define new-size (let () + (define line-heights + (filter-map (λ (q) (quad-ref q 'line-height)) pcs)) + (pt line-width (if (empty? line-heights) line-height (apply max line-heights))))) + (list + (struct-copy + quad line-q + ;; move block attrs up, so they are visible in page wrap + [attrs (copy-block-attrs (quad-attrs elem) + (hash-copy (quad-attrs line-q)))] + ;; line width is static + ;; line height is the max 'line-height value or the natural height of q:line + [size new-size] + ;; handle list indexes. drop new quad into line to hold list index + ;; could also use this for line numbers + [elems + ;; we assume here that a list item has already had extra inset-left + ;; 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 + #:offset (pt (quad-ref elem 'inset-left 0) 0) + #:elems elems)))) + (attach-to-parent new-elems 'sw))]))] + [_ null])])) + (append new-lines (cond + [ending-q null] + [else (list q:line-spacer)]))) (define (line-wrap qs wrap-size) (unless (positive? wrap-size) @@ -398,7 +402,8 @@ (+ (- (pdf-height doc) bottom-margin) 20))) (define (page-draw-end q doc) - (draw-page-footer q doc)) + #;(draw-page-footer q doc) + (void)) (define q:page (q #:offset '(0 0) #:draw-start page-draw-start @@ -412,7 +417,7 @@ (match-define (list bil bit bir bib) (for/list ([k (in-list '(border-inset-left border-inset-top border-inset-right border-inset-bottom))]) (quad-ref first-line k 0))) - (match-define (list left top) (pt+ (quad-position q) (list bil bit))) + (match-define (list left top) (pt+ (quad-origin q) (list bil bit))) (match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib)))) ;; fill rect (cond @@ -447,10 +452,11 @@ (define (block-wrap lines) (define first-line (car lines)) - (q #:in 'nw - #:out 'sw + (q #:out 'sw + #:in 'nw + #:on-parent #false #:offset (pt 0 (+ (quad-ref first-line 'inset-top 0))) - #:elems lines + #:elems (attach-to-parent lines 'nw) #:size (delay (pt (pt-x (size first-line)) ; (+ (for/sum ([line (in-list lines)]) (pt-y (size line))) @@ -478,6 +484,16 @@ (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) + ;; 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) (list (struct-copy quad page-quad [attrs (let ([page-number idx] @@ -487,7 +503,7 @@ (split-path (path-replace-extension path #""))) (hash-set! h 'doc-title (string-titlecase (path->string name))) h)] - [elems (insert-blocks lns)]))) + [elems (attach-to-parent (insert-blocks lns) 'nw)]))) (define (page-wrap xs vertical-height [page-quad q:page]) (unless (positive? vertical-height) @@ -581,8 +597,8 @@ (make-pdf #:compress #t #:auto-first-page #f #:output-path pdf-path - #:width page-width - #:height page-height + #:width 350 + #:height 350 #:size (quad-ref (car qs) 'page-size default-page-size) #:orientation (quad-ref (car qs) 'page-orientation default-page-orientation)))) @@ -590,7 +606,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)] @@ -605,7 +621,7 @@ [bottom-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 0 0)] + [shift (pt left-margin top-margin)] [size (pt line-wrap-size page-wrap-size)])] [qs (time-name page-wrap (page-wrap qs page-wrap-size page-quad))] [qs (time-name position (position (struct-copy quad q:doc [elems 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 diff --git a/quad/quadwriter/tags.rkt b/quad/quadwriter/tags.rkt index f42a0814..73278842 100644 --- a/quad/quadwriter/tags.rkt +++ b/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))