You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
305 lines
11 KiB
Racket
305 lines
11 KiB
Racket
#lang debug racket/base
|
|
(require (for-syntax racket/base racket/syntax syntax/strip-context)
|
|
racket/match
|
|
racket/sequence
|
|
racket/string)
|
|
(provide (all-defined-out))
|
|
|
|
(define (list->attrs . kvs)
|
|
(for/list ([kv (in-slice 2 kvs)])
|
|
kv))
|
|
|
|
(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]))
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
(check-equal? (parse-dimension "Foobar") "Foobar")
|
|
(check-equal? (parse-dimension "72plink") "72plink")
|
|
(check-equal? (parse-dimension "7..2pt") "7..2pt")
|
|
(check-equal? (parse-dimension "72pt") 72)
|
|
(check-equal? (parse-dimension "72.5pts") 72.5)
|
|
(check-equal? (parse-dimension "-72point") -72)
|
|
(check-equal? (parse-dimension "-72.5points") -72.5)
|
|
(check-equal? (parse-dimension "72.5points3") "72.5points3")
|
|
(check-equal? (parse-dimension "2in") 144)
|
|
(check-equal? (parse-dimension "-2ins") -144)
|
|
(check-equal? (parse-dimension "2.5inch") 180)
|
|
(check-equal? (parse-dimension "-2.5inches") -180)
|
|
(check-equal? (parse-dimension "2.54cm") (parse-dimension "1in"))
|
|
(check-equal? (parse-dimension "-2.54cms") (parse-dimension "-1in"))
|
|
(check-equal? (parse-dimension "25.4mm") (parse-dimension "1in"))
|
|
(check-equal? (parse-dimension "-25.4mms") (parse-dimension "-1in"))
|
|
(check-equal? (parse-dimension "2.5em" (hash :font-size 12)) 30)
|
|
(check-equal? (parse-dimension "-2.5em" (hash :font-size 12)) -30)
|
|
(check-equal? (parse-dimension "25.4em") "25.4em")
|
|
(check-equal? (parse-dimension "-25.4ems") "-25.4ems")
|
|
(check-equal? (parse-dimension "6pica3") 75)
|
|
(check-equal? (parse-dimension "6.5picas3.5") 81.5)
|
|
(check-equal? (parse-dimension "12p") 144)
|
|
(check-equal? (parse-dimension "-6p3") -75)
|
|
(check-equal? (parse-dimension "-6.5ps3.5") -81.5))
|
|
|
|
(define (copy-block-attrs source-hash dest-hash)
|
|
(define new-hash (make-hasheq))
|
|
(for ([(k v) (in-hash dest-hash)])
|
|
(hash-set! new-hash k v))
|
|
(for ([(k v) (in-hash source-hash)]
|
|
#:when (memq k block-attrs))
|
|
(hash-set! new-hash k v))
|
|
new-hash)
|
|
|
|
(define-syntax (define-attrs stx)
|
|
(syntax-case stx ()
|
|
[(_ (ATTR-NAME ...))
|
|
(with-syntax ([(ATTR-ID ...) (for/list ([attr-id (in-list (syntax->list #'(ATTR-NAME ...)))])
|
|
(format-id stx ":~a" (syntax-e attr-id)))])
|
|
#'(begin
|
|
(define ATTR-ID 'ATTR-NAME) ...))]
|
|
[(_ ID (ATTR-NAME ...))
|
|
(replace-context stx
|
|
#'(begin
|
|
(define ID (list 'ATTR-NAME ...))
|
|
(define-attrs (ATTR-NAME ...))))]))
|
|
|
|
|
|
#|
|
|
Naming guidelines
|
|
+ shorter is better
|
|
+ general to specific: border-color-left, not border-left-color or left-border-color
|
|
+ don't refer to specific output format, e.g. PDF or HTML
|
|
+ consistency with CSS style property names is OK if the concept is mostly the same, but usually it's not
|
|
+ default value for any missing attr is #false
|
|
+ measurement units are points by default
|
|
|
|
|#
|
|
|
|
|
|
(define-attrs (font-family
|
|
font-path
|
|
font-size
|
|
font-color
|
|
font-features
|
|
font-features-adjust
|
|
font-italic
|
|
font-bold
|
|
font-underline
|
|
font-tracking
|
|
font-baseline-shift
|
|
font-case
|
|
|
|
bg
|
|
link
|
|
href
|
|
line-height
|
|
hyphenate
|
|
list-index
|
|
no-colbr
|
|
no-pbr
|
|
page-number
|
|
doc-title
|
|
|
|
output-path
|
|
|
|
pdf-title
|
|
pdf-subject
|
|
pdf-author
|
|
pdf-keywords
|
|
|
|
break
|
|
|
|
draw
|
|
width
|
|
height
|
|
parent
|
|
anchor-from
|
|
anchor-from-parent
|
|
anchor-to
|
|
string
|
|
color
|
|
stroke
|
|
x
|
|
y
|
|
x1 ;; x & y are the top-left pos of the bounding box.
|
|
y1 ;; x1 & y1 are the starting points of a line
|
|
x2
|
|
y2))
|
|
|
|
|
|
(define-attrs block-attrs (display
|
|
;; inset values increase the layout size of the quad.
|
|
;; they are relative to the natural layout box.
|
|
inset-top
|
|
inset-bottom
|
|
inset-left
|
|
inset-right
|
|
;; border-inset values do not increase the layout size of the quad.
|
|
;; they are relative to the layout size of the quad, with inset values included.
|
|
;; this is different from CSS, where margin + padding increase the size of the layout.
|
|
;; one has to be dependent on the other, so a choice must be made.
|
|
;; I find this approach more sensible because
|
|
;; borders are a styling element, not a layout element.
|
|
;; this means that changing the inset values will change the position of the border.
|
|
;; but this is preferable to the CSS model, where moving the border changes the layout.
|
|
;; principle: minimize the number of values that affect the layout,
|
|
;; so it's easier to reason about programmatically.
|
|
border-inset-top
|
|
border-inset-bottom
|
|
border-inset-left
|
|
border-inset-right
|
|
border-width-left
|
|
border-width-right
|
|
border-width-top
|
|
border-width-bottom
|
|
border-color-left
|
|
border-color-right
|
|
border-color-top
|
|
border-color-bottom
|
|
background-color
|
|
|
|
block-clip ; whether box boundary clips its contents
|
|
|
|
space-after ; space after a block, like a paragraph
|
|
space-before
|
|
|
|
column-count
|
|
column-gap
|
|
|
|
keep-first-lines
|
|
keep-last-lines
|
|
|
|
keep-with-next
|
|
|
|
line-align
|
|
|
|
first-line-indent
|
|
|
|
line-wrap
|
|
|
|
image-file
|
|
image-object
|
|
image-alt
|
|
image-height
|
|
image-width
|
|
|
|
page-width
|
|
page-height
|
|
page-size ; e.g., "letter"
|
|
page-orientation ; only applies to page-size dimensions
|
|
|
|
page-number-start ; 1
|
|
page-side-start ; 'right
|
|
|
|
page-margin-top
|
|
page-margin-bottom
|
|
page-margin-left
|
|
page-margin-right
|
|
page-margin-gutter
|
|
|
|
footer-display
|
|
footer-text
|
|
|
|
;; we want this distinct from anchor-parent
|
|
;; because the two directives may overlap / contradict.
|
|
;; for instance: repeat on every page,
|
|
;; a quad that prints on the previous page on the second line.
|
|
repeat
|
|
|
|
draw-debug
|
|
|
|
fn-ref
|
|
fn-text
|
|
fn-text-start))
|
|
|
|
(define (takes-dimension-string? k)
|
|
(and (memq k (list :page-width
|
|
:page-height
|
|
:page-margin-top
|
|
:page-margin-bottom
|
|
:page-margin-left
|
|
:page-margin-right
|
|
:page-margin-gutter
|
|
:column-gap
|
|
:inset-top
|
|
:inset-bottom
|
|
:inset-left
|
|
:inset-right
|
|
:border-inset-top
|
|
:border-inset-bottom
|
|
:border-inset-left
|
|
:border-inset-right
|
|
:border-width-left
|
|
:border-width-right
|
|
:border-width-top
|
|
:border-width-bottom
|
|
:space-before
|
|
:space-after
|
|
:image-height
|
|
:image-width
|
|
:font-size
|
|
:font-tracking
|
|
:font-baseline-shift
|
|
:line-height
|
|
:x
|
|
:y
|
|
:x1
|
|
:x2
|
|
:y1
|
|
:y2
|
|
:stroke
|
|
:width)) #true))
|
|
|
|
(define (has-case-sensitive-value? k)
|
|
(and (memq k (list :pdf-title
|
|
:pdf-subject
|
|
:pdf-author
|
|
:pdf-keywords
|
|
:string
|
|
:font-family
|
|
:footer-text
|
|
:output-path)) #true))
|
|
|
|
(define (takes-path? k)
|
|
(and (memq k (list :image-file)) #true))
|