diff --git a/quad/quad/typewriter.rkt b/quad/quad/typewriter.rkt index 49d90e19..181f9e86 100644 --- a/quad/quad/typewriter.rkt +++ b/quad/quad/typewriter.rkt @@ -1,13 +1,16 @@ #lang debug br/quicklang (require racket/promise racket/list sugar/list sugar/debug "quad.rkt" "atomize.rkt" "break.rkt" "qexpr.rkt" "generic.rkt" "position.rkt") -(require pitfall/document) +(require pitfall/document fontland/font) (require hyphenate racket/runtime-path pollen/unstable/typography pollen/tag) (provide (rename-out [mb #%module-begin]) (except-out (all-from-out br/quicklang) #%module-begin)) (define-runtime-path charter "charter.ttf") -(define soft-break? (λ (q) (and (quad? q) (memv (car (elems q)) '(#\space #\- #\u00AD))))) +(define (soft-break? q) + (and (quad? q) + (or (memv (car (elems q)) '(#\space #\- #\u00AD)) + (member (car (elems q)) (map string '(#\space #\- #\u00AD)))))) (struct $shim $quad () #:transparent) (struct $char $quad () #:transparent) (define current-doc (make-parameter #f)) @@ -40,9 +43,9 @@ (send (current-doc) widthOfString str) (send (current-doc) currentLineHeight))) 'printable? (case (car (elems q)) - [(#\u00AD) (λ (sig) (memq sig '(end)))] - [(#\space) (λ (sig) (not (memq sig '(start end))))] - [else #t]) + [(" " #\u00AD) (λ (sig) (memq sig '(end)))] + [(" " #\space) (λ (sig) (not (memq sig '(start end))))] + [else #true]) 'draw (λ (q doc) (set! draw-counter (add1 draw-counter )) #;(draw-debug q doc) @@ -77,7 +80,7 @@ (define-values (run-pcs rest) (splitf-at pcs (λ (p) (run-attrs-match (car pcs) p)))) (define new-run ($char (hash-set (attrs (car pcs)) 'size (list (pt-x (apply map + (map size run-pcs))) - (pt-y (size (car pcs))))) + (pt-y (size (car pcs))))) (merge-adjacent-strings (append-map elems run-pcs)))) (values (cons new-run runs) rest))) @@ -123,6 +126,7 @@ #:finish-wrap-proc (λ (pcs) (list ($page (hasheq 'offset '(36 36)) (filter-not $break? pcs)))))) (define (typeset qarg) + (current-layout-caching #true) ; from fontland/font (define chars 65) (define line-width (* 7.2 chars)) (define lines-per-page (* 40 line-height)) @@ -156,12 +160,12 @@ (define-macro (mb . ARGS) (with-syntax ([PS (syntax-property #'ARGS 'ps)] - [(REP . QS) #'ARGS]) - #'(#%module-begin - (define qs (list . QS)) - (define lotsa-qs (append* (make-list (string->number (string-trim REP)) qs))) - (run (qexpr->quad (apply quad #:fontsize "12" lotsa-qs)) PS) - (void)))) + [(REP . QS) #'ARGS]) + #'(#%module-begin + (define qs (list . QS)) + (define lotsa-qs (append* (make-list (string->number (string-trim REP)) qs))) + (run (qexpr->quad (apply quad #:fontsize "12" lotsa-qs)) PS) + (void)))) (module reader syntax/module-reader quad/typewriter