start of css math lib

pull/9/head
Matthew Butterick 11 years ago
parent 0b9e8f6ab4
commit c98d7e3229

@ -1,21 +1,46 @@
#lang racket/base #lang racket/base
(require "core.rkt") (require "core.rkt" racket/match)
(define/contract (css-unit? x)
(any/c . -> . boolean?)
(x . in? . '("%" "in" "cm" "mm" "em" "ex" "pt" "pc" "px" "rem")))
(struct cssq (num unit) (struct cssq (num unit)
#:methods gen:custom-write #:methods gen:custom-write
[(define write-proc [(define write-proc
(λ(x port mode) (display (format "~a~a" (cssq-num x) (cssq-unit x)) port)))]) (λ(x port mode) (display (format "~a~a" (cssq-num x) (cssq-unit x)) port)))])
(define (string->cssq str) (define/contract (cssqish? x)
(any/c . -> . boolean?)
(->boolean (or (cssq? x) (cssqish->cssq x))))
(define/contract (string->unit x)
(string? . -> . css-unit?)
(if (css-unit? x)
x
(error 'string->unit "'~a' not a valid css unit" x)))
(define (cssqish->cssq x)
(cond
[(cssq? x) x]
[else (begin
(define pieces (let* ([str (string-downcase x)]
[str (string-replace str " " "")]
[str (string-trim str "s" #:left? #f)])
(string-split str #px"(?<![A-Za-z])(?=[A-Za-z])")))
(apply cssq (apply cssq
(let ([str (string-trim str "s" #:left? #f)]) (with-handlers ([exn:fail? (λ(e) (error 'string->cssq (exn-message e)))])
(regexp-split #px"(?<=[.\\d])(?=[A-Za-z])" str)))) (list (string->number (first pieces))
(string->unit (second pieces))))))]))
(define/contract (css-math-op op left right)
(procedure? cssqish? cssqish? . -> . cssq?)
(let ([left (cssqish->cssq left)]
[right (cssqish->cssq right)])
(cssqish->cssq (format "~a~a" (apply op (list (cssq-num left) (cssq-num right)))(cssq-unit left)))))
(define (css+ left right) (define-values (css+ css- css* css/)
(string->cssq (format "~a~a" (apply + (map string->number (list (cssq-num left) (cssq-num right))))(cssq-unit left)))) (apply values (map (λ(op) (λ(left right) (css-math-op op left right))) (list + - * /))))
(module+ main (module+ main
(define q1 (string->cssq "51.2rems")) (css+ "10rem" "5rem"))
(define q2 (string->cssq "10rem"))
(css+ q1 q2))
Loading…
Cancel
Save