diff --git a/library/css.rkt b/library/css.rkt deleted file mode 100644 index 92dc75f..0000000 --- a/library/css.rkt +++ /dev/null @@ -1,22 +0,0 @@ -#lang racket/base - -; todo: make this hoover up everything in css directory & provide out. - -(require "css/core.rkt" - "css/column.rkt" - "css/font-face.rkt" - "css/gradient.rkt" - "css/misc.rkt" - "css/transition.rkt" - "css/typography.rkt") - - -(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")) - - diff --git a/library/css/column.rkt b/library/css/column.rkt deleted file mode 100644 index edecf2a..0000000 --- a/library/css/column.rkt +++ /dev/null @@ -1,22 +0,0 @@ -#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/library/css/core.rkt b/library/css/core.rkt deleted file mode 100644 index 8dce549..0000000 --- a/library/css/core.rkt +++ /dev/null @@ -1,35 +0,0 @@ -#lang racket/base -(require racket/string racket/list racket/contract) -(require pollen/readability) - -(provide (all-defined-out) - (all-from-out racket/string racket/list racket/contract 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)) - diff --git a/library/css/font-face.rkt b/library/css/font-face.rkt deleted file mode 100644 index 14cfa41..0000000 --- a/library/css/font-face.rkt +++ /dev/null @@ -1,86 +0,0 @@ -#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/library/css/gradient.rkt b/library/css/gradient.rkt deleted file mode 100644 index 00e4d89..0000000 --- a/library/css/gradient.rkt +++ /dev/null @@ -1,44 +0,0 @@ -#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/library/css/math.rkt b/library/css/math.rkt deleted file mode 100644 index 4e7d003..0000000 --- a/library/css/math.rkt +++ /dev/null @@ -1,47 +0,0 @@ -#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/library/css/misc.rkt b/library/css/misc.rkt deleted file mode 100644 index a32b3e0..0000000 --- a/library/css/misc.rkt +++ /dev/null @@ -1,28 +0,0 @@ -#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/library/css/transition.rkt b/library/css/transition.rkt deleted file mode 100644 index fff07c8..0000000 --- a/library/css/transition.rkt +++ /dev/null @@ -1,16 +0,0 @@ -#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/library/css/typography.rkt b/library/css/typography.rkt deleted file mode 100644 index 7235499..0000000 --- a/library/css/typography.rkt +++ /dev/null @@ -1,46 +0,0 @@ -#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 diff --git a/library/decode-tools.rkt b/library/decode-tools.rkt index 18b4a85..936d04b 100644 --- a/library/decode-tools.rkt +++ b/library/decode-tools.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/contract racket/list racket/string racket/match) -(require "../readability.rkt" "../predicates.rkt" "../tools.rkt") +(require sugar "../predicates.rkt" "../tools.rkt") (module+ test (require rackunit))