diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 79519606..dd0de50c 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -10,10 +10,13 @@ (define point? (list/c number? number?)) -(define (valid-anchor? anchor) (define valid-anchors '(nw n ne w c e sw s se bi bo)) + +(define (valid-anchor? anchor) (and (memq anchor valid-anchors) #t)) +(define (random-anchor) + (list-ref valid-anchors (random (length valid-anchors)))) (define (coerce-int x) (if (integer? x) (inexact->exact x) x)) @@ -34,12 +37,15 @@ (unitsPerEm (hash-ref! fonts p (λ () (openSync p))))) (define (fontsize q) + ;; this needs to not default to 0 + ;; needs parameter with default font size (define val (hash-ref (attrs q) 'fontsize 0)) ((if (number? val) values string->number) val)) (define/contract (anchor->point q anchor) (quad? symbol? . -> . point?) + ;; calculate the location of the anchor on the bounding box relative to '(0 0) (unless (valid-anchor? anchor) (raise-argument-error 'relative-anchor-pt "valid anchor" anchor)) (cond @@ -58,20 +64,33 @@ (define/contract (inner-point q) point/c + ;; calculate absolute location of inner-point + ;; based on current origin and point type. + ;; include offset, because it's intended to adjust inner (pt+ (origin q) (anchor->point q (inner q)) (offset q))) (define/contract (in-point q) point/c + ;; calculate absolute location of in-point + ;; based on current origin and point type. + ;; don't include offset, so location is on bounding box (pt+ (origin q) (anchor->point q (in q)))) (define/contract (out-point q) point/c - (pt+ (origin q) (anchor->point q (out q)))) ; no offset because end-point is calculated without padding + ;; calculate absolute location of out-point + ;; based on current origin and point type. + ;; don't include offset, so location is on bounding box + (pt+ (origin q) (anchor->point q (out q)))) -(define/contract (position q [previous-end-pt (origin q)]) +(define/contract (position q [previous-end-pt #f]) ((quad?) (point?) . ->* . quad?) - (set-origin! q (pt- previous-end-pt (in-point q))) + ;; recursively calculates coordinates for quad & subquads + ;; based on starting origin point + (set-origin! q (if previous-end-pt + (pt- previous-end-pt (in-point q)) + (in-point q))) (for/fold ([pt (inner-point q)]) ([q (in-list (elems q))] #:when (quad? q)) diff --git a/quad/quad/typewriter-test.rkt b/quad/quad/typewriter-test.rkt index e883ad2d..19678582 100644 --- a/quad/quad/typewriter-test.rkt +++ b/quad/quad/typewriter-test.rkt @@ -1,3 +1,3 @@ #lang quad/typewriter -H◊quad[#:fontsize "32"]{H}◊quad[#:fontsize "8"]{H} \ No newline at end of file +◊quad[#:fontsize "18"]{Hel}◊quad[#:fontsize "32"]{Lo}◊quad[#:fontsize "8"]{ World} \ No newline at end of file diff --git a/quad/quad/typewriter.rkt b/quad/quad/typewriter.rkt index 873d041e..3120db2b 100644 --- a/quad/quad/typewriter.rkt +++ b/quad/quad/typewriter.rkt @@ -15,13 +15,12 @@ (send doc save) (send doc lineWidth 0.25) (send/apply doc rect (append (origin q) (size q))) - (send doc stroke) - #R (hash-ref (attrs q) 'in) - (send doc circle (+ (pt-x #R(origin q)) (pt-x #R(in-point q))) - (+ (pt-y (origin q)) (pt-y (in-point q))) 1) - (send doc circle (+ (pt-x (origin q)) (pt-x #R(out-point q))) - (+ (pt-y (origin q)) (pt-y (out-point q))) 1) - (send doc fill) + (send doc stroke "#fcc") + (send/apply doc rect (append (origin q) (size q))) + (send doc clip) + (send doc circle (pt-x (in-point q)) (pt-y (in-point q)) 1) + (send doc circle (pt-x (out-point q)) (pt-y (out-point q)) 1) + (send doc fill "#f99") (send doc restore)) (define char-sizes (make-hasheqv)) @@ -30,13 +29,12 @@ 'in 'bi 'out 'bo 'font fira - 'size (hash-ref! char-sizes (car (elems q)) - (λ () - (send util-doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12"))) - (send util-doc font fira) - (list - (send util-doc widthOfString (apply string (elems q))) - (send util-doc currentLineHeight)))) + 'size (λ () + (send util-doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12"))) + (send util-doc font fira) + (list + (send util-doc widthOfString (apply string (elems q))) + (send util-doc currentLineHeight))) 'printable? (case (car (elems q)) [(#\u00AD) (λ (sig) (memq sig '(end)))] [(#\space) (λ (sig) (not (memq sig '(start end))))] @@ -76,7 +74,7 @@ (values (cons new-run runs) rest))) (define line-height 16) -(define consolidate-into-runs? #t) +(define consolidate-into-runs? #f) (define (line-wrap xs size [debug #f]) (break xs size debug #:break-val (make-break #\newline)