diff --git a/quad/quads-typed.rkt b/quad/quads-typed.rkt index 7a0f6ad1..8a298d36 100644 --- a/quad/quads-typed.rkt +++ b/quad/quads-typed.rkt @@ -130,9 +130,9 @@ (: id (case-> (-> Quad) - ((Option (Listof Any)) (U String Quad) * . -> . Quad))) + ((Option (U QuadAttrs (Listof Any))) (U String Quad) * . -> . Quad))) (define (id [attrs #f] . xs) - (quad 'id (quadattrs (if (list? attrs) attrs '())) (cast xs QuadList))) + (quad 'id (if (quad-attrs? attrs) (cast attrs QuadAttrs) (quadattrs (if (list? attrs) attrs '()))) (cast xs QuadList))) (: id? (Any . -> . Boolean)) (define (id? x) @@ -190,6 +190,9 @@ (define-break-type word) +(: word-string (Quad . -> . String)) +(define (word-string c) + (cast ((inst car QuadListItem Any) (quad-list c)) String)) (define-break-type page) (define-break-type column) (define-break-type block) diff --git a/quad/world-typed.rkt b/quad/world-typed.rkt index bde8c810..31925ef4 100644 --- a/quad/world-typed.rkt +++ b/quad/world-typed.rkt @@ -73,7 +73,7 @@ -(define-parameter default-word-break-list '(nb "" bb "-")) +(define-parameter default-word-break-list '(nb "" bb "-")) (define-parameter optical-overhang 0.8) diff --git a/quad/wrap-typed.rkt b/quad/wrap-typed.rkt new file mode 100644 index 00000000..f8c94052 --- /dev/null +++ b/quad/wrap-typed.rkt @@ -0,0 +1,74 @@ +#lang typed/racket/base +(require (for-syntax racket/base racket/syntax)) +(require sugar/list sugar/debug racket/list racket/function math/flonum racket/vector math/statistics) +(require "ocm-typed.rkt" "quads-typed.rkt" "utils-typed.rkt" "measure-typed.rkt" "world-typed.rkt" "logger-typed.rkt") + + +(define-syntax (define/typed stx) + (syntax-case stx () + [(_ (proc-name arg ... . rest-arg) type-expr body ...) + #'(define/typed proc-name type-expr + (λ(arg ... . rest-arg) body ...))] + [(_ proc-name type-expr body ...) + #'(begin + (: proc-name type-expr) + (define proc-name body ...))])) + +;; predicate for the soft hyphen +(define/typed (soft-hyphen? x) + (String . -> . Boolean) + (equal? (format "~a" world:soft-hyphen) x)) + +;; visible characters that also mark possible breakpoints +(define/typed (visible-breakable? x) + (String . -> . Boolean) + (and (member x world:hyphens-and-dashes) #t)) + +;; invisible characters that denote possible breakpoints +(define/typed (invisible-breakable? x) + (String . -> . Boolean) + (and (member x (cons world:empty-string world:spaces)) #t)) + +;; union of visible & invisible +(define/typed (breakable? x) + (Any . -> . Boolean) + (cond + [(string? x) (or (visible-breakable? x) (invisible-breakable? x))] + [(word? x) (breakable? (word-string (cast x Quad)))] + [else #f])) + +;; used by insert-spacers to determine which characters +;; can be surrounded by stretchy spacers +(define/typed (takes-justification-space? x) + (Any . -> . Boolean) + (whitespace/nbsp? x)) + +;; test if a quad can be a word break: +;; either it's an explicit word break, +;; or it's breakable (and can be converted to a word break) +(define/typed (possible-word-break-quad? q) + (Quad . -> . Boolean) + (or (word-break? q) (breakable? q))) + + +;; convert a possible word break into an actual one +(define/typed (convert-to-word-break q) + (Quad . -> . Quad) + (when (not (possible-word-break-quad? q)) + (error 'convert-to-word-break "input is not a possible word break:" q)) + (define result (cond + [(word-break? q) q] + [(word? q) + (define str (word-string q)) ; str will be one character long, because we've exploded our input + (apply word-break + (merge-attrs q ; take q's attributes for formatting purposes + (cond + ;; a space is ordinarily visible, but disappears at the end of a line + [(equal? str " ") (list world:no-break-key " " world:before-break-key "")] + ;; soft hyphen is ordinarily invisible, but appears at the end of a line + [(soft-hyphen? str) (list world:no-break-key "" world:before-break-key "-")] + ;; a visible breakable character is always visible + [(visible-breakable? str) (list world:no-break-key str world:before-break-key str)] + [else (cast (world:default-word-break-list) HashableList)])) (quad-list q))] + [else #f])) + (or result (error 'convert-to-word-break "result was a not word break for input:" q))) \ No newline at end of file