diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..013cb2f --- /dev/null +++ b/.gitignore @@ -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 diff --git a/README.md b/README.md index df23e5f..e675991 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ css-tools -========= +--------- Tools for using Racket as a CSS preprocessor diff --git a/colors.rkt b/colors.rkt new file mode 100644 index 0000000..9092ad5 --- /dev/null +++ b/colors.rkt @@ -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)) \ No newline at end of file diff --git a/column.rkt b/column.rkt new file mode 100644 index 0000000..edecf2a --- /dev/null +++ b/column.rkt @@ -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")))) + + + diff --git a/core.rkt b/core.rkt new file mode 100644 index 0000000..3d5d17a --- /dev/null +++ b/core.rkt @@ -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)) + diff --git a/font-face.rkt b/font-face.rkt new file mode 100644 index 0000000..e1d646b --- /dev/null +++ b/font-face.rkt @@ -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))) \ No newline at end of file diff --git a/gradient.rkt b/gradient.rkt new file mode 100644 index 0000000..00e4d89 --- /dev/null +++ b/gradient.rkt @@ -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"))) \ No newline at end of file diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..53d8e20 --- /dev/null +++ b/info.rkt @@ -0,0 +1,3 @@ +#lang info +(define collection "css-tools") +(define scribblings '(("scribblings/css-tools.scrbl" ()))) \ No newline at end of file diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..0e73f03 --- /dev/null +++ b/main.rkt @@ -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")) + + diff --git a/math.rkt b/math.rkt new file mode 100644 index 0000000..4e7d003 --- /dev/null +++ b/math.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"(?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")) \ No newline at end of file diff --git a/misc.rkt b/misc.rkt new file mode 100644 index 0000000..a32b3e0 --- /dev/null +++ b/misc.rkt @@ -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))) \ No newline at end of file diff --git a/named-colors.rkt b/named-colors.rkt new file mode 100644 index 0000000..177bda7 --- /dev/null +++ b/named-colors.rkt @@ -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"))) \ No newline at end of file diff --git a/scribblings/css-tools.scrbl b/scribblings/css-tools.scrbl new file mode 100644 index 0000000..a9f6561 --- /dev/null +++ b/scribblings/css-tools.scrbl @@ -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. + diff --git a/transition.rkt b/transition.rkt new file mode 100644 index 0000000..fff07c8 --- /dev/null +++ b/transition.rkt @@ -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)))) diff --git a/typography.rkt b/typography.rkt new file mode 100644 index 0000000..7235499 --- /dev/null +++ b/typography.rkt @@ -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")))) \ No newline at end of file