subdivide css functions
parent
e127cefaac
commit
f353fece69
@ -1,157 +1,22 @@
|
||||
#lang racket/base
|
||||
(require racket/string racket/list)
|
||||
(require (planet mb/pollen/readability))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; CSS Helper functions.
|
||||
; use these either in CSS style block,
|
||||
; or inline style.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; todo: make this hoover up everything in css directory & provide out.
|
||||
|
||||
(define css-property-prefixes '("-moz-" "-webkit-" "-o-" "-ms-" ""))
|
||||
(require "css/core.rkt"
|
||||
"css/column.rkt"
|
||||
"css/font-face.rkt"
|
||||
"css/gradient.rkt"
|
||||
"css/misc.rkt"
|
||||
"css/transition.rkt"
|
||||
"css/typography.rkt")
|
||||
|
||||
(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-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 (join-css-prop-and-value p v)
|
||||
(string-join (list (->string p) (->string v)) ": "))
|
||||
|
||||
(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 join-css-prop-and-value properties values))
|
||||
(provide (all-from-out "css/core.rkt"
|
||||
"css/column.rkt"
|
||||
"css/font-face.rkt"
|
||||
"css/gradient.rkt"
|
||||
"css/misc.rkt"
|
||||
"css/transition.rkt"
|
||||
"css/typography.rkt"))
|
||||
|
||||
(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"))))
|
||||
|
||||
(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))))
|
||||
|
||||
|
||||
(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-background-gradient colors [stops #f] #:radial [radial #f] #:horizontal [horizontal #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 (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)))
|
||||
|
||||
|
||||
(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"))))
|
||||
|
||||
|
||||
|
||||
; 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")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(provide (all-defined-out))
|
||||
@ -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 (planet mb/pollen/readability))
|
||||
|
||||
(provide (all-defined-out)
|
||||
(all-from-out racket/string racket/list racket/contract (planet mb/pollen/readability)))
|
||||
|
||||
(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 (planet mb/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,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,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