process the attrs
parent
f8a0a90f36
commit
94fb4057c9
@ -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))
|
||||
@ -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]))
|
||||
Loading…
Reference in New Issue