From 92f6825b74643c11144c4264f264745fdfb02455 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 4 Jan 2019 11:23:18 -0800 Subject: [PATCH] up --- quad/quad/break.rkt | 23 +++++++++++++++-------- quad/quad/position.rkt | 18 ++---------------- quad/quad/quad.rkt | 2 +- 3 files changed, 18 insertions(+), 25 deletions(-) diff --git a/quad/quad/break.rkt b/quad/quad/break.rkt index 86d2357b..876488fd 100644 --- a/quad/quad/break.rkt +++ b/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))) diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 6bda16c2..b841d4e9 100644 --- a/quad/quad/position.rkt +++ 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 diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index ed8bc201..16116374 100644 --- a/quad/quad/quad.rkt +++ b/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))