dels

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"))))

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?)

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)])