diff --git a/quad2/attr.rkt b/quad2/attr.rkt new file mode 100644 index 00000000..14ab1c4e --- /dev/null +++ b/quad2/attr.rkt @@ -0,0 +1,71 @@ +#lang debug racket/base +(require racket/match + racket/hash + racket/list + racket/string + "dimension.rkt" + "pipeline.rkt" + "quad.rkt") +(provide (all-defined-out)) + +(define (do-attr-iteration qs #:which-key predicate #:value-proc proc) + (define attrs-seen (make-hasheq)) + (for ([q (in-list qs)]) + (define attrs (quad-attrs q)) + (hash-ref! attrs-seen attrs + (λ () + (for ([k (in-hash-keys attrs)] + #:when (predicate k)) + (hash-update! attrs k (λ (val) (proc val attrs)))) + #t))) + qs) + +;; TODO: make real `has-case-sensitive-value?` +(define (has-case-sensitive-value? x) #false) + +(define-pass (downcase-attr-values qs) + ;; make attribute values lowercase, unless they're case-sensitive + ;; so we can check them more easily later. + ;; in principle we could do this earlier and recursively process a single quad + ;; rather than linearized quads + ;; it would be faster because there are fewer copies of the attr hashes, + ;; so we do fewer tests + ;; but let's stay with the pipeline policy of operating on flat lists of quads + #:pre (list-of quad?) + #:post (list-of quad?) + (do-attr-iteration qs + #:which-key (λ (k) (not (has-case-sensitive-value? k))) + #:value-proc (λ (val attrs) (string-downcase val)))) + +;; TODO: make real `takes-path?` +(define (takes-path? x) (memq x '(ps))) + +(define-pass (complete-attr-paths qs) + #:pre (list-of quad?) + #:post (list-of quad?) + ;; convert every pathlike thing to a complete path (well, path string, because it's inside an attr) + ;; so we don't get tripped up later by relative paths + ;; relies on `current-directory` being parameterized to source file's dir + (do-attr-iteration qs + #:which-key takes-path? + #:value-proc (λ (val attrs) (path->string (path->complete-path val))))) + +;; TODO: make real `takes-dimension-string?` +(define (takes-dimension-string? x) (memq x '(dim))) + +(define-pass (parse-dimension-strings qs) + #:pre (list-of quad?) + #:post (list-of quad?) + ;; certain attributes can be "dimension strings", which are strings like "3in" or "4.2cm" + ;; we parse them into the equivalent measurement in points. + (do-attr-iteration qs + #:which-key takes-dimension-string? + #:value-proc (λ (val attrs) (parse-dimension val attrs)))) + +(module+ test + (require rackunit) + (define q (make-quad #:attrs (make-hasheq '((foo . "BAR")(ps . "file.txt")(dim . "2in"))))) + (define qs (list q)) + (check-equal? (quad-ref (car (downcase-attr-values qs)) 'foo) "bar") + (check-true (complete-path? (string->path (quad-ref (car (complete-attr-paths qs)) 'ps)))) + (check-equal? (quad-ref (car (parse-dimension-strings qs)) 'dim) 144)) \ No newline at end of file diff --git a/quad2/dimension.rkt b/quad2/dimension.rkt new file mode 100644 index 00000000..b6bfab0b --- /dev/null +++ b/quad2/dimension.rkt @@ -0,0 +1,50 @@ +#lang debug racket/base +(require racket/match) +(provide (all-defined-out)) + +;; TODO: define :font-size properly +(define :font-size 'font-size) + +(define (pica->pts prefix [suffix #false]) + ;; both pieces of measurement are either positive or negative + ((if (negative? prefix) - +) (+ (* (abs prefix) 12) (or suffix 0)))) +(define (cm->in x) (/ x 2.54)) +(define (in->pts x) (* 72 x)) +(define (mm->cm x) (/ x 10.0)) + +(define (parse-dimension x [em-resolution-attrs #false]) + (define pica-pat (regexp "^(p|pica)(s)?$")) + (define (unit->converter-proc unit) + (match unit + [(regexp #rx"^(pt|point)(s)?$") values] ; points + [(regexp pica-pat) pica->pts] ; pica (no pts) + [(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])) + (define parsed-thing + (match x + [#false #false] + [(? number? num) num] + [(? 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) + (and (regexp pica-pat) unit) + (app string->number suffix-num)) + #:when (and prefix-num suffix-num) ; prefix + suffix measurement (only pica + point) + (pica->pts prefix-num suffix-num)] + [_ str])])) + (match parsed-thing + [(and (? integer?) (? inexact?)) (inexact->exact parsed-thing)] + [_ parsed-thing])) \ No newline at end of file diff --git a/quad2/linearize.rkt b/quad2/linearize.rkt index 9096752a..32c38979 100644 --- a/quad2/linearize.rkt +++ b/quad2/linearize.rkt @@ -9,7 +9,7 @@ (define (simple-quad? x) (and (quad? x) (<= (length (quad-elems x)) 1))) -(define-pass (linearize q) +(define-pass (linearize-quad q) ;; convert a single quad into a list of quads, with the attributes propagated downward ;; every resulting quad should have at most one element #:pre quad? @@ -27,7 +27,7 @@ (module+ test (define q (make-quad #:attrs (hasheq 'foo 42) #:elems (list (make-quad #:elems (list "Hi" " idiot" (make-quad #:attrs (hasheq 'bar 84) #:elems '("There")) " Eve" "ry" "one" (make-quad #:attrs (hasheq 'zam 108) #:elems null)))))) - (define lqs (linearize q)) + (define lqs (linearize-quad q)) lqs) diff --git a/quad2/main.rkt b/quad2/main.rkt index 95080f55..674a9670 100644 --- a/quad2/main.rkt +++ b/quad2/main.rkt @@ -7,6 +7,7 @@ "layout.rkt" "draw.rkt" "struct.rkt" + "attr.rkt" racket/string racket/match) @@ -19,7 +20,7 @@ [(and (list (? quad?) ...) qs) (make-quad #:elems qs)] [other (make-quad #:elems (list other))])) -(define-pass (single-char-quads qs) +(define-pass (split-into-single-char-quads qs) ;; break list of quads into single characters (keystrokes) #:pre (list-of simple-quad?) #:post (list-of simple-quad?) @@ -33,17 +34,36 @@ (define quad-compile (make-pipeline (list bootstrap-input - linearize + ;; TODO: resolve font paths + ;; TODO: missing glyphs + linearize-quad + ;; TODO: maybe we shouldn't downcase values? + ;; we have to track attrs that are case sensitive + ;; instead we could use case-insensitive matching where suitable + ;; but will it always be apparent whether it's suitable? + ;; or will we have to still track which attrs are case-sensitive? + downcase-attr-values + ;; upgrade relative paths to complete for ease of handling later + ;; TODO: we have to track which attrs take a path + ;; (to distinguish them from attrs that might have path-like values + ;; that should be left alone) + complete-attr-paths + ;; TODO: resolve font paths + ;; TODO: resolve font sizes + ;; we resolve dimension strings after font size + ;; because they can be denoted relative to em size + parse-dimension-strings + ;; TODO: parse feature strings mark-text-runs merge-adjacent-strings split-whitespace - single-char-quads + split-into-single-char-quads layout make-drawing-insts stackify))) (define insts (parameterize ([current-wrap-width 13]) - (quad-compile "Hello this is the earth"))) + (quad-compile "Hello this is the earth"))) (displayln insts)