From 6fa628148a0b757ec048f8bfbe17c53cce35204c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 7 Mar 2015 10:53:49 -0800 Subject: [PATCH] pause point: resume in main-typed-tests --- quad/logger-typed.rkt | 5 ++-- quad/main-typed-tests.rkt | 9 +++++++- quad/main-typed.rkt | 48 +++++++++++++++++++++++++++++++++++++++ quad/main.rkt | 2 ++ quad/world-typed.rkt | 2 +- quad/wrap-typed.rkt | 1 + 6 files changed, 63 insertions(+), 4 deletions(-) diff --git a/quad/logger-typed.rkt b/quad/logger-typed.rkt index 43787985..7594ffb0 100644 --- a/quad/logger-typed.rkt +++ b/quad/logger-typed.rkt @@ -40,7 +40,8 @@ (log-quad-debug "~a = ~a" 'x x) x)) -(define-syntax-rule (log-quad-debug* xs) +(: log-quad-debug* ((Listof String) . -> . Void)) +(define (log-quad-debug* xs) (when (equal? (world:logging-level) 'debug) - (map (λ(x) (log-quad-debug x)) xs))) + ((inst for-each String) (λ(x) (log-quad-debug x)) xs))) diff --git a/quad/main-typed-tests.rkt b/quad/main-typed-tests.rkt index 9f67c732..732e20e2 100644 --- a/quad/main-typed-tests.rkt +++ b/quad/main-typed-tests.rkt @@ -19,4 +19,11 @@ (check-equal? (average-looseness (list)) 0.0) ; default value for no lines (check-equal? (average-looseness (list al-test-line)) 0.0) ; default value for one line (check-equal? (average-looseness (list al-test-line al-test-line2)) 42.0) ; last line excluded by default -(check-equal? (average-looseness (list al-test-line al-test-line2 al-test-line)) 36.0) ; last line excluded by default \ No newline at end of file +(check-equal? (average-looseness (list al-test-line al-test-line2 al-test-line)) 36.0) ; last line excluded by default + + +(check-equal? (log-debug-lines (list (line (list world:line-looseness-key 42.0) (word #f "bar")))) '("0/1: \"bar\" 42.0")) + + +;; todo next: debug this line +(block->lines (block #f (word '(measure 50.0) "Meg is an ally."))) \ No newline at end of file diff --git a/quad/main-typed.rkt b/quad/main-typed.rkt index 63512aa8..050d6a70 100644 --- a/quad/main-typed.rkt +++ b/quad/main-typed.rkt @@ -45,3 +45,51 @@ 0.0 (let ([lines-to-measure (drop-right lines 1)]) ; exclude last line from looseness calculation (round-float (/ (foldl fl+ 0.0 ((inst map Flonum Quad) (λ(line) (cast (quad-attr-ref line world:line-looseness-key 0.0) Flonum)) lines-to-measure)) (- (fl (length lines)) 1.0)))))) + + +(provide log-debug-lines) +(define/typed (log-debug-lines lines) + ((Listof Quad) . -> . (Listof String)) + (log-quad-debug "line report:") + (for/list : (Listof String) ([(line idx) (in-indexed lines)]) + (format "~a/~a: ~v ~a" idx + (length lines) + (quad->string line) + (quad-attr-ref line world:line-looseness-key)))) + + +(provide block->lines) +(define/typed (block->lines b) + (Quad . -> . (Listof Quad)) ;; todo: introduce a Quad subtype where quad-list is guaranteed to be all Quads (no strings) + (define quality (cast (quad-attr-ref/parameter b world:quality-key) Real)) + (define/typed (wrap-quads qs) + ((Listof Quad) . -> . (Listof Quad)) + (define wrap-proc (cond + [(>= quality world:max-quality) wrap-best] + [(<= quality world:draft-quality) wrap-first] + [else wrap-adaptive])) + (wrap-proc qs)) + (log-quad-debug "wrapping lines") + (log-quad-debug "quality = ~a" quality) + (log-quad-debug "looseness tolerance = ~a" world:line-looseness-tolerance) + (define wrapped-lines-without-hyphens (wrap-quads (cast (quad-list b) (Listof Quad)))) ; 100/150 + (log-quad-debug* (log-debug-lines wrapped-lines-without-hyphens)) + (define avg-looseness (average-looseness wrapped-lines-without-hyphens)) + (define gets-hyphenation? (and world:use-hyphenation? + (fl> avg-looseness world:line-looseness-tolerance))) + (log-quad-debug "average looseness = ~a" avg-looseness) + (log-quad-debug (if gets-hyphenation? "hyphenating" "no hyphenation needed")) + + (define wrapped-lines (if gets-hyphenation? + (wrap-quads (split-quad (cast ((if world:allow-hyphenated-last-word-in-paragraph + hyphenate-quad + hyphenate-quad-except-last-word) (merge-adjacent-within b)) Quad))) + wrapped-lines-without-hyphens)) + + (when gets-hyphenation? (log-quad-debug* (log-debug-lines wrapped-lines))) + + + (log-quad-debug "final looseness = ~a" (average-looseness wrapped-lines)) + (map insert-spacers-in-line + (for/list : (Listof Quad) ([line-idx (in-naturals)][line (in-list wrapped-lines)]) + (quad-attr-set* line 'line-idx line-idx 'lines (length wrapped-lines))))) diff --git a/quad/main.rkt b/quad/main.rkt index f4968e67..ca4cfd57 100644 --- a/quad/main.rkt +++ b/quad/main.rkt @@ -37,6 +37,8 @@ (length lines) (quad->string line) (quad-attr-ref line world:line-looseness-key)))) + + (require racket/trace) (define (block->lines b) (define quality (quad-attr-ref/parameter b world:quality-key)) diff --git a/quad/world-typed.rkt b/quad/world-typed.rkt index 04493a92..31f53a50 100644 --- a/quad/world-typed.rkt +++ b/quad/world-typed.rkt @@ -14,7 +14,7 @@ (define name-key keyname) (define-parameter name-default val)))])) -(define-key-and-parameter measure 'measure 300) +(define-key-and-parameter measure 'measure 300.0) (define-key-and-parameter font-size 'size 13) diff --git a/quad/wrap-typed.rkt b/quad/wrap-typed.rkt index db505da4..d38476cd 100644 --- a/quad/wrap-typed.rkt +++ b/quad/wrap-typed.rkt @@ -222,6 +222,7 @@ ;; spacers are used to soak up extra space left over in a line. ;; depending on where the spacers are inserted, different formatting effects are achieved. ;; e.g., left / right / centered / justified. +(provide insert-spacers-in-line) (define/typed (insert-spacers-in-line line [alignment-override #f]) ((Quad) ((Option Symbol)) . ->* . Quad) ;; important principle: avoid peeking into quad-list to get attributes.