add files
parent
6dd409162b
commit
eb98cf1815
@ -0,0 +1,15 @@
|
|||||||
|
# for Racket
|
||||||
|
compiled/
|
||||||
|
|
||||||
|
# for Mac OS X
|
||||||
|
.DS_Store
|
||||||
|
.AppleDouble
|
||||||
|
.LSOverride
|
||||||
|
Icon
|
||||||
|
|
||||||
|
# Thumbnails
|
||||||
|
._*
|
||||||
|
|
||||||
|
# Files that might appear on external disk
|
||||||
|
.Spotlight-V100
|
||||||
|
.Trashes
|
@ -1,4 +1,4 @@
|
|||||||
css-tools
|
css-tools
|
||||||
=========
|
---------
|
||||||
|
|
||||||
Tools for using Racket as a CSS preprocessor
|
Tools for using Racket as a CSS preprocessor
|
||||||
|
@ -0,0 +1,304 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require racket/contract racket/match racket/string)
|
||||||
|
|
||||||
|
(require "named-colors.rkt")
|
||||||
|
|
||||||
|
(module+ test (require rackunit))
|
||||||
|
|
||||||
|
|
||||||
|
;; Conversion functions between RGB and other color systems.
|
||||||
|
;; Adaptation of colorsys module in the Python library
|
||||||
|
;; Original source:
|
||||||
|
;; http://hg.python.org/cpython/file/2.7/Lib/colorsys.py
|
||||||
|
|
||||||
|
;; References:
|
||||||
|
;; http://en.wikipedia.org/wiki/HLS_color_space
|
||||||
|
|
||||||
|
|
||||||
|
(provide rgb->hsl hsl->rgb
|
||||||
|
rgb->hex hex->rgb
|
||||||
|
hsl->hex hex->hsl)
|
||||||
|
|
||||||
|
|
||||||
|
;; this makes things work on exact numbers by default
|
||||||
|
(read-decimal-as-inexact #f)
|
||||||
|
|
||||||
|
|
||||||
|
(define unitval? (real-in 0 1))
|
||||||
|
|
||||||
|
(define/contract (real->unitval x)
|
||||||
|
(real? . -> . unitval?)
|
||||||
|
(min (max 0 x) 1))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (real->unitval -10) 0)
|
||||||
|
(check-equal? (real->unitval 10) 1)
|
||||||
|
(check-equal? (real->unitval 0.5) 0.5))
|
||||||
|
|
||||||
|
|
||||||
|
(define DEGREE_MAX 360)
|
||||||
|
(define degree? (real-in 0 DEGREE_MAX))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-false (degree? -1))
|
||||||
|
(check-true (degree? 0))
|
||||||
|
(check-true (degree? 149.23))
|
||||||
|
(check-true (degree? 255))
|
||||||
|
(check-false (degree? 361)))
|
||||||
|
|
||||||
|
|
||||||
|
;; like (modulo x 1) but works with floating-point numbers
|
||||||
|
(define (modulo1 x)
|
||||||
|
(- x (floor x)))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (unitval->byte u)
|
||||||
|
(unitval? . -> . byte?)
|
||||||
|
(inexact->exact (floor (* u 255))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (unitval->byte 0) 0)
|
||||||
|
(check-equal? (unitval->byte 1) 255))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (byte->unitval b)
|
||||||
|
(byte? . -> . unitval?)
|
||||||
|
(/ b 255))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (byte->unitval 0) 0)
|
||||||
|
(check-equal? (byte->unitval 255) 1))
|
||||||
|
|
||||||
|
|
||||||
|
(define (degree-string? x)
|
||||||
|
(and (string? x) (degree? (string->number x))))
|
||||||
|
|
||||||
|
(define/contract (unitval->degree u)
|
||||||
|
(unitval? . -> . degree-string?)
|
||||||
|
(format "~a" (exact->inexact (/ (floor (* u DEGREE_MAX 100)) 100))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (unitval->degree 0) "0.0")
|
||||||
|
(check-equal? (unitval->degree 0.5) "180.0")
|
||||||
|
(check-equal? (unitval->degree 1) "360.0"))
|
||||||
|
|
||||||
|
(define (unitval->percentage u)
|
||||||
|
(format "~a%" (exact->inexact (/ (floor (* u 100 100)) 100))))
|
||||||
|
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-true (degree-string? "0"))
|
||||||
|
(check-true (degree-string? "180"))
|
||||||
|
(check-true (degree-string? "360"))
|
||||||
|
(check-false (degree-string? "450"))
|
||||||
|
(check-false (degree-string? 450))
|
||||||
|
(check-false (degree-string? "foo")))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (degree-string->unitval d)
|
||||||
|
(degree-string? . -> . unitval?)
|
||||||
|
(/ (string->number d) DEGREE_MAX))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (degree-string->unitval "0") 0)
|
||||||
|
(check-equal? (degree-string->unitval "180") (/ 1 2))
|
||||||
|
(check-equal? (degree-string->unitval "360") 1))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (trim-unitval-sign x)
|
||||||
|
(string? . -> . string?)
|
||||||
|
(string-trim x "%" #:left? #f))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (trim-unitval-sign "50") "50")
|
||||||
|
(check-equal? (trim-unitval-sign "50%") "50")
|
||||||
|
(check-equal? (trim-unitval-sign "%50%") "%50"))
|
||||||
|
|
||||||
|
(define/contract (unitval-string? x)
|
||||||
|
(any/c . -> . boolean?)
|
||||||
|
(and (string? x)
|
||||||
|
(equal? #\% (car (reverse (string->list x))))
|
||||||
|
((real-in 0 100) (string->number (trim-unitval-sign x)))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-true (unitval-string? "56%"))
|
||||||
|
(check-true (unitval-string? "0.00001%"))
|
||||||
|
(check-false (unitval-string? 50))
|
||||||
|
(check-false (unitval-string? "50"))
|
||||||
|
(check-false (unitval-string? "-12%"))
|
||||||
|
(check-false (unitval-string? "200%")))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (unitval-string->unitval x)
|
||||||
|
(unitval-string? . -> . unitval?)
|
||||||
|
(/ (string->number (trim-unitval-sign x)) 100))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (unitval-string->unitval "50%") (/ 1 2))
|
||||||
|
(check-equal? (unitval-string->unitval "100%") 1)
|
||||||
|
(check-equal? (unitval-string->unitval "0%") 0))
|
||||||
|
|
||||||
|
|
||||||
|
(define (trim-pound-sign x)
|
||||||
|
(string-trim x "#" #:right? #f))
|
||||||
|
|
||||||
|
(define (make-hex-number x)
|
||||||
|
(string->number (string-append "#x" (trim-pound-sign x))))
|
||||||
|
|
||||||
|
|
||||||
|
(define HEX_DIGITS (string->list "0123456789abcdef"))
|
||||||
|
(define (hex-digit? x)
|
||||||
|
(member x HEX_DIGITS))
|
||||||
|
|
||||||
|
(define (base-hex? x)
|
||||||
|
(and (string? x)
|
||||||
|
(equal? (substring x 0 1) "#")
|
||||||
|
(andmap hex-digit? (string->list (string-downcase (trim-pound-sign x))))))
|
||||||
|
|
||||||
|
(define (short-hex? x) ; like #ddd
|
||||||
|
(and (= (string-length x) 4) (base-hex? x)))
|
||||||
|
|
||||||
|
(define (long-hex? x) ; like #e802cf
|
||||||
|
(and (= (string-length x) 7) (base-hex? x)))
|
||||||
|
|
||||||
|
(define (hex? x)
|
||||||
|
(or (short-hex? x) (long-hex? x)))
|
||||||
|
|
||||||
|
(define rgb? (list/c unitval? unitval? unitval?))
|
||||||
|
(define hsl? rgb?)
|
||||||
|
|
||||||
|
(define (rgbish? x)
|
||||||
|
(ormap (λ(proc) (proc x))
|
||||||
|
(list
|
||||||
|
rgb?
|
||||||
|
(list/c unitval-string? unitval-string? unitval-string?)
|
||||||
|
(list/c byte? byte? byte?)
|
||||||
|
hex?
|
||||||
|
named-color?)))
|
||||||
|
|
||||||
|
(define/contract (rgbish->rgb x)
|
||||||
|
(rgbish? . -> . rgb?)
|
||||||
|
;; must handle all possible branches of rgbish
|
||||||
|
(cond
|
||||||
|
[(rgb? x) x]
|
||||||
|
[((list/c unitval-string? unitval-string? unitval-string?) x)
|
||||||
|
(map unitval-string->unitval x)]
|
||||||
|
[((list/c byte? byte? byte?) x) (map byte->unitval x)]
|
||||||
|
[(hex? x) (hex->rgb x)]
|
||||||
|
[(named-color? x) (rgbish->rgb (named-color->hex x))]
|
||||||
|
[else #f]))
|
||||||
|
|
||||||
|
|
||||||
|
(define (hslish? x)
|
||||||
|
(ormap (λ(proc) (proc x))
|
||||||
|
(list
|
||||||
|
hsl?
|
||||||
|
(list/c degree-string? unitval-string? unitval-string?) ; aka css-hsl
|
||||||
|
(list/c byte? byte? byte?))))
|
||||||
|
|
||||||
|
(define (hslish->hsl x)
|
||||||
|
(hslish? . -> . hsl?)
|
||||||
|
(cond
|
||||||
|
[(hsl? x) x]
|
||||||
|
[((list/c degree-string? unitval-string? unitval-string?) x) (cons (degree-string->unitval (car x)) (map unitval-string->unitval (cdr x)))]
|
||||||
|
[((list/c byte? byte? byte?) x) (map byte->unitval x)]
|
||||||
|
[else #f]))
|
||||||
|
|
||||||
|
(define (hsl->css hsl)
|
||||||
|
(hslish? . -> . hsl?)
|
||||||
|
(match-define (list h s lum) (hslish->hsl hsl))
|
||||||
|
(list (unitval->degree h) (unitval->percentage s) (unitval->percentage lum)))
|
||||||
|
|
||||||
|
;; convert rgb values into hue value
|
||||||
|
(define/contract (rgb->h r g b)
|
||||||
|
(unitval? unitval? unitval? . -> . unitval?)
|
||||||
|
(define maxc (max r g b))
|
||||||
|
(define minc (min r g b))
|
||||||
|
(if (minc . = . maxc)
|
||||||
|
0 ; color is gray. Return now & avoid division by zero below
|
||||||
|
(let ()
|
||||||
|
(define-values (rc gc bc)
|
||||||
|
(apply values (map (λ(x) (/ (- maxc x) (- maxc minc))) (list r g b))))
|
||||||
|
(modulo1 (/ (cond
|
||||||
|
[(r . = . maxc) (- bc gc)]
|
||||||
|
[(g . = . maxc) (+ 2.0 (- rc bc))]
|
||||||
|
[else (+ 4.0 (- gc rc))])
|
||||||
|
6.0)))))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (rgb->hsl rgb)
|
||||||
|
(rgbish? . -> . hsl?)
|
||||||
|
(match-define (list r g b) (rgbish->rgb rgb))
|
||||||
|
(define maxc (max r g b))
|
||||||
|
(define minc (min r g b))
|
||||||
|
(define h (rgb->h r g b))
|
||||||
|
(define lum (/ (+ maxc minc) 2))
|
||||||
|
(define s (/ (- maxc minc) (if (lum . <= . 0.5)
|
||||||
|
(+ maxc minc)
|
||||||
|
(- 2.0 maxc minc))))
|
||||||
|
(map real->unitval (list h s lum)))
|
||||||
|
|
||||||
|
(define/contract (hsl->rgb hsl)
|
||||||
|
(hslish? . -> . rgb?)
|
||||||
|
(define ONE_THIRD (/ 1 3))
|
||||||
|
(define ONE_SIXTH (/ 1 6))
|
||||||
|
(define TWO_THIRDS (/ 2 3))
|
||||||
|
(match-define (list h s lum) (hslish->hsl hsl))
|
||||||
|
|
||||||
|
(define (_v m1 m2 hue)
|
||||||
|
(let ([hue (modulo1 hue)])
|
||||||
|
(cond
|
||||||
|
[(hue . < . ONE_SIXTH) (+ m1 (* (- m2 m1) hue 6.0))]
|
||||||
|
[(hue . < . 0.5) m2]
|
||||||
|
[(hue . < . TWO_THIRDS) (+ m1 (* (- m2 m1) (- TWO_THIRDS hue) 6.0))]
|
||||||
|
[else m1])))
|
||||||
|
|
||||||
|
(define m2 (if (lum . <= . 0.5)
|
||||||
|
(* lum (+ 1.0 s))
|
||||||
|
(- (+ lum s) (* lum s))))
|
||||||
|
|
||||||
|
(define m1 (- (* 2.0 lum) m2))
|
||||||
|
|
||||||
|
(map real->unitval (map (λ(x) (_v m1 m2 x))
|
||||||
|
(list (+ h ONE_THIRD) h (- h ONE_THIRD)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (rgb->hex rgb)
|
||||||
|
(rgbish? . -> . hex?)
|
||||||
|
;; make a 2-digit hex string from a number
|
||||||
|
(define (hex-format num)
|
||||||
|
(define hex (format "~x" num))
|
||||||
|
(if (= (string-length hex) 1)
|
||||||
|
(string-append "0" hex)
|
||||||
|
hex))
|
||||||
|
|
||||||
|
(define raw-hex (apply string-append (map hex-format (map unitval->byte (rgbish->rgb rgb)))))
|
||||||
|
(define triple-double-pattern #px"^(\\w)\\1(\\w)\\2(\\w)\\3$")
|
||||||
|
(define result (regexp-match triple-double-pattern raw-hex))
|
||||||
|
(string-append "#" (if result
|
||||||
|
; cdr result holds the three submatches
|
||||||
|
(apply string-append (cdr result))
|
||||||
|
raw-hex)))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (rgb->hex '(1 1 1)) "#fff")
|
||||||
|
(check-equal? (rgb->hex '(0.8 0.8 0.8)) "#ccc")
|
||||||
|
(check-equal? (rgb->hex '(0.01 0.01 0.01)) "#020202"))
|
||||||
|
|
||||||
|
(define/contract (hex->long-hex hex)
|
||||||
|
(hex? . -> . long-hex?)
|
||||||
|
(if (short-hex? hex)
|
||||||
|
(let ()
|
||||||
|
(match-define (list d1 d2 d3) (cdr (regexp-match #px"^#(\\w)(\\w)(\\w)$" hex)))
|
||||||
|
(string-append "#" d1 d1 d2 d2 d3 d3))
|
||||||
|
hex))
|
||||||
|
|
||||||
|
(define/contract (hex->rgb hex)
|
||||||
|
(hex? . -> . rgb?)
|
||||||
|
(let ([hex (hex->long-hex hex)])
|
||||||
|
(define result (regexp-match #px"^#(\\w\\w)(\\w\\w)(\\w\\w)$" hex))
|
||||||
|
(map (compose1 byte->unitval make-hex-number) (cdr result))))
|
||||||
|
|
||||||
|
(define hsl->hex (compose1 rgb->hex hsl->rgb))
|
||||||
|
(define hex->hsl (compose1 rgb->hsl hex->rgb))
|
@ -0,0 +1,22 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require "core.rkt")
|
||||||
|
|
||||||
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
(define (make-css-columns #:count count #:gap [gap #f])
|
||||||
|
; shorthand for css column declaration
|
||||||
|
(join-css-strings (append
|
||||||
|
(make-css-strings css-property-prefixes "column-count" count)
|
||||||
|
(if gap
|
||||||
|
(make-css-strings css-property-prefixes "column-gap" gap)
|
||||||
|
empty))))
|
||||||
|
|
||||||
|
(define (make-css-avoid-column-break-inside)
|
||||||
|
; this gets applied to list items to keep them from breaking across columns
|
||||||
|
; however it doesn't work in Firefox due to bug; workaround is stupid
|
||||||
|
(join-css-strings (append
|
||||||
|
(make-css-strings css-property-prefixes "column-break-inside" "avoid")
|
||||||
|
(make-css-strings css-property-prefixes "break-inside" "avoid-column"))))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -0,0 +1,35 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require racket/string racket/list racket/contract)
|
||||||
|
(require sugar)
|
||||||
|
|
||||||
|
(provide (all-defined-out)
|
||||||
|
(all-from-out racket/string racket/list racket/contract sugar))
|
||||||
|
|
||||||
|
(define css-property-prefixes '("-moz-" "-webkit-" "-o-" "-ms-" ""))
|
||||||
|
|
||||||
|
(define (join-css-strings properties)
|
||||||
|
(define line-ending ";\n")
|
||||||
|
(define out-string (string-join properties line-ending))
|
||||||
|
(if (ends-with? out-string line-ending) ; might already have the line ending, so don't duplicate it
|
||||||
|
out-string
|
||||||
|
(string-append out-string line-ending)))
|
||||||
|
|
||||||
|
(define (make-css-string p v)
|
||||||
|
(string-join (list (->string p) (->string v)) ": "))
|
||||||
|
|
||||||
|
(define (make-css-strings property-prefixes property-suffix values)
|
||||||
|
; general function for creating groups of css properties
|
||||||
|
; with browser prefixes and one value
|
||||||
|
(define (map-suffix suffix prefixes)
|
||||||
|
(map (λ(prefix) (string-append prefix suffix)) prefixes))
|
||||||
|
|
||||||
|
|
||||||
|
(define properties (map-suffix property-suffix property-prefixes))
|
||||||
|
|
||||||
|
; if single value provided, convert to list of values
|
||||||
|
; so that it will work with map in the next step
|
||||||
|
(when (not (list? values))
|
||||||
|
(set! values (make-list (len properties) values)))
|
||||||
|
|
||||||
|
(map make-css-string properties values))
|
||||||
|
|
@ -0,0 +1,86 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require "core.rkt")
|
||||||
|
(require pollen/file-tools)
|
||||||
|
(require net/url-structs net/base64 racket/file)
|
||||||
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
(module+ test (require rackunit))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (base64-font-string? x)
|
||||||
|
(any/c . -> . boolean?)
|
||||||
|
((->string x) . starts-with? . "data:"))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-true (base64-font-string? "data:foobar"))
|
||||||
|
(check-false (base64-font-string? "foobar")))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (font-format p)
|
||||||
|
(pathish? . -> . (or/c string? #f))
|
||||||
|
(case (get-ext (->path p))
|
||||||
|
[("eot") "embedded-opentype"]
|
||||||
|
[("woff") "woff"]
|
||||||
|
[("ttf" "otf") "truetype"] ; yep, in this CSS declaration, otf is considered 'truetype'
|
||||||
|
[("svg") "svg"]
|
||||||
|
[else #f]))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (font-format "foo.eot") "embedded-opentype")
|
||||||
|
(check-equal? (font-format "foo.woff") "woff")
|
||||||
|
(check-equal? (font-format "foo.ttf") "truetype")
|
||||||
|
(check-equal? (font-format "foo.otf") "truetype")
|
||||||
|
(check-equal? (font-format "foo.svg") "svg")
|
||||||
|
(check-false (font-format "foo")))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (font-mime-type p)
|
||||||
|
(pathish? . -> . (or/c string? #f))
|
||||||
|
(case (get-ext (->path p))
|
||||||
|
[("eot") "application/vnd.ms-fontobject"]
|
||||||
|
[("woff") "application/font-woff"]
|
||||||
|
[("ttf") "application/x-font-truetype"]
|
||||||
|
[("otf") "application/x-font-opentype"]
|
||||||
|
[("svg") "image/svg+xml"]
|
||||||
|
[else #f]))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (font-mime-type "foo.eot") "application/vnd.ms-fontobject")
|
||||||
|
(check-equal? (font-mime-type (->url "foo.woff?bar=ino")) "application/font-woff")
|
||||||
|
(check-equal? (font-mime-type "foo.ttf") "application/x-font-truetype")
|
||||||
|
(check-equal? (font-mime-type "foo.otf") "application/x-font-opentype")
|
||||||
|
(check-equal? (font-mime-type "foo.svg") "image/svg+xml")
|
||||||
|
(check-false (font-mime-type "foo")))
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (path->base64-font-string p)
|
||||||
|
(pathish? . -> . base64-font-string?)
|
||||||
|
(define path (->path p))
|
||||||
|
;; for CSS, base64 encode needs to be done with no line separator
|
||||||
|
(format "data:~a;charset=utf-8;base64,~a" (font-mime-type p) (base64-encode (file->bytes path) #"")))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(define/contract (font-face-declaration font-family
|
||||||
|
src-url
|
||||||
|
#:font-style [font-style "normal"]
|
||||||
|
#:font-weight [font-weight "normal"]
|
||||||
|
#:font-stretch [font-stretch "normal"]
|
||||||
|
#:base64 [base64? #f])
|
||||||
|
((string? (or/c urlish? base64-font-string?))
|
||||||
|
(#:font-style string? #:font-weight string? #:font-stretch string? #:base64 boolean?)
|
||||||
|
. ->* . string?)
|
||||||
|
(let* [(url (->url src-url))
|
||||||
|
(url-value (if base64? (path->base64-font-string src-url) (->path url)))
|
||||||
|
(src (format "url('~a') format('~a')" url-value (font-format src-url)))]
|
||||||
|
(string-append "@font-face {\n"
|
||||||
|
(join-css-strings (map make-css-string
|
||||||
|
'(font-family font-style font-weight font-stretch src)
|
||||||
|
(list font-family font-style font-weight font-stretch src)))
|
||||||
|
"}")))
|
||||||
|
|
||||||
|
(define ffd font-face-declaration)
|
||||||
|
|
||||||
|
;;(module+ main
|
||||||
|
;;(display (ffd "Miso" "charter-regular.woff" #:font-style "italic" #:font-weight "700" #:base64 #t)))
|
@ -0,0 +1,44 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require "core.rkt")
|
||||||
|
|
||||||
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
(define (make-css-background-gradient colors [stops #f]
|
||||||
|
#:radial [radial #f]
|
||||||
|
#:horizontal [horizontal #f]
|
||||||
|
#:direction [direction #f])
|
||||||
|
; this doesn't handle old-style webkit syntax. todo: add it? I think I don't care
|
||||||
|
|
||||||
|
; check inputs for failure
|
||||||
|
(when (or (not (list? colors)) (< (len colors) 2))
|
||||||
|
(error "Not enough colors to make gradient in" colors))
|
||||||
|
(when (and stops (< (len stops) (len colors)))
|
||||||
|
(error "Not enough stops for given number of colors in" stops))
|
||||||
|
|
||||||
|
(when (not stops) ; distribute colors evenly between 0 and 100
|
||||||
|
; new-stops is range of steps incremented properly and rounded to int, then append 100 to end
|
||||||
|
(let ([new-stops `(,@(map ->int (range 0 100 (/ 100 (sub1 (len colors))))) 100)])
|
||||||
|
; convert to list of percentages
|
||||||
|
(set! stops (map (λ(x) (format "~a%" x)) new-stops))))
|
||||||
|
|
||||||
|
; color / percentage pairs separated by commas
|
||||||
|
(define color-stop-string (string-join (map (λ(color stop) (format "~a ~a" color stop)) colors stops) ", "))
|
||||||
|
|
||||||
|
; set up gradient options
|
||||||
|
(define gradient-type (if radial "radial" "linear"))
|
||||||
|
(define gradient-direction (or direction (if horizontal "left" "top")))
|
||||||
|
|
||||||
|
; can't use standard make-css-strings in this case because the prefixes appear in the value,
|
||||||
|
; not in the property (which is always "background")
|
||||||
|
(define gradient-strings (map (λ(prefix) (format "background: ~a~a-gradient(~a, ~a)" prefix gradient-type gradient-direction color-stop-string)) css-property-prefixes))
|
||||||
|
|
||||||
|
; just fill with the last color if gradient not available
|
||||||
|
(define fallback-string (format "background: ~a" (last colors)))
|
||||||
|
|
||||||
|
; put fallback string at front of list
|
||||||
|
(join-css-strings (cons fallback-string gradient-strings)))
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(display (make-css-background-gradient (list "hsl(216, 78%, 95%)" "hsl(0, 0%, 99%)")
|
||||||
|
(list "0%" "100%")
|
||||||
|
#:direction "to top right")))
|
@ -0,0 +1,3 @@
|
|||||||
|
#lang info
|
||||||
|
(define collection "css-tools")
|
||||||
|
(define scribblings '(("scribblings/css-tools.scrbl" ())))
|
@ -0,0 +1,22 @@
|
|||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require "core.rkt"
|
||||||
|
"colors.rkt"
|
||||||
|
"column.rkt"
|
||||||
|
"font-face.rkt"
|
||||||
|
"gradient.rkt"
|
||||||
|
"misc.rkt"
|
||||||
|
"transition.rkt"
|
||||||
|
"typography.rkt")
|
||||||
|
|
||||||
|
|
||||||
|
(provide (all-from-out "core.rkt"
|
||||||
|
"column.rkt"
|
||||||
|
"colors.rkt"
|
||||||
|
"font-face.rkt"
|
||||||
|
"gradient.rkt"
|
||||||
|
"misc.rkt"
|
||||||
|
"transition.rkt"
|
||||||
|
"typography.rkt"))
|
||||||
|
|
||||||
|
|
@ -0,0 +1,47 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(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)
|
||||||
|
#:methods gen:custom-write
|
||||||
|
[(define write-proc
|
||||||
|
(λ(x port mode) (display (format "~a~a" (cssq-num x) (cssq-unit x)) port)))])
|
||||||
|
|
||||||
|
(define/contract (cssqish? x)
|
||||||
|
(any/c . -> . boolean?)
|
||||||
|
(->boolean (or (cssq? x) (string? 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/contract (cssqish->cssq x)
|
||||||
|
(cssqish? . -> . cssq?)
|
||||||
|
(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
|
||||||
|
(with-handlers ([exn:fail? (λ(e) (error 'string->cssq (exn-message e)))])
|
||||||
|
(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-values (css+ css- css* css/)
|
||||||
|
(apply values (map (λ(op) (λ(left right) (css-math-op op left right))) (list + - * /))))
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(css+ "10rem" "5rem"))
|
@ -0,0 +1,28 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require "core.rkt")
|
||||||
|
|
||||||
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
|
||||||
|
; editability can't be handled as pure css because firefox requires extra content-editable attribute.
|
||||||
|
; does it still? todo: further research, maybe this can be css only.
|
||||||
|
(define (editable . stuff)
|
||||||
|
(define editable-string (make-css-editable))
|
||||||
|
`(div ((style ,editable-string)(contenteditable "true")) ,@stuff))
|
||||||
|
|
||||||
|
(define (make-css-editable)
|
||||||
|
(join-css-strings (list "user-modify: read-write"
|
||||||
|
"-moz-user-modify: read-write"
|
||||||
|
"-webkit-user-modify: read-write-plaintext-only"
|
||||||
|
"outline-style: none")))
|
||||||
|
|
||||||
|
|
||||||
|
(define (make-media-query starting-size ending-size max-width interval)
|
||||||
|
(string-join (cons (format "@media all {html {font-size: ~apx;}}" starting-size)
|
||||||
|
(for/list ([size (in-range starting-size (sub1 ending-size) -1)])
|
||||||
|
(format "@media all and (max-width:~apx){html {font-size: ~apx;}}"
|
||||||
|
(- max-width (* interval (- starting-size size))) size))) "\n"))
|
||||||
|
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(display (make-media-query 15 11 980 60)))
|
@ -0,0 +1,151 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require racket/dict)
|
||||||
|
|
||||||
|
(provide named-color? named-color->hex)
|
||||||
|
|
||||||
|
(define (named-color? x)
|
||||||
|
(and (string? x) (dict-has-key? named-colors (string-downcase x))))
|
||||||
|
|
||||||
|
(define (named-color->hex nc)
|
||||||
|
(dict-ref named-colors (string-downcase nc)))
|
||||||
|
|
||||||
|
(define named-colors
|
||||||
|
'(("antiquewhite" . "#faebd7")
|
||||||
|
("aqua" . "#00ffff")
|
||||||
|
("aquamarine" . "#7fffd4")
|
||||||
|
("azure" . "#f0ffff")
|
||||||
|
("beige" . "#f5f5dc")
|
||||||
|
("bisque" . "#ffe4c4")
|
||||||
|
("black" . "#000000")
|
||||||
|
("blanchedalmond" . "#ffebcd")
|
||||||
|
("blue" . "#0000ff")
|
||||||
|
("blueviolet" . "#8a2be2")
|
||||||
|
("brown" . "#a52a2a")
|
||||||
|
("burlywood" . "#deb887")
|
||||||
|
("cadetblue" . "#5f9ea0")
|
||||||
|
("chartreuse" . "#7fff00")
|
||||||
|
("chocolate" . "#d2691e")
|
||||||
|
("coral" . "#ff7f50")
|
||||||
|
("cornflowerblue" . "#6495ed")
|
||||||
|
("cornsilk" . "#fff8dc")
|
||||||
|
("crimson" . "#dc143c")
|
||||||
|
("cyan" . "#00ffff")
|
||||||
|
("darkblue" . "#00008b")
|
||||||
|
("darkcyan" . "#008b8b")
|
||||||
|
("darkgoldenrod" . "#b8860b")
|
||||||
|
("darkgray" . "#a9a9a9")
|
||||||
|
("darkgreen" . "#006400")
|
||||||
|
("darkkhaki" . "#bdb76b")
|
||||||
|
("darkmagenta" . "#8b008b")
|
||||||
|
("darkolivegreen" . "#556b2f")
|
||||||
|
("darkorange" . "#ff8c00")
|
||||||
|
("darkorchid" . "#9932cc")
|
||||||
|
("darkred" . "#8b0000")
|
||||||
|
("darksalmon" . "#e9967a")
|
||||||
|
("darkseagreen" . "#8fbc8f")
|
||||||
|
("darkslateblue" . "#483d8b")
|
||||||
|
("darkslategray" . "#2f4f4f")
|
||||||
|
("darkturquoise" . "#00ced1")
|
||||||
|
("darkviolet" . "#9400d3")
|
||||||
|
("deeppink" . "#ff1493")
|
||||||
|
("deepskyblue" . "#00bfff")
|
||||||
|
("dimgray" . "#696969")
|
||||||
|
("dodgerblue" . "#1e90ff")
|
||||||
|
("firebrick" . "#b22222")
|
||||||
|
("floralwhite" . "#fffaf0")
|
||||||
|
("forestgreen" . "#228b22")
|
||||||
|
("fuchsia" . "#ff00ff")
|
||||||
|
("gainsboro" . "#dcdcdc")
|
||||||
|
("ghostwhite" . "#f8f8ff")
|
||||||
|
("gold" . "#ffd700")
|
||||||
|
("goldenrod" . "#daa520")
|
||||||
|
("gray" . "#808080")
|
||||||
|
("green" . "#008000")
|
||||||
|
("greenyellow" . "#adff2f")
|
||||||
|
("honeydew" . "#f0fff0")
|
||||||
|
("hotpink" . "#ff69b4")
|
||||||
|
("indianred" . "#cd5c5c")
|
||||||
|
("indigo" . "#4b0082")
|
||||||
|
("ivory" . "#fffff0")
|
||||||
|
("khaki" . "#f0e68c")
|
||||||
|
("lavender" . "#e6e6fa")
|
||||||
|
("lavenderblush" . "#fff0f5")
|
||||||
|
("lawngreen" . "#7cfc00")
|
||||||
|
("lemonchiffon" . "#fffacd")
|
||||||
|
("lightblue" . "#add8e6")
|
||||||
|
("lightcoral" . "#f08080")
|
||||||
|
("lightcyan" . "#e0ffff")
|
||||||
|
("lightgoldenrodyellow" . "#fafad2")
|
||||||
|
("lightgray" . "#d3d3d3")
|
||||||
|
("lightgreen" . "#90ee90")
|
||||||
|
("lightpink" . "#ffb6c1")
|
||||||
|
("lightsalmon" . "#ffa07a")
|
||||||
|
("lightseagreen" . "#20b2aa")
|
||||||
|
("lightskyblue" . "#87cefa")
|
||||||
|
("lightslategray" . "#778899")
|
||||||
|
("lightsteelblue" . "#b0c4de")
|
||||||
|
("lightyellow" . "#ffffe0")
|
||||||
|
("lime" . "#00ff00")
|
||||||
|
("limegreen" . "#32cd32")
|
||||||
|
("linen" . "#faf0e6")
|
||||||
|
("magenta" . "#ff00ff")
|
||||||
|
("maroon" . "#800000")
|
||||||
|
("mediumaquamarine" . "#66cdaa")
|
||||||
|
("mediumblue" . "#0000cd")
|
||||||
|
("mediumorchid" . "#ba55d3")
|
||||||
|
("mediumpurple" . "#9370db")
|
||||||
|
("mediumseagreen" . "#3cb371")
|
||||||
|
("mediumslateblue" . "#7b68ee")
|
||||||
|
("mediumspringgreen" . "#00fa9a")
|
||||||
|
("mediumturquoise" . "#48d1cc")
|
||||||
|
("mediumvioletred" . "#c71585")
|
||||||
|
("midnightblue" . "#191970")
|
||||||
|
("mintcream" . "#f5fffa")
|
||||||
|
("mistyrose" . "#ffe4e1")
|
||||||
|
("moccasin" . "#ffe4b5")
|
||||||
|
("navajowhite" . "#ffdead")
|
||||||
|
("navy" . "#000080")
|
||||||
|
("oldlace" . "#fdf5e6")
|
||||||
|
("olive" . "#808000")
|
||||||
|
("olivedrab" . "#6b8e23")
|
||||||
|
("orange" . "#ffa500")
|
||||||
|
("orangered" . "#ff4500")
|
||||||
|
("orchid" . "#da70d6")
|
||||||
|
("palegoldenrod" . "#eee8aa")
|
||||||
|
("palegreen" . "#98fb98")
|
||||||
|
("paleturquoise" . "#afeeee")
|
||||||
|
("palevioletred" . "#db7093")
|
||||||
|
("papayawhip" . "#ffefd5")
|
||||||
|
("peachpuff" . "#ffdab9")
|
||||||
|
("peru" . "#cd853f")
|
||||||
|
("pink" . "#ffc0cb")
|
||||||
|
("plum" . "#dda0dd")
|
||||||
|
("powderblue" . "#b0e0e6")
|
||||||
|
("purple" . "#800080")
|
||||||
|
("red" . "#ff0000")
|
||||||
|
("rosybrown" . "#bc8f8f")
|
||||||
|
("royalblue" . "#4169e1")
|
||||||
|
("saddlebrown" . "#8b4513")
|
||||||
|
("salmon" . "#fa8072")
|
||||||
|
("sandybrown" . "#f4a460")
|
||||||
|
("seagreen" . "#2e8b57")
|
||||||
|
("seashell" . "#fff5ee")
|
||||||
|
("sienna" . "#a0522d")
|
||||||
|
("silver" . "#c0c0c0")
|
||||||
|
("skyblue" . "#87ceeb")
|
||||||
|
("slateblue" . "#6a5acd")
|
||||||
|
("slategray" . "#708090")
|
||||||
|
("snow" . "#fffafa")
|
||||||
|
("springgreen" . "#00ff7f")
|
||||||
|
("steelblue" . "#4682b4")
|
||||||
|
("tan" . "#d2b48c")
|
||||||
|
("teal" . "#008080")
|
||||||
|
("thistle" . "#d8bfd8")
|
||||||
|
("tomato" . "#ff6347")
|
||||||
|
("turquoise" . "#40e0d0")
|
||||||
|
("violet" . "#ee82ee")
|
||||||
|
("wheat" . "#f5deb3")
|
||||||
|
("white" . "#ffffff")
|
||||||
|
("whitesmoke" . "#f5f5f5")
|
||||||
|
("yellow" . "#ffff00")
|
||||||
|
("yellowgreen" . "#9acd32")))
|
@ -0,0 +1,36 @@
|
|||||||
|
#lang scribble/manual
|
||||||
|
|
||||||
|
@(require scribble/eval (for-label racket "../main.rkt"))
|
||||||
|
|
||||||
|
@(define my-eval (make-base-eval))
|
||||||
|
@(my-eval `(require css-tools))
|
||||||
|
|
||||||
|
|
||||||
|
@title{css-tools}
|
||||||
|
|
||||||
|
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
|
||||||
|
|
||||||
|
A collection of little functions that help make Racket code more readable.
|
||||||
|
|
||||||
|
@section{Installation & updates}
|
||||||
|
|
||||||
|
At the command line:
|
||||||
|
@verbatim{raco pkg install css-tools}
|
||||||
|
|
||||||
|
After that, you can update the package from the command line:
|
||||||
|
@verbatim{raco pkg update css-tools}
|
||||||
|
|
||||||
|
|
||||||
|
@section{Interface}
|
||||||
|
|
||||||
|
@defmodule[css-tools]
|
||||||
|
|
||||||
|
Hello css-tools.
|
||||||
|
|
||||||
|
|
||||||
|
@section{License & source code}
|
||||||
|
|
||||||
|
This module is licensed under the LGPL.
|
||||||
|
|
||||||
|
Source repository at @link["http://github.com/mbutterick/css-tools"]{http://github.com/mbutterick/css-tools}. Suggestions & corrections welcome.
|
||||||
|
|
@ -0,0 +1,16 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require "core.rkt")
|
||||||
|
|
||||||
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
(define (make-css-transition property duration #:timing-function [timing-function #f] #:delay [delay #f])
|
||||||
|
(define transition-prefixes '("-moz-" "-webkit-" ""))
|
||||||
|
(join-css-strings (append
|
||||||
|
(make-css-strings transition-prefixes "transition-property" property)
|
||||||
|
(make-css-strings transition-prefixes "transition-duration" duration)
|
||||||
|
(if timing-function
|
||||||
|
(make-css-strings transition-prefixes "transition-timing-function" timing-function)
|
||||||
|
empty)
|
||||||
|
(if delay
|
||||||
|
(make-css-strings transition-prefixes "transition-delay" delay)
|
||||||
|
empty))))
|
@ -0,0 +1,46 @@
|
|||||||
|
#lang racket/base
|
||||||
|
(require "core.rkt")
|
||||||
|
|
||||||
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
(define (make-css-ot-features feature-tags [feature-values 1])
|
||||||
|
; if single value provided, upconvert to list
|
||||||
|
(when (not (list? feature-tags))
|
||||||
|
(set! feature-tags (list feature-tags)))
|
||||||
|
|
||||||
|
; same here: convert single value into list
|
||||||
|
(when (not (list? feature-values))
|
||||||
|
(let ([single-value feature-values])
|
||||||
|
(set! feature-values (make-list (len feature-tags) single-value))))
|
||||||
|
|
||||||
|
; use single quotes in the formatter because css string might be used in an inline tag
|
||||||
|
; with form style="[string]" so double quotes are irritating
|
||||||
|
(define feature-tag-string (string-join (map (λ(tag value) (format "'~a' ~a" tag value)) feature-tags feature-values) ", "))
|
||||||
|
|
||||||
|
; I hate accommodating old browsers but I'll make an exception because OT support is
|
||||||
|
; critical to most MB projects
|
||||||
|
; if this comes before new-style -moz- declaration, it will work for all.
|
||||||
|
(define feature-tag-string-old-firefox (string-join (map (λ(tag value) (format "'~a=~a'" tag value)) feature-tags feature-values) ", "))
|
||||||
|
|
||||||
|
(define feature-tag-property "font-feature-settings")
|
||||||
|
|
||||||
|
(join-css-strings (append
|
||||||
|
(make-css-strings '("-moz-") feature-tag-property feature-tag-string-old-firefox)
|
||||||
|
(make-css-strings css-property-prefixes feature-tag-property feature-tag-string))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (make-css-hyphens [value "auto"])
|
||||||
|
(join-css-strings (make-css-strings css-property-prefixes "hyphens" value)))
|
||||||
|
|
||||||
|
(define (make-css-small-caps)
|
||||||
|
(join-css-strings (list "text-transform: lowercase" (make-css-ot-features "c2sc"))))
|
||||||
|
|
||||||
|
(define (make-css-caps)
|
||||||
|
(join-css-strings (list "text-transform: uppercase" (make-css-ot-features "case"))))
|
||||||
|
|
||||||
|
(define (make-css-kerning)
|
||||||
|
(join-css-strings (list "text-rendering: optimizeLegibility" (make-css-ot-features "kern"))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (make-css-ligatures)
|
||||||
|
(join-css-strings (list "text-rendering: optimizeLegibility" (make-css-ot-features "liga"))))
|
Loading…
Reference in New Issue