diff --git a/quad2/attr.rkt b/quad2/attr.rkt index 387dacc1..a67106de 100644 --- a/quad2/attr.rkt +++ b/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))) diff --git a/quad2/constants.rkt b/quad2/constants.rkt index 1151bd2c..6b9fd8c1 100644 --- a/quad2/constants.rkt +++ b/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)]) \ No newline at end of file + [:font-size (attr-dimension-string-key 'font-size)] + [:font-size-previous (attr-dimension-string-key 'font-size-previous)]) \ No newline at end of file diff --git a/quad2/dimension.rkt b/quad2/dimension.rkt index 56685fe7..1568dbd4 100644 --- a/quad2/dimension.rkt +++ b/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])) \ No newline at end of file + [_ parsed-thing])) + +(define q (bootstrap-input '(div ((font-size "100")) (span ((font-size "1.5em")))))) \ No newline at end of file diff --git a/quad2/draw.rkt b/quad2/draw.rkt index 05039e17..8d1327d9 100644 --- a/quad2/draw.rkt +++ b/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")) \ No newline at end of file + (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")) \ No newline at end of file diff --git a/quad2/font.rkt b/quad2/font.rkt index 0256f3b4..20e7be26 100644 --- a/quad2/font.rkt +++ b/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")))) \ No newline at end of file + (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))) diff --git a/quad2/main.rkt b/quad2/main.rkt index a6f9524d..d9457143 100644 --- a/quad2/main.rkt +++ b/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)) diff --git a/quad2/quad.rkt b/quad2/quad.rkt index f9e0605e..80ffabb0 100644 --- a/quad2/quad.rkt +++ b/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")))) \ No newline at end of file