diff --git a/quad/quad/generic.rkt b/quad/quad/generic.rkt index 04b33d48..bb608839 100644 --- a/quad/quad/generic.rkt +++ b/quad/quad/generic.rkt @@ -3,8 +3,8 @@ (provide (all-defined-out)) (define-generics quad - (start quad) - (end quad) + (in quad) + (out quad) (inner quad) (size quad [signal]) diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 73728bb6..e9d112af 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -36,22 +36,22 @@ point/c (pt+ (origin q) (anchor->point q (inner q) signal) (offset q))) -(define/contract (start-point q [signal #f]) +(define/contract (in-point q [signal #f]) point/c - (anchor->point q (start q) signal)) + (anchor->point q (in q) signal)) -(define/contract (end-point q [signal #f]) +(define/contract (out-point q [signal #f]) point/c - (pt+ (origin q) (anchor->point q (end q) signal))) ; no offset because end-point is calculated without padding + (pt+ (origin q) (anchor->point q (out q) signal))) ; no offset because end-point is calculated without padding (define/contract (position q [previous-end-pt (pt 0 0)]) ((quad?) (point?) . ->* . quad?) - (set-origin! q (pt- previous-end-pt (start-point q))) + (set-origin! q (pt- previous-end-pt (in-point q))) (for/fold ([pt (inner-point q)]) ([q (in-list (elems q))] #:when (quad? q)) - (end-point (position q pt))) + (out-point (position q pt))) q) @@ -61,14 +61,14 @@ "origins" (define size (pt 10 10)) (define orig (pt 5 5)) - (check-equal? (origin (position (quad (hasheq 'start 'nw 'size size)) orig)) (pt 5 5)) - (check-equal? (origin (position (quad (hasheq 'start 'n 'size size)) orig)) (pt 0 5)) - (check-equal? (origin (position (quad (hasheq 'start 'ne 'size size)) orig)) (pt -5 5)) - (check-equal? (origin (position (quad (hasheq 'start 'e 'size size)) orig)) (pt -5 0)) - (check-equal? (origin (position (quad (hasheq 'start 'se 'size size)) orig)) (pt -5 -5)) - (check-equal? (origin (position (quad (hasheq 'start 's 'size size)) orig)) (pt 0 -5)) - (check-equal? (origin (position (quad (hasheq 'start 'sw 'size size)) orig)) (pt 5 -5)) - (check-equal? (origin (position (quad (hasheq 'start 'w 'size size)) orig)) (pt 5 0))) + (check-equal? (origin (position (quad (hasheq 'in 'nw 'size size)) orig)) (pt 5 5)) + (check-equal? (origin (position (quad (hasheq 'in 'n 'size size)) orig)) (pt 0 5)) + (check-equal? (origin (position (quad (hasheq 'in 'ne 'size size)) orig)) (pt -5 5)) + (check-equal? (origin (position (quad (hasheq 'in 'e 'size size)) orig)) (pt -5 0)) + (check-equal? (origin (position (quad (hasheq 'in 'se 'size size)) orig)) (pt -5 -5)) + (check-equal? (origin (position (quad (hasheq 'in 's 'size size)) orig)) (pt 0 -5)) + (check-equal? (origin (position (quad (hasheq 'in 'sw 'size size)) orig)) (pt 5 -5)) + (check-equal? (origin (position (quad (hasheq 'in 'w 'size size)) orig)) (pt 5 0))) (test-case "inner points" @@ -99,10 +99,10 @@ (test-case "folding positions" - (check-equal? (position (quad (quad '(end se) (quad) (quad) (quad)) - (quad '(end se) (quad) (quad) (quad)) - (quad '(end se) (quad) (quad) (quad)))) + (check-equal? (position (quad (quad '(out se) (quad) (quad) (quad)) + (quad '(out se) (quad) (quad) (quad)) + (quad '(out se) (quad) (quad) (quad)))) (quad '(origin (0 0)) - (quad '(origin (0 0) end se) (quad '(origin (0 0))) (quad '(origin (1 0))) (quad '(origin (2 0)))) - (quad '(origin (1 1) end se) (quad '(origin (1 1))) (quad '(origin (2 1))) (quad '(origin (3 1)))) - (quad '(origin (2 2) end se) (quad '(origin (2 2))) (quad '(origin (3 2))) (quad '(origin (4 2)))))))) \ No newline at end of file + (quad '(origin (0 0) out se) (quad '(origin (0 0))) (quad '(origin (1 0))) (quad '(origin (2 0)))) + (quad '(origin (1 1) out se) (quad '(origin (1 1))) (quad '(origin (2 1))) (quad '(origin (3 1)))) + (quad '(origin (2 2) out se) (quad '(origin (2 2))) (quad '(origin (3 2))) (quad '(origin (4 2)))))))) \ No newline at end of file diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index 0e8f2f1d..6e57fae5 100644 --- a/quad/quad/quad.rkt +++ b/quad/quad/quad.rkt @@ -14,9 +14,9 @@ #:methods gen:quad [(define (elems q) ($quad-elems q)) (define (attrs q) ($quad-attrs q)) - (define (start q) (hash-ref (attrs q) 'start 'nw)) - (define (end q) (hash-ref (attrs q) 'end 'ne)) - (define (inner q) (hash-ref (attrs q) 'inner (λ () (start q)))) + (define (in q) (hash-ref (attrs q) 'in 'nw)) + (define (out q) (hash-ref (attrs q) 'out 'ne)) + (define (inner q) (hash-ref (attrs q) 'inner (λ () (in q)))) (define (size q [signal #f]) (let ([v (hash-ref (attrs q) 'size (λ () (default-size-proc q signal)))]) (cond [(procedure? v) (v signal)] diff --git a/quad/quad/typewriter.rkt b/quad/quad/typewriter.rkt index 717e1cc9..d9c6d406 100644 --- a/quad/quad/typewriter.rkt +++ b/quad/quad/typewriter.rkt @@ -15,12 +15,12 @@ (struct $page $quad () #:transparent) (struct $doc $quad () #:transparent) (struct $break $quad () #:transparent) -(define (break . xs) ($break (hasheq 'size (delay (values 0 0 0))) xs)) +(define (break . xs) ($break (hasheq 'size '(0 0)) xs)) (define (lbs xs size [debug #f]) (wrap xs size debug #:break-val (break #\newline) #:optional-break-proc optional-break? - #:finish-segment-proc (λ (pcs) (list ($line (hasheq) (map charify pcs)))))) + #:finish-segment-proc (λ (pcs) (list ($line (hasheq 'size '(0 12) 'out 'sw) (map charify pcs)))))) (define (pbs xs size [debug #f]) (wrap xs size debug @@ -29,7 +29,7 @@ #:finish-segment-proc (λ (pcs) (list ($page (hasheq) (filter-not $break? pcs)))))) (define (typeset args) - (quad->qexpr ($doc (hasheq) (map position (filter-not $break? (pbs (lbs (atomize (apply quad #f args)) (* 3 7.2)) (* 2 12))))))) + ($doc (hasheq) (map position (filter-not $break? (pbs (lbs (atomize (apply quad #f args)) 3) (* 5 12)))))) (define-syntax-rule (mb lang-line-config-arg . args) (#%module-begin diff --git a/quad/quad/wrap.rkt b/quad/quad/wrap.rkt index a9680a20..2897a59d 100644 --- a/quad/quad/wrap.rkt +++ b/quad/quad/wrap.rkt @@ -6,7 +6,7 @@ ((any/c) (any/c) . ->* . real?) (cond [(quad? q) - (match-define (list ∆x ∆y) (map - (end-point q signal) (start-point q signal))) + (match-define (list ∆x ∆y) (map - (out-point q signal) (in-point q signal))) (cond [(zero? ∆x) ∆y] [(zero? ∆y) ∆x] @@ -59,12 +59,13 @@ (add-to-segment)])] [(or at-start? underflow?) (when debug (report x 'add-ordinary-char)) (add-to-segment)] + ;; overflow handlers [last-optional-break-k (when debug (report x 'invoking-last-breakpoint)) (last-optional-break-k #t)] + ;; fallback if no last-breakpoint-k exists [else (when debug (report x 'falling-back)) (match-define-values (vals _ _) (insert-break)) - (values vals (list x) (distance x 'start))]))))) ;; fallback if no last-breakpoint-k exists - + (values vals (list x) (distance x 'start))]))))) (define x (q #f #\x)) @@ -210,10 +211,10 @@ (define (slug . xs) ($slug #f xs)) (define (linewrap2 xs size [debug #f]) (wrap xs size debug - #:break-val 'lb - #:mandatory-break-proc (λ (q) (and (quad? q) (memv (car (elems q)) '(#\newline)))) - #:optional-break-proc optional-break? - #:finish-segment-proc (λ (pcs) (list ($slug #f pcs))))) + #:break-val 'lb + #:mandatory-break-proc (λ (q) (and (quad? q) (memv (car (elems q)) '(#\newline)))) + #:optional-break-proc optional-break? + #:finish-segment-proc (λ (pcs) (list ($slug #f pcs))))) (module+ test (test-case