up

quad/quad/break.rkt

@@ -121,6 +121,7 @@
              #:break (empty? qs))
     (match-define (cons q other-qs) qs)
     (debug-report q 'next-q)
+    (debug-report (quad-elems q) 'next-q-elems)
     (define at-start? (not current-dist))
     (define dist (if (and (quad? q) (printable? q)) (distance q) 0))
     (define would-overflow? (and current-dist (> (+ dist current-dist) target-size)))
@@ -212,6 +213,9 @@
          #:hard-break-proc (λ (q) (and (quad? q) (memv (car (quad-elems q)) '(#\newline))))
          #:soft-break-proc soft-break?))
 
+(module+ test
+  (require rackunit))
+
 (module+ test
   (require rackunit)
   (test-case
@@ -307,13 +311,15 @@
    (check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
 
 (define (visual-wrap str int [debug #f])
-  (apply string (for/list ([b (in-list (linewrap (for/list ([atom (atomize str)])
-                                                   (struct-copy quad q-one
-                                                                [attrs (quad-attrs atom)]
-                                                                [elems (quad-elems atom)])) int debug))])
-                  (cond
-                    [(quad? b) (car (quad-elems b))]
-                    [else #\|]))))
+  (apply string
+         (for/list ([b (in-list (linewrap (for/list ([atom (atomize str)])
+                                            (if (equal? (quad-elems atom) '(#\space))
+                                                (struct-copy quad sp)
+                                                (struct-copy quad q-one
+                                                             [attrs (quad-attrs atom)]
+                                                             [elems (quad-elems atom)]))) int debug))])
+           (if (quad? b) (car (quad-elems b)) #\|))))
+
 (module+ test
   (test-case
    "visual breaks"
@@ -343,6 +349,7 @@
 (define pbr (q #:size #false #:elems '(#\page)))
 
 (module+ test
+  (require rackunit)
   (test-case
    "soft page breaks"
    (check-equal? (pagewrap null 2) '(pb))
@@ -380,7 +387,7 @@
          #:soft-break-proc soft-break?
          #:finish-wrap-proc (λ (pcs) (list (apply slug pcs)))))
 
-#;(module+ test
+(module+ test
   (test-case
    "hard breaks and spurious spaces with slugs"
    (check-equal? (linewrap2 (list a sp sp sp br b) 2) (list (slug a) 'lb (slug b)))

quad/quad/position.rkt

@@ -159,21 +159,7 @@
    (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)))
-
-  #;(test-case
-     "folding positions"
-     (define (unit [attrs null] . elems) (apply quad (append attrs '(size (1 1))) elems))
-     (check-equal? (position (unit null (unit '(out se) (unit) (unit) (unit))
-                                   (unit '(out se) (unit) (unit) (unit))
-                                   (unit '(out se) (unit) (unit) (unit))))
-                   (unit '(origin (0 0))
-                         (unit '(origin (0 0) out se)
-                               (unit '(origin (0 0))) (unit '(origin (1 0))) (unit '(origin (2 0))))
-                         (unit '(origin (1 1) out se)
-                               (unit '(origin (1 1))) (unit '(origin (2 1))) (unit '(origin (3 1))))
-                         (unit '(origin (2 2) out se)
-                               (unit '(origin (2 2))) (unit '(origin (3 2))) (unit '(origin (4 2))))))))
+   (check-equal? (inner-point (position (q #:size size #:inner 'w #:offset off) orig)) (pt+ '(0 5) off))))
 
 (module+ test
   (require racket/runtime-path fontland/font)
@@ -182,7 +168,7 @@
   (define q1 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12)))
   (define q2 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 24)))
   (define q3 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 6)))
-  (position (q #f q1 q2 q3)))
+  #;(position (q #f q1 q2 q3)))
 
 
 #;(module+ test

quad/quad/quad.rkt

@@ -43,7 +43,7 @@
               printable
               pre-draw
               post-draw
-              draw) #:mutable
+              draw) #:mutable #:transparent
   #:methods gen:equal+hash
   [(define equal-proc quad=?)
    (define (hash-proc h recur) (equal-hash-code h))