From e28ce401cb5190952403c8e34aaa9574613d7867 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 25 Jan 2020 19:24:22 -0800 Subject: [PATCH] dels --- quad/quadwriter/core.rkt | 6 +++++ quad/quadwriter/layout.rkt | 52 ++++++++++++++++---------------------- quad/quadwriter/render.rkt | 42 ++++++++++-------------------- 3 files changed, 42 insertions(+), 58 deletions(-) diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index 6cd90438..93d77d42 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -15,3 +15,9 @@ q:hr-break (all-from-out "param.rkt")) +(define para-break '(q ((break "para")))) +(define line-break '(q ((break "line")))) +(define page-break '(q ((break "page")))) +(define column-break '(q ((break "column")))) +(define hr-break '(q ((break "hr")))) +(define section-break '(q ((break "section")))) diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 7217fbaf..a95b971d 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -120,32 +120,19 @@ [else 0])) (list string-size (quad-ref q :line-height default-line-height)))) -(define-syntax (define-break-types stx) - (syntax-case stx () - [(_ ALL-BREAKS-ID . TYPES) - (with-syntax ([((TYPE-BREAK TYPE-STR Q:TYPE-BREAK BREAK-TYPE) ...) - (for/list ([type (in-list (syntax->list #'TYPES))]) - (list - (format-id #'TYPES "~a-break" type) - (symbol->string (syntax->datum type)) - (format-id #'TYPES "q:~a-break" type) - (format-id #'TYPES "~a-break-quad" type)))]) - #'(begin - (define TYPE-BREAK '(q ((break TYPE-STR)))) ... - (define ALL-BREAKS-ID (list (cons TYPE-STR BREAK-TYPE) ...))))])) - -(define-break-types all-breaks para line page column hr section) - (define (convert-break-quad q) - ;; replaces Q-expressions representing breaks - ;; with special typed quads representing breaks. - ;; Because typed quads have their own predicates, - ;; it's faster to find them in wrapping operations - ;; (instead of, say, using `equal?`) - (match (assoc (quad-ref q :break) all-breaks) - [#false q] - [(cons _ break-quad-type) (make-quad #:type break-quad-type - #:attrs (quad-attrs q))])) + (define break-quad-type (match (quad-ref q :break) + ["para" para-break-quad] + ["line" line-break-quad] + ["page" page-break-quad] + ["column" column-break-quad] + ["hr" hr-break-quad] + ["section" section-break-quad] + [_ #false])) + (if break-quad-type + (make-quad #:type break-quad-type + #:attrs (quad-attrs q)) + q)) (module+ test (check-equal? (quad-ref (convert-break-quad (qexpr->quad '(q ((break "page") (foo "bar"))))) 'foo) "bar")) @@ -212,11 +199,16 @@ [size #:parent quad (make-size-promise q cased-str)])) (define (generic->typed-quad q) - (cond - [(quad-ref q :break) (convert-break-quad q)] - [(quad-ref q :draw) (convert-draw-quad q)] - [(quad-ref q :image-file) (convert-image-quad q)] - [else (convert-string-quad q)])) + ;; replaces quads representing certain things + ;; with special typed quads representing those things. + ;; Because typed quads have their own predicates, + ;; it's faster to find them in wrapping operations + (define converter (cond + [(quad-ref q :break) convert-break-quad] + [(quad-ref q :draw) convert-draw-quad] + [(quad-ref q :image-file) convert-image-quad] + [else convert-string-quad])) + (converter q)) (define (draw-debug q doc [fill-color "#f99"] [stroke-color "#fcc"] [stroke-width 0.5]) (when (draw-debug?) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 7425e8ec..f21eb3ea 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -35,33 +35,19 @@ [path path])))))) -(define (replace-breaks x) - ;; replaces Q-expressions representing breaks - ;; with special typed quads representing breaks. - ;; Because typed quads have their own predicates, - ;; it's faster to find them in wrapping operations - ;; (instead of, say, using `equal?`) - (map-elements (λ (el) - (cond - [(assoc el all-breaks) => cdr] - [else el])) x)) - - -(define (handle-hyphenate qs) +(define (handle-hyphenate q) ;; find quads that want hyphenation and split them into smaller pieces ;; do this before ->string-quad so that it can handle the sizing promises - (apply append - (for/list ([q (in-list qs)]) - (cond - [(and (quad-ref q :hyphenate) (pair? (quad-elems q)) (andmap string? (quad-elems q))) - (for*/list ([str (in-list (quad-elems q))] - [hyphen-char (in-value #\u00AD)] - [hstr (in-value (hyphenate str hyphen-char - #:min-left-length 3 - #:min-right-length 3))] - [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) - (quad-copy q [elems (list substr)]))] - [else (list q)])))) + (cond + [(and (quad-ref q :hyphenate) (pair? (quad-elems q)) (andmap string? (quad-elems q))) + (for*/list ([str (in-list (quad-elems q))] + [hyphen-char (in-value #\u00AD)] + [hstr (in-value (hyphenate str hyphen-char + #:min-left-length 3 + #:min-right-length 3))] + [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) + (quad-copy q [elems (list substr)]))] + [else (list q)])) (define (string->feature-list str) @@ -143,20 +129,20 @@ ;; apply some default styling attributes. ;; These will only be used if the underlying q-expression hasn't specified its own values, ;; which will naturally override these. - (define the-quad + (define q (qexpr->quad (list 'q (list->attrs :font-family default-font-family :font-size (number->string default-font-size) :line-height (number->string (floor (* default-line-height-multiplier default-font-size)))) qexpr))) (setup-font-path-table! base-dir) - (let* ([qs (atomize the-quad + (let* ([qs (atomize q #:attrs-proc handle-cascading-attrs #:missing-glyph-action 'fallback #:fallback "fallback" #:emoji "fallback-emoji" #:math "fallback-math" #:font-path-resolver resolve-font-path!)] - [qs (time-log hyphenate (handle-hyphenate qs))] + [qs (time-log hyphenate (apply append (map handle-hyphenate qs)))] [qs (map generic->typed-quad qs)] [qs (drop-leading-breaks qs)] [qs (insert-first-line-indents qs)])