touchy

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])

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))))))))
+                       (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))))))))

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)]

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

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