From c45ed05acef77be18676c6dfbb44e7adc93c97f3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 7 Mar 2015 09:35:00 -0800 Subject: [PATCH] hyphenate & merge-adjacent --- quad/main-typed-tests.rkt | 6 +++++- quad/main-typed.rkt | 9 ++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/quad/main-typed-tests.rkt b/quad/main-typed-tests.rkt index d29cf42a..6060865d 100644 --- a/quad/main-typed-tests.rkt +++ b/quad/main-typed-tests.rkt @@ -8,4 +8,8 @@ (check-equal? (input->nested-blocks (input #f (block #f "1" (column-break) "2"))) (list (list (list (list (quad 'word '#hash() '("1")))) (list (list (quad 'word '#hash() '("2"))))))) (check-equal? (list (list (list (list (quad 'word '#hash() '("1"))))) (list (list (list (quad 'word '#hash() '("2")))))) -(input->nested-blocks (input #f (block #f "1" (page-break) "2")))) \ No newline at end of file +(input->nested-blocks (input #f (block #f "1" (page-break) "2")))) + +(check-equal? (merge-adjacent-within (line #f (word #f "b") (word #f "a") (word #f "r"))) (line #f (word #f "bar"))) + +(check-equal? (hyphenate-quad-except-last-word (line #f "snowman" "snowman")) (line #f "snow\u00ADman" "snowman")) \ No newline at end of file diff --git a/quad/main-typed.rkt b/quad/main-typed.rkt index 623626f4..6c42a72c 100644 --- a/quad/main-typed.rkt +++ b/quad/main-typed.rkt @@ -26,13 +26,16 @@ [else (values multipages multicolumns blocks (cons q block-acc))]))) (reverse (cons-reverse (cons-reverse ((inst cons-reverse Quad Block-Type) b bs) mcs) mps))) - +(provide merge-adjacent-within) (define/typed (merge-adjacent-within q) (Quad . -> . Quad) (quad (quad-name q) (quad-attrs q) (join-quads (cast (quad-list q) (Listof Quad))))) +(provide hyphenate-quad-except-last-word) (define/typed (hyphenate-quad-except-last-word q) (Quad . -> . Quad) (log-quad-debug "last word will not be hyphenated") - (define-values (first-quads last-quad) (split-last (quad-list q))) - (quad (quad-name q) (quad-attrs q) (snoc (map hyphenate-quad first-quads) last-quad))) + (define-values (first-quads last-quad) ((inst split-last QuadListItem) (quad-list q))) + (quad (quad-name q) (quad-attrs q) (snoc ((inst map QuadListItem QuadListItem) hyphenate-quad first-quads) last-quad))) + +