work on font size cascading

quad2/attr.rkt

@@ -114,7 +114,7 @@
   ;; we parse them into the equivalent measurement in points.
   (do-attr-iteration qs
                      #:which-attr attr-dimension-string-key?
-                     #:attr-proc (λ (ak av attrs) (parse-dimension av attrs))))
+                     #:attr-proc (λ (ak av attrs) (parse-dimension av))))
 
 (module+ test
   (require rackunit)
@@ -142,7 +142,7 @@
                        (upgrade-attr-keys (list (make-q))))))
     (check-equal? (quad-ref (car (downcase-attr-values qs)) :foo) "bar")
     (check-true (complete-path? (quad-ref (car (complete-attr-paths qs)) :ps)))
-    (check-equal? (quad-ref (car (parse-dimension-strings qs)) :dim) 144)
+    (check-true (procedure? (quad-ref (car (parse-dimension-strings qs)) :dim)))
     (let ([q (car (convert-boolean-attr-values qs))])
       (check-true (quad-ref q :boolt))
       (check-false (quad-ref q :boolf)))

quad2/constants.rkt

@@ -14,4 +14,5 @@
   [:font-path (attr-path-key 'font-path)]
   [:font-bold (attr-boolean-key 'font-bold)]
   [:font-italic (attr-boolean-key 'font-italic)]
-  [:font-size (attr-dimension-string-key 'font-size)])
+  [:font-size (attr-dimension-string-key 'font-size)]
+  [:font-size-previous (attr-dimension-string-key 'font-size-previous)])

quad2/dimension.rkt

@@ -1,5 +1,7 @@
 #lang debug racket/base
 (require racket/match
+         racket/string
+         "quad.rkt"
          "constants.rkt")
 (provide (all-defined-out))
 
@@ -10,7 +12,7 @@
 (define (in->pts x) (* 72 x))
 (define (mm->cm x) (/ x 10.0))
 
-(define (parse-dimension x [em-resolution-attrs #false])
+(define (parse-dimension x)
   (define pica-pat (regexp "^(p|pica)(s)?$"))
   (define (unit->converter-proc unit)
     (match unit
@@ -19,22 +21,31 @@
       [(regexp #rx"^inch(es)?|in(s)?$") in->pts] ; inches
       [(regexp #rx"^cm(s)?$") (compose1 in->pts cm->in)] ; cm
       [(regexp #rx"^mm(s)?$") (compose1 in->pts cm->in mm->cm)] ; mm
-      [(regexp #rx"^em(s)?$")
-       #:when em-resolution-attrs
-       ;; if we don't have attrs for resolving the em string, we ignore it
-       (λ (num) (* (hash-ref em-resolution-attrs :font-size) num))]
-      [_ #false]))
+      [_ values]))
+  (define (parse-em pstr)
+    (define em-suffix "em")
+    (and
+     pstr
+     (string? pstr)
+     (string-suffix? pstr em-suffix)
+     (string->number (string-trim pstr em-suffix))))
   (define parsed-thing
     (match x
       [#false #false]
       [(? number? num) num]
+      [(app parse-em em) #:when em
+                         (procedure-rename
+                          (λ (previous-size)
+                            (unless (number? previous-size)
+                              (raise-argument-error 'em-resolver "number" previous-size))
+                            (* em previous-size))
+                          'em-resolver)]
       [(? string? str)
        (match (regexp-match #px"^(-?[0-9\\.]+)\\s*([a-z]+)([0-9\\.]+)?$" (string-downcase str))
          [(list str
                 (app string->number num)
                 (app unit->converter-proc converter-proc)
                 #false) ; prefix measurement (suffix is #false)
-          #:when (and converter-proc num)
           (converter-proc num)]
          [(list str
                 (app string->number prefix-num)
@@ -45,4 +56,6 @@
          [_ str])]))
   (match parsed-thing
     [(and (? integer?) (? inexact?)) (inexact->exact parsed-thing)]
-    [_ parsed-thing]))
+    [_ parsed-thing]))
+
+(define q (bootstrap-input '(div ((font-size "100")) (span ((font-size "1.5em"))))))

quad2/draw.rkt

@@ -15,10 +15,12 @@
   (flatten
    (list ($doc 'start) ($page 'start)
          (for/list ([q (in-list qs)])
-                   (cond
-                     [(quad? q)
-                      (list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q)))))))]
-                     [else (error 'render-unknown-thing)]))
+           (cond
+             [(quad? q)
+              (if (pair? (quad-elems q))
+                  (list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q)))))))
+                  (list))]
+             [else (error 'render-unknown-thing)]))
          ($page 'end) ($doc 'end))))
 
 (define valid-tokens '(doc-start doc-end page-start page-end text move))
@@ -27,15 +29,15 @@
   #:pre (list-of $drawing-inst?)
   #:post string?
   (define move-points (map $move-posn (filter $move? xs)))
-  (define xmax (add1 (apply max (map $point-x move-points))))
-  (define ymax (add1 (apply max (map $point-y move-points))))
+  (define xmax (if (pair? move-points) (add1 (apply max (map $point-x move-points))) 0))
+  (define ymax (if (pair? move-points) (add1 (apply max (map $point-y move-points))) 0))
   (string-join
    (for/list ([x (in-list xs)])
-             (string-join (map ~a (match x
-                                    [($move ($point x y)) (list y x 'move)]
-                                    [($text charint) (list charint 'text)]
-                                    [($doc 'start) '(doc-start)]
-                                    [($doc 'end) '(doc-end)]
-                                    [($page 'start) (list ymax xmax 'page-start)]
-                                    [($page 'end) '(page-end)]
-                                    [_ (error 'unknown-drawing-inst)])) " ")) "\n"))
+     (string-join (map ~a (match x
+                            [($move ($point x y)) (list y x 'move)]
+                            [($text charint) (list charint 'text)]
+                            [($doc 'start) '(doc-start)]
+                            [($doc 'end) '(doc-end)]
+                            [($page 'start) (list ymax xmax 'page-start)]
+                            [($page 'end) '(page-end)]
+                            [_ (error 'unknown-drawing-inst)])) " ")) "\n"))

quad2/font.rkt

@@ -10,6 +10,7 @@
          "pipeline.rkt"
          "param.rkt"
          "struct.rkt"
+         "dimension.rkt"
          "attr.rkt")
 (provide (all-defined-out))
 
@@ -18,6 +19,7 @@
 (define top-font-directory "fonts")
 (define font-file-extensions '(#".otf" #".ttf" #".woff" #".woff2"))
 (define default-font-family "text")
+(define default-font-size 12)
 
 (define (fonts-in-directory dir)
   (for/list ([font-path (in-directory dir)]
@@ -152,4 +154,43 @@
     (check-equal? (resolved-font-for-family "Heading") (string->path "fira-sans-light.otf"))
     (check-equal? (resolved-font-for-family "CODE") (string->path "fira-mono.otf"))
     (check-equal? (resolved-font-for-family "blockquote" #:bold #t) (string->path "fira-sans-bold.otf"))
-    (check-equal? (resolved-font-for-family "nonexistent-fam") (string->path "SourceSerifPro-Regular.otf"))))
+    (check-equal? (resolved-font-for-family "nonexistent-fam") (string->path "SourceSerifPro-Regular.otf"))))
+
+(define (parse-em pstr)
+  (define em-suffix "em")
+  (and
+   pstr
+   (string? pstr)
+   (string-suffix? pstr em-suffix)
+   (string->number (string-trim pstr em-suffix))))
+
+(define-pass (resolve-font-sizes qs)
+  ;; convert font-size attributes into a simple font size
+  ;; we stashed the previous size in private key 'font-size-previous
+  #:pre (list-of quad?)
+  #:post (list-of quad?)
+  
+  (define (resolve-font-size-once attrs)
+    ;; FIXME: this technique no longer works because
+    ;; it depends on resolving values while attrs are being cascaded
+    (define base-size-adjusted
+      (match (hash-ref attrs :font-size default-font-size)
+        ;; if our value represents an adjustment,
+        ;; we apply the adjustment to the previous value
+        [(? procedure? proc) (proc (hash-ref attrs :font-size-previous default-font-size))]
+        ;; otherwise we use our value directly
+        [val val]))
+    ;; we write our new value into both font-size and font-size-previous
+    ;; because as we cascade down, we're likely to come across superseding values
+    ;; of font-size (but font-size-previous will persist)
+    (hash-set! attrs :font-size base-size-adjusted)
+    (hash-set! attrs :font-size-previous base-size-adjusted))
+  
+  (define font-paths (setup-font-path-table))
+  (do-attr-iteration qs
+                     #:attr-proc (λ (ak av attrs) (resolve-font-size-once attrs))))
+
+
+(module+ test
+  (define qs (bootstrap-input (make-quad #:tag 'div #:attrs (make-hasheq (list (cons :font-size "100pt"))) #:elems (list (make-quad #:tag 'span #:attrs (make-hasheq (list (cons :font-size-previous "100pt") (cons :font-size "1.5em"))))))))
+  (resolve-font-sizes (parse-dimension-strings qs)))

quad2/main.rkt

@@ -1,40 +1,17 @@
 #lang debug racket/base
 (require "layout.rkt"
-         "render.rkt"
          "quad.rkt"
          "pipeline.rkt"
          "linearize.rkt"
          "layout.rkt"
          "draw.rkt"
-         "struct.rkt"
          "attr.rkt"
          "font.rkt"
          "constants.rkt"
          "param.rkt"
-         racket/string
-         txexpr
          racket/list
          racket/match)
 
-(define (txexpr->quad x)
-  (match x
-    [(txexpr tag attrs elems)
-     (make-quad #:tag tag
-                #:attrs (attrs->hash attrs)
-                #:elems (map txexpr->quad elems))]
-    [_ x]))
-
-(define-pass (bootstrap-input x)
-  ;; turn a simple string into a quad for testing layout.
-  #:pre values
-  #:post (list-of quad?)
-  (let loop ([x x])
-    (match x
-      [(? quad? q) (list q)]
-      [(and (list (? quad?) ...) qs) (loop (make-quad #:elems qs))]
-      [(? txexpr? tx) (loop (txexpr->quad tx))]
-      [(? string? str) (loop (make-quad #:elems (list str)))])))
-
 (define-pass (split-into-single-char-quads qs)
   ;; break list of quads into single characters (keystrokes)
   #:pre (list-of simple-quad?)
@@ -59,10 +36,6 @@
                   downcase-attr-values
                   convert-boolean-attr-values
                   convert-numeric-attr-values
-                  ;; TODO: resolve font sizes
-                  resolve-font-sizes
-                  ;; we resolve dimension strings after font size
-                  ;; because they can be denoted relative to em size
                   parse-dimension-strings
 
                   ;; linearization =============
@@ -74,10 +47,11 @@
                   linearize
 
                   ;; resolutions & parsings =============
+                  ;; TODO: finish resolve-font-sizes
+                  #;resolve-font-sizes
                   resolve-font-paths
                   complete-attr-paths
                   ;; TODO: parse feature strings
-
                     
                   mark-text-runs
                   merge-adjacent-strings
@@ -88,16 +62,22 @@
                   make-drawing-insts
                   stackify)))
 
-(define insts (parameterize ([current-wrap-width 13]
-                             [current-attrs all-attrs]
-                             [current-strict-attrs? #t]
-                             [current-show-timing? #f]
-                             [current-use-preconditions? #t]
-                             [current-use-postconditions? #t])
-                (quad-compile (bootstrap-input "Hello this is the earth"))))
+(module+ test
+  (require "render.rkt")
+  (define (test-compile x)
+    (parameterize ([current-wrap-width 13]
+                               [current-attrs all-attrs]
+                               [current-strict-attrs? #t]
+                               [current-show-timing? #f]
+                               [current-use-preconditions? #t]
+                               [current-use-postconditions? #t])
+                  (quad-compile (bootstrap-input x))))
+
+  (match (test-compile "Hello this is the earth")
+    [(? string? insts)
+    (render insts #:using text-renderer)
+    (render insts #:using drr-renderer)
+    #;(render-to-html drawing-insts)
+    #;(render-to-pdf drawing-insts)
+    ]))
 
-(when (string? insts)
-  (render insts #:using text-renderer)
-  (render insts #:using drr-renderer)
-  #;(render-to-html drawing-insts)
-  #;(render-to-pdf drawing-insts))

quad2/quad.rkt

@@ -2,7 +2,9 @@
 (require racket/contract
          racket/match
          racket/hash
-         (for-syntax racket/base racket/syntax))
+         txexpr
+         (for-syntax racket/base racket/syntax)
+         "struct.rkt")
 (provide (all-defined-out))
 
 (struct $point (x y) #:transparent #:mutable)
@@ -46,6 +48,8 @@
     (quad-constructor tag attrs elems #false)))
 
 (define (quad-ref q key [default-val #false])
+  (unless (attr-key? key)
+    (raise-argument-error 'quad-ref "attr-key?" key))
   (hash-ref (quad-attrs q) key default-val))
 (define (quad-set! q key val)
   (hash-set! (quad-attrs q) key val))
@@ -64,5 +68,22 @@
 (define (has-no-position? q) (not (has-position? q)))
 (define (has-position? q) (quad-posn q))
 
+(define (txexpr->quad x)
+  (match x
+    [(txexpr tag attrs elems)
+     (make-quad #:tag tag
+                #:attrs (attrs->hash attrs)
+                #:elems (map txexpr->quad elems))]
+    [_ x]))
+
+(define (bootstrap-input x)
+  ;; turn a simple string into a quad for testing layout.
+  (let loop ([x x])
+    (match x
+      [(? quad? q) (list q)]
+      [(and (list (? quad?) ...) qs) (loop (make-quad #:elems qs))]
+      [(? txexpr? tx) (loop (txexpr->quad tx))]
+      [(? string? str) (loop (make-quad #:elems (list str)))])))
+
 (module+ test
   (define q (make-quad #:tag 'div #:attrs (make-hasheq '((hello . "world"))) #:elems (list "fine"))))