From f20dd1b0d08bd99f5b3d5cf516f12ff9e36204b1 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sat, 27 Jan 2018 18:44:45 +1300 Subject: [PATCH] Bundle garden to avoid source conflicts with garden 2.0.0 --- project.clj | 5 +- source-deps.sh | 1 + src/day8/re_frame/trace/common_styles.cljs | 4 +- src/day8/re_frame/trace/styles.cljs | 8 +- src/day8/re_frame/trace/view/container.cljs | 4 +- src/day8/re_frame/trace/view/settings.cljs | 4 +- .../garden/v1v3v3/garden/arithmetic.cljc | 92 ++ .../garden/v1v3v3/garden/color.cljc | 619 ++++++++++ .../garden/v1v3v3/garden/compiler.cljc | 753 ++++++++++++ .../garden/v1v3v3/garden/compression.cljc | 97 ++ .../garden/v1v3v3/garden/core.cljc | 17 + .../garden/v1v3v3/garden/def.clj | 119 ++ .../garden/v1v3v3/garden/media.cljc | 27 + .../garden/v1v3v3/garden/repl.clj | 31 + .../garden/v1v3v3/garden/selectors.cljc | 1057 +++++++++++++++++ .../garden/v1v3v3/garden/stylesheet.cljc | 79 ++ .../garden/v1v3v3/garden/types.cljc | 8 + .../garden/v1v3v3/garden/units.cljc | 327 +++++ .../garden/v1v3v3/garden/util.cljc | 179 +++ 19 files changed, 3419 insertions(+), 12 deletions(-) create mode 100644 src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/color.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/compiler.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/compression.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/core.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/def.clj create mode 100644 src/mranderson047/garden/v1v3v3/garden/media.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/repl.clj create mode 100644 src/mranderson047/garden/v1v3v3/garden/selectors.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/types.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/units.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/util.cljc diff --git a/project.clj b/project.clj index 68718a2..1d11907 100644 --- a/project.clj +++ b/project.clj @@ -7,7 +7,6 @@ [reagent "0.6.0" :scope "provided"] [re-frame "0.10.3" :scope "provided"] [binaryage/devtools "0.9.4"] - [garden "1.3.3"] [cljsjs/react-flip-move "2.9.17-0"]] :plugins [[thomasa/mranderson "0.4.7"] [lein-less "RELEASE"]] @@ -46,4 +45,6 @@ cljsjs/react-dom-server cljsjs/create-react-class org.clojure/tools.logging - net.cgrand/macrovich]]]}}) + net.cgrand/macrovich]] + ^:source-dep [garden "1.3.3" + :exclusions [com.yahoo.platform.yui/yuicompressor]]]}}) diff --git a/source-deps.sh b/source-deps.sh index 8911085..4ea2b97 100755 --- a/source-deps.sh +++ b/source-deps.sh @@ -5,4 +5,5 @@ lein with-profile mranderson source-deps # Then delete the META-INF directories rm -r target/srcdeps/mranderson047/reagent/v0v7v0/META-INF rm -r target/srcdeps/mranderson047/re-frame +rm -r target/srcdeps/mranderson047/garden/v1v3v3/META-INF cp -r target/srcdeps/mranderson047 src diff --git a/src/day8/re_frame/trace/common_styles.cljs b/src/day8/re_frame/trace/common_styles.cljs index 55ff3ae..70134b9 100644 --- a/src/day8/re_frame/trace/common_styles.cljs +++ b/src/day8/re_frame/trace/common_styles.cljs @@ -1,6 +1,6 @@ (ns day8.re-frame.trace.common-styles - (:require [garden.units :refer [px em]] - [garden.compiler :refer [render-css]])) + (:require [mranderson047.garden.v1v3v3.garden.units :refer [px em]] + [mranderson047.garden.v1v3v3.garden.compiler :refer [render-css]])) ;; TODO: Switch these to BM (or just use BM defs if available) diff --git a/src/day8/re_frame/trace/styles.cljs b/src/day8/re_frame/trace/styles.cljs index b083b50..e09a8cd 100644 --- a/src/day8/re_frame/trace/styles.cljs +++ b/src/day8/re_frame/trace/styles.cljs @@ -1,9 +1,9 @@ (ns day8.re-frame.trace.styles (:require-macros [day8.re-frame.trace.utils.macros :as macros]) - (:require [garden.core :as garden] - [garden.units :refer [em px percent]] - [garden.color :as color] - [garden.selectors :as s] + (:require [mranderson047.garden.v1v3v3.garden.core :as garden] + [mranderson047.garden.v1v3v3.garden.units :refer [em px percent]] + [mranderson047.garden.v1v3v3.garden.color :as color] + [mranderson047.garden.v1v3v3.garden.selectors :as s] [day8.re-frame.trace.common-styles :as common] [day8.re-frame.trace.utils.re-com :as rc] [day8.re-frame.trace.view.app-db :as app-db] diff --git a/src/day8/re_frame/trace/view/container.cljs b/src/day8/re_frame/trace/view/container.cljs index 7285c55..45a9137 100644 --- a/src/day8/re_frame/trace/view/container.cljs +++ b/src/day8/re_frame/trace/view/container.cljs @@ -10,8 +10,8 @@ [day8.re-frame.trace.view.timing :as timing] [day8.re-frame.trace.view.debug :as debug] [day8.re-frame.trace.view.settings :as settings] - [garden.core :refer [css style]] - [garden.units :refer [px]] + [mranderson047.garden.v1v3v3.garden.core :refer [css style]] + [mranderson047.garden.v1v3v3.garden.units :refer [px]] [re-frame.trace] [day8.re-frame.trace.utils.re-com :as rc] [day8.re-frame.trace.common-styles :as common])) diff --git a/src/day8/re_frame/trace/view/settings.cljs b/src/day8/re_frame/trace/view/settings.cljs index 51ac35b..0f90efe 100644 --- a/src/day8/re_frame/trace/view/settings.cljs +++ b/src/day8/re_frame/trace/view/settings.cljs @@ -3,8 +3,8 @@ [mranderson047.reagent.v0v7v0.reagent.core :as r] [day8.re-frame.trace.utils.re-com :as rc :refer [css-join]] [day8.re-frame.trace.common-styles :as common] - [garden.units :as units] - [garden.compiler :refer [render-css]])) + [mranderson047.garden.v1v3v3.garden.units :as units] + [mranderson047.garden.v1v3v3.garden.compiler :refer [render-css]])) (def comp-section-width "400px") (def instruction--section-width "190px") diff --git a/src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc b/src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc new file mode 100644 index 0000000..f20e7c7 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc @@ -0,0 +1,92 @@ +(ns mranderson047.garden.v1v3v3.garden.arithmetic + "Generic arithmetic operators for computing sums, differences, + products, and quotients between CSSUnits, CSSColors, and numbers." + (:refer-clojure :exclude [+ - * /]) + (:require [mranderson047.garden.v1v3v3.garden.units :as u :refer [unit?]] + [mranderson047.garden.v1v3v3.garden.color :as c :refer [color?]])) + +;; The motivation for the functions in this namespace is the +;; contention that working with unit arithmetic functions (`px+`, +;; `px-`, etc.) and color arithmetic functions (`color+`, `color-`, +;; etc.) can at times be a bit unweildly. In some cases it would be +;; nice to have functions which could transparently perform unit and +;; color math without the verbosity. + +;; Here, such functions are provided. + +;; All operations favor `CSSUnit` and `CSSColor` types and fall back to +;; the standard `clojure.core` arithmetic functions. The preference for +;; this order stems from the assertion that it is far more likely unit +;; arithmetic will be performed in the context of a stylesheet versus +;; color or numeric. + +(defn + + "Generic addition operator. Transparently computes the sum of + `CSSUnit`s,`CSSColor`s, and numbers." + ([] 0) + ([x] x) + ([x y] + (cond + (unit? x) ((u/make-unit-adder (:unit x)) x y) + (color? x) (c/color+ x y) + :else (if (or (unit? y) (color? y)) + (+ y x) + (clojure.core/+ x y)))) + ([x y & more] + (reduce + (+ x y) more))) + +(defn - + "Generic subtraction operator. Transparently computes the difference + between `CSSUnit`s, `CSSColor`s, and numbers." + ([x] + (cond + (unit? x) (update-in x [:magnitude] clojure.core/-) + ;; Colors shouldn't have negative semantics. + (color? x) x + :else (clojure.core/- x))) + ([x y] + (cond + (unit? x) ((u/make-unit-subtractor (:unit x)) x y) + (color? x) (c/color- x y) + :else (cond + (unit? y) (let [{m :magnitude} y] + (assoc y :magnitude (clojure.core/- x m))) + (color? y) (c/color- x y) + :else (clojure.core/- x y)))) + ([x y & more] + (reduce - (- x y) more))) + +(defn * + "Generic multiplication operation. Transparently computes the product + between `CSSUnit`s, `CSSColor`s, and numbers." + ([] 1) + ([x] x) + ([x y] + (cond + (unit? x) ((u/make-unit-multiplier (:unit x)) x y) + (color? x) (c/color* x y) + :else (if (or (unit? y) (color? y)) + (* y x) + (clojure.core/* x y)))) + ([x y & more] + (reduce * (* x y) more))) + +(defn / + "Generic division operation. Transparently computes the quotient + between `CSSUnit`s, `CSSColor`s, and numbers." + ([x] + (cond + (unit? x) (update-in x [:magnitude] clojure.core//) + (color? x) (c/color-div x) + :else (clojure.core// x))) + ([x y] + (cond + (unit? x) ((u/make-unit-divider (:unit x)) x y) + (color? x) (c/color-div x y) + :else (cond + (unit? y) (let [{m :magnitude} y] + (assoc y :magnitude (clojure.core// x m))) + (color? y) (c/color-div x y) + :else (clojure.core// x y)))) + ([x y & more] + (reduce / (/ x y) more))) diff --git a/src/mranderson047/garden/v1v3v3/garden/color.cljc b/src/mranderson047/garden/v1v3v3/garden/color.cljc new file mode 100644 index 0000000..20a4d78 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/color.cljc @@ -0,0 +1,619 @@ +(ns mranderson047.garden.v1v3v3.garden.color + "Utilities for color creation, conversion, and manipulation." + (:refer-clojure :exclude [complement]) + #?(:cljs + (:require-macros + [mranderson047.garden.v1v3v3.garden.color :refer [defcolor-operation]])) + (:require + [clojure.string :as string] + [mranderson047.garden.v1v3v3.garden.util :as util]) + #?(:clj + (:import clojure.lang.IFn))) + +;; Many of the functions in this namespace were ported or inspired by +;; the implementations included with Sass +;; (http://sass-lang.com/docs/yardoc/Sass/Script/Functions.html). +;; Some additional functions have been added such as `triad` and +;; `tetrad` for generating sets of colors. + +;; Converts a color to a hexadecimal string (implementation below). +(declare as-hex) + +(defrecord CSSColor [red green blue hue saturation lightness alpha] + IFn + #?(:clj + (invoke [this] this)) + #?(:clj + (invoke [this k] + (get this k))) + #?(:clj + (invoke [this k missing] + (get this k missing))) + #?(:cljs + (-invoke [this] this)) + #?(:cljs + (-invoke [this k] + (get this k))) + #?(:cljs + (-invoke [this k missing] + (get this k missing))) + #?(:clj + (applyTo [this args] + (clojure.lang.AFn/applyToHelper this args)))) + +(def as-color map->CSSColor) + +(defn rgb + "Create an RGB color." + ([[r g b :as vs]] + (if (every? #(util/between? % 0 255) vs) + (as-color {:red r :green g :blue b}) + (throw + (ex-info "RGB values must be between 0 and 255" {})))) + ([r g b] + (rgb [r g b]))) + +(defn rgba + "Create an RGBA color." + ([[r g b a]] + (if (util/between? a 0 1) + (as-color (assoc (rgb [r g b]) :alpha a)) + (throw + (ex-info "Alpha value must be between 0 and 1" {})))) + ([r g b a] + (rgba [r g b a]))) + +(defn hsl + "Create an HSL color." + ([[h s l]] + ;; Handle CSSUnits. + (let [[h s l] (map #(get % :magnitude %) [h s l])] + (if (and (util/between? s 0 100) + (util/between? l 0 100)) + (as-color {:hue (mod h 360) :saturation s :lightness l}) + (throw + (ex-info "Saturation and lightness must be between 0(%) and 100(%)" {}))))) + ([h s l] + (hsl [h s l]))) + +(defn hsla + "Create an HSLA color." + ([[h s l a]] + (if (util/between? a 0 1) + (as-color (assoc (hsl [h s l]) :alpha a)) + (throw + (ex-info "Alpha value must be between 0 and 1" {})))) + ([h s l a] + (hsla [h s l a]))) + +(defn rgb? + "Return true if color is an RGB color." + [color] + (and (map? color) + (every? color #{:red :green :blue}))) + +(defn hsl? + "Return true if color is an HSL color." + [color] + (and (map? color) + (every? color #{:hue :saturation :lightness}))) + +(defn color? + "Return true if x is a color." + [x] + (or (rgb? x) (hsl? x))) + +(def ^{:doc "Regular expression for matching a hexadecimal color. + Matches hexadecimal colors of length three or six possibly + lead by a \"#\". The color portion is captured."} + ;; Quantifier must be in this order or JavaScript engines will match + ;; 3 chars even when 6 are provided (failing re-matches). + hex-re #"#?([\da-fA-F]{6}|[\da-fA-F]{3})") + +(defn hex? + "Returns true if x is a hexadecimal color." + [x] + (boolean (and (string? x) (re-matches hex-re x)))) + +(defn hex->rgb + "Convert a hexadecimal color to an RGB color map." + [s] + (when-let [[_ hex] (re-matches hex-re s)] + (let [hex (if (= 3 (count hex)) + (apply str (mapcat #(list % %) hex)) + hex)] + (->> (re-seq #"[\da-fA-F]{2}" hex) + (map #(util/string->int % 16)) + (rgb))))) + +(defn rgb->hex + "Convert an RGB color map to a hexadecimal color." + [{r :red g :green b :blue}] + (letfn [(hex-part [v] + (-> (util/format "%2s" (util/int->string v 16)) + (string/replace " " "0")))] + (apply str "#" (map hex-part [r g b])))) + +(defn trim-one [x] + (if (< 1 x) 1 x)) + +(defn rgb->hsl + "Convert an RGB color map to an HSL color map." + [{:keys [red green blue] :as color}] + (if (hsl? color) + color + (let [[r g b] (map #(/ % 255) [red green blue]) + mx (max r g b) + mn (min r g b) + d (- mx mn) + h (condp = mx + mn 0 + r (* 60 (/ (- g b) d)) + g (+ (* 60 (/ (- b r) d)) 120) + b (+ (* 60 (/ (- r g) d)) 240)) + l (trim-one (/ (+ mx mn) 2)) + s (trim-one + (cond + (= mx mn) 0 + (< l 0.5) (/ d (* 2 l)) + :else (/ d (- 2 (* 2 l)))))] + (hsl (mod h 360) (* 100 s) (* 100 l))))) + +(declare hue->rgb) + +;; SEE: http://www.w3.org/TR/css3-color/#hsl-color. +(defn hsl->rgb + "Convert an HSL color map to an RGB color map." + [{:keys [hue saturation lightness] :as color}] + (if (rgb? color) + color + (let [h (/ hue 360.0) + s (/ saturation 100.0) + l (/ lightness 100.0) + m2 (if (<= l 0.5) + (* l (inc s)) + (- (+ l s) (* l s))) + m1 (- (* 2 l) m2) + [r g b] (map #(Math/round (* % 0xff)) + [(hue->rgb m1 m2 (+ h (/ 1.0 3))) + (hue->rgb m1 m2 h) + (hue->rgb m1 m2 (- h (/ 1.0 3)))])] + (rgb [r g b])))) + +(defn- hue->rgb + [m1 m2 h] + (let [h (cond + (< h 0) (inc h) + (> h 1) (dec h) + :else h)] + (cond + (< (* 6 h) 1) (+ m1 (* (- m2 m1) h 6)) + (< (* 2 h) 1) m2 + (< (* 3 h) 2) (+ m1 (* (- m2 m1) (- (/ 2.0 3) h) 6)) + :else m1))) + +(defn hsl->hex + "Convert an HSL color map to a hexadecimal string." + [color] + (-> color hsl->rgb rgb->hex)) + +(defn hex->hsl + "Convert a hexadecimal color to an HSL color." + [color] + (-> color hex->rgb rgb->hsl)) + +(def percent-clip + (partial util/clip 0 100)) + +(def rgb-clip + (partial util/clip 0 255)) + +(defn as-hex + "Convert a color to a hexadecimal string." + [x] + (cond + (hex? x) x + (rgb? x) (rgb->hex x) + (hsl? x) (hsl->hex x) + :else (throw (ex-info (str "Can't convert " x " to a color.") {})))) + +(defn as-rgb + "Convert a color to a RGB." + [x] + (cond + (rgb? x) x + (hsl? x) (hsl->rgb x) + (hex? x) (hex->rgb x) + (number? x) (rgb (map rgb-clip [x x x])) + :else (throw (ex-info (str "Can't convert " x " to a color.") {})))) + +(defn as-hsl + "Convert a color to a HSL." + [x] + (cond + (hsl? x) x + (rgb? x) (rgb->hsl x) + (hex? x) (hex->hsl x) + (number? x) (hsl [x (percent-clip x) (percent-clip x)]) + :else (throw (ex-info (str "Can't convert " x " to a color.") {})))) + +(defn- restrict-rgb + [m] + (select-keys m [:red :green :blue])) + +(defn- make-color-operation + [op] + (fn color-op + ([a] a) + ([a b] + (let [o (comp rgb-clip op) + a (restrict-rgb (as-rgb a)) + b (restrict-rgb (as-rgb b))] + (as-color (merge-with o a b)))) + ([a b & more] + (reduce color-op (color-op a b) more)))) + +#?(:clj + (defmacro ^:private defcolor-operation [name operator] + `(def ~name (make-color-operation ~operator)))) + +(defcolor-operation + ^{:doc "Add the RGB components of two or more colors." + :arglists '([a] [a b] [a b & more])} + color+ +) + +(defcolor-operation + ^{:doc "Subtract the RGB components of two or more colors." + :arglists '([a] [a b] [a b & more])} + color- -) + +(defcolor-operation + ^{:doc "Multiply the RGB components of two or more colors." + :arglists '([a] [a b] [a b & more])} + color* *) + +(defcolor-operation + ^{:doc "Multiply the RGB components of two or more colors." + :arglists '([a] [a b] [a b & more])} + color-div /) + +(defn- update-color [color field f v] + (let [v (or (:magnitude v) v)] + (update-in (as-hsl color) [field] f v))) + +(defn rotate-hue + "Rotates the hue value of a given color by amount." + [color amount] + (update-color color :hue (comp #(mod % 360) +) amount)) + +(defn saturate + "Increase the saturation value of a given color by amount." + [color amount] + (update-color color :saturation (comp percent-clip +) amount)) + +(defn desaturate + "Decrease the saturation value of a given color by amount." + [color amount] + (update-color color :saturation (comp percent-clip -) amount)) + +(defn lighten + "Increase the lightness value a given color by amount." + [color amount] + (update-color color :lightness (comp percent-clip +) amount)) + +(defn darken + "Decrease the lightness value a given color by amount." + [color amount] + (update-color color :lightness (comp percent-clip -) amount)) + +(defn invert + "Return the inversion of a color." + [color] + (as-color (merge-with - {:red 255 :green 255 :blue 255} (as-rgb color)))) + +(defn mix + "Mix two or more colors by averaging their RGB channels." + ([color-1 color-2] + (let [c1 (restrict-rgb (as-rgb color-1)) + c2 (restrict-rgb (as-rgb color-2))] + (as-color (merge-with util/average c1 c2)))) + ([color-1 color-2 & more] + (reduce mix (mix color-1 color-2) more))) + +;;;; Color wheel functions. + +(defn complement + "Return the complement of a color." + [color] + (rotate-hue color 180)) + +(defn- hue-rotations + ([color & amounts] + (map (partial rotate-hue color) amounts))) + +(defn analogous + "Given a color return a triple of colors which are 0, 30, and 60 + degrees clockwise from it. If a second falsy argument is passed the + returned values will be in a counter-clockwise direction." + ([color] + (analogous color true)) + ([color clockwise?] + (let [sign (if clockwise? + -)] + (hue-rotations color 0 (sign 30) (sign 60))))) + +(defn triad + "Given a color return a triple of colors which are equidistance apart + on the color wheel." + [color] + (hue-rotations color 0 120 240)) + +(defn split-complement + "Given a color return a triple of the color and the two colors on + either side of it's complement." + ([color] + (split-complement color 130)) + ([color distance-from-complement] + (let [d (util/clip 1 179 distance-from-complement)] + (hue-rotations color 0 d (- d))))) + +(defn tetrad + "Given a color return a quadruple of four colors which are + equidistance on the color wheel (ie. a pair of complements). An + optional angle may be given for color of the second complement in the + pair (this defaults to 90 when only color is passed)." + ([color] + (tetrad color 90)) + ([color angle] + (let [a (util/clip 1 90 (Math/abs (:magnitude angle angle))) + color-2 (rotate-hue color a)] + [(rotate-hue color 0) + (complement color) + color-2 + (complement color-2)]))) + +(defn shades + "Given a color return a list of shades from lightest to darkest by + a step. By default the step is 10. White and black are excluded from + the returned list." + ([color] + (shades color 10)) + ([color step] + (let [c (as-hsl color)] + (for [i (range 1 (Math/floor (/ 100.0 step)))] + (assoc c :lightness (* i step)))))) + +;; --------------------------------------------------------------------- +;; CSS color name conversion + +(def color-name->hex + {:aquamarine "#7fffd4" + :aliceblue "#f0f8ff" + :antiquewhite "#faebd7" + :aqua "#00ffff" + :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" + :darkgrey "#a9a9a9" + :darkkhaki "#bdb76b" + :darkmagenta "#8b008b" + :darkolivegreen "#556b2f" + :darkorange "#ff8c00" + :darkorchid "#9932cc" + :darkred "#8b0000" + :darksalmon "#e9967a" + :darkseagreen "#8fbc8f" + :darkslateblue "#483d8b" + :darkslategray "#2f4f4f" + :darkslategrey "#2f4f4f" + :darkturquoise "#00ced1" + :darkviolet "#9400d3" + :deeppink "#ff1493" + :deepskyblue "#00bfff" + :dimgray "#696969" + :dimgrey "#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" + :lightgrey "#d3d3d3" + :lightpink "#ffb6c1" + :lightsalmon "#ffa07a" + :lightseagreen "#20b2aa" + :lightskyblue "#87cefa" + :lightslategray "#778899" + :lightslategrey "#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" + :slategrey "#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"}) + +(defn- ex-info-color-name + "Helper function for from-name. Returns an instance of ExceptionInfo + for unknown colors." + [n] + (ex-info + (str "Unknown color " (pr-str n) " see (:expected (ex-data e)) for a list of color names") + {:given n + :expected (set (keys color-name->hex))})) + +(def + ^{:private true + :doc "Helper function for from-name."} + color-name->color + (memoize (fn [k] (color-name->hex k)))) + +(defn from-name + "Given a CSS color name n return an instance of CSSColor." + [n] + (if-let [h (color-name->color (keyword n))] + h + (throw (ex-info-color-name n)))) + +(defn- scale-color-value + [value amount] + (+ value (if (pos? amount) + (* (- 100 value) (/ amount 100)) + (/ (* value amount) 100)))) + +(defn scale-lightness + "Scale the lightness of a color by amount" + [color amount] + (update-color color :lightness scale-color-value amount)) + +(defn scale-saturation + "Scale the saturation of a color by amount" + [color amount] + (update-color color :saturation scale-color-value amount)) + +(defn- decrown-hex [hex] + (string/replace hex #"^#" "")) + +(defn- crown-hex [hex] + (if (re-find #"^#" hex) + hex + (str "#" hex))) + +(defn- expand-hex + "(expand-hex \"#abc\") -> \"aabbcc\" + (expand-hex \"333333\") -> \"333333\"" + [hex] + (as-> (decrown-hex hex) _ + (cond + (= 3 (count _)) (string/join (mapcat vector _ _)) + (= 1 (count _)) (string/join (repeat 6 _)) + :else _))) + +(defn- hex->long + "(hex->long \"#abc\") -> 11189196" + [hex] + (-> hex + (string/replace #"^#" "") + (expand-hex) + #?(:clj (Long/parseLong 16) + :cljs (js/parseInt 16)))) + +(defn- long->hex + "(long->hex 11189196) -> \"aabbcc\"" + [long] + #?(:clj (Integer/toHexString long) + :cljs (.toString long 16))) + +(defn weighted-mix + "`weight` is number 0 to 100 (%). + At 0, it weighs color-1 at 100%. + At 100, it weighs color-2 at 100%. + Returns hex string." + [color-1 color-2 weight] + (let [[weight-1 weight-2] (map #(/ % 100) [(- 100 weight) weight]) + [long-1 long-2] (map (comp hex->long as-hex) + [color-1 color-2])] + (-> (+ (* long-1 weight-1) (* long-2 weight-2)) + (long->hex) + (expand-hex) + (crown-hex)))) diff --git a/src/mranderson047/garden/v1v3v3/garden/compiler.cljc b/src/mranderson047/garden/v1v3v3/garden/compiler.cljc new file mode 100644 index 0000000..fbab912 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/compiler.cljc @@ -0,0 +1,753 @@ +(ns mranderson047.garden.v1v3v3.garden.compiler + "Functions for compiling Clojure data structures to CSS." + (:require + [clojure.string :as string] + #?(:clj [mranderson047.garden.v1v3v3.garden.color :as color] + :cljs [mranderson047.garden.v1v3v3.garden.color :as color :refer [CSSColor]]) + [mranderson047.garden.v1v3v3.garden.compression :as compression] + [mranderson047.garden.v1v3v3.garden.selectors :as selectors] + [mranderson047.garden.v1v3v3.garden.units :as units] + [mranderson047.garden.v1v3v3.garden.util :as util] + #?(:cljs + [mranderson047.garden.v1v3v3.garden.types :refer [CSSUnit CSSFunction CSSAtRule]])) + #?(:cljs + (:require-macros + [mranderson047.garden.v1v3v3.garden.compiler :refer [with-media-query-context with-selector-context]])) + #?(:clj + (:import (mranderson047.garden.v1v3v3.garden.types CSSUnit CSSFunction CSSAtRule) + (mranderson047.garden.v1v3v3.garden.color CSSColor)))) + +;; --------------------------------------------------------------------- +;; Compiler flags + +(def + ^{:dynamic true + :private true + :doc "The current compiler flags."} + *flags* + {;; When set to `true` the compiled stylesheet will be "pretty + ;; printed." This would be equivalent to setting + ;; `{:ouput-style => :expanded}` in Sass. When set to `false` + ;; the compiled stylesheet will be compressed with the YUI + ;; compressor. + :pretty-print? true + ;; A sequence of files to prepend to the output file. + :preamble [] + ;; Location to save a stylesheet after compiling. + :output-to nil + ;; A list of vendor prefixes to prepend to things like + ;; `@keyframes`, properties within declarations containing the + ;; `^:prefix` meta data, and properties defined in `:auto-prefix`. + :vendors [] + ;; A set of properties to automatically prefix with `:vendors`. + :auto-prefix #{} + ;; `@media-query` specific configuration. + :media-expressions {;; May either be `:merge` or `:default`. When + ;; set to `:merge` nested media queries will + ;; have their expressions merged with their + ;; parent's. + :nesting-behavior :default}}) + +(def + ^{:private true + :doc "Retun a function to call when rendering a media expression. + The returned function accepts two arguments: the media + expression being evaluated and the current media expression context. + Both arguments are maps. This is used to provide semantics for nested + media queries."} + media-expression-behavior + {:merge (fn [expr context] (merge context expr)) + :default (fn [expr _] expr)}) + +(def + ^{:dynamic true + :private true + :doc "The current parent selector context."} + *selector-context* nil) + +(def + ^{:dynamic true + :private true + :doc "The current media query context."} + *media-query-context* nil) + +;; --------------------------------------------------------------------- +;; Utilities + +(defmacro with-selector-context + [selector-context & body] + `(binding [*selector-context* ~selector-context] + (do ~@body))) + +(defmacro with-media-query-context + [selector-context & body] + `(binding [*media-query-context* ~selector-context] + (do ~@body))) + +(defn- vendors + "Return the current list of browser vendors specified in `*flags*`." + [] + (seq (:vendors *flags*))) + +(defn- auto-prefixed-properties + "Return the current list of auto-prefixed properties specified in `*flags*`." + [] + (set (map name (:auto-prefix *flags*)))) + +(defn- auto-prefix? + [property] + (contains? (auto-prefixed-properties) property)) + +(defn- top-level-expression? [x] + (or (util/rule? x) + (util/at-import? x) + (util/at-media? x) + (util/at-keyframes? x))) + +(defn- divide-vec + "Return a vector of [(filter pred coll) (remove pred coll)]." + [pred coll] + ((juxt filter remove) pred coll)) + +#?(:clj + (defn- save-stylesheet + "Save a stylesheet to disk." + [path stylesheet] + (spit path stylesheet))) + +;; ===================================================================== +;; Expansion + +;; The expansion process ensures that before a stylesheet is rendered +;; it is in a format that can be easily digested. That is, it produces +;; a new data structure which is a list of only one level. + +;; This intermediate process between input and compilation separates +;; concerns between parsing data structures and compiling them to CSS. + +;; All data types that implement `IExpandable` should produce a list. + +(defprotocol IExpandable + (expand [this] + "Return a list containing the expanded form of `this`.")) + +;; --------------------------------------------------------------------- +;; List expansion + +(defn- expand-seqs + "Like flatten but only affects seqs." + [coll] + (mapcat + (fn [x] + (if (seq? x) + (expand-seqs x) + (list x))) + coll)) + +;; --------------------------------------------------------------------- +;; Declaration expansion + +(defn expand-declaration-1 + [declaration] + {:pre [(map? declaration)]} + (let [prefix #(util/as-str %1 "-" %2)] + (reduce + (fn [m [k v]] + (if (util/hash-map? v) + (reduce + (fn [m1 [k1 v1]] + (assoc m1 (prefix k k1) v1)) + m + (expand-declaration-1 v)) + (assoc m (util/to-str k) v))) + (empty declaration) + declaration))) + +(defn- expand-declaration + [declaration] + (if (empty? declaration) + declaration + (with-meta (expand-declaration-1 declaration) (meta declaration)))) + +;; --------------------------------------------------------------------- +;; Rule expansion + +(def + ^{:private true + :doc "Matches a single \"&\" or \"&\" follow by one or more + non-whitespace characters."} + parent-selector-re + #"^&(?:\S+)?$") + +(defn- extract-reference + "Extract the selector portion of a parent selector reference." + [selector] + (when-let [reference (->> (last selector) + (util/to-str) + (re-find parent-selector-re))] + (apply str (rest reference)))) + +(defn- expand-selector-reference + [selector] + (if-let [reference (extract-reference selector)] + (let [parent (butlast selector)] + (concat (butlast parent) + (-> (last parent) + (util/as-str reference) + (list)))) + selector)) + +(defn- expand-selector [selector parent] + (let [selector (map selectors/css-selector selector) + selector (if (seq parent) + (->> (util/cartesian-product parent selector) + (map flatten)) + (map list selector))] + (map expand-selector-reference selector))) + +(defn- expand-rule + [rule] + (let [[selector children] (split-with selectors/selector? rule) + selector (expand-selector selector *selector-context*) + children (expand children) + [declarations xs] (divide-vec util/declaration? children) + ys (with-selector-context + (if (seq selector) + selector + *selector-context*) + (doall (mapcat expand xs)))] + (->> (mapcat expand declarations) + (conj [selector]) + (conj ys)))) + +;; --------------------------------------------------------------------- +;; At-rule expansion + +(defmulti ^:private expand-at-rule :identifier) + +(defmethod expand-at-rule :default + [at-rule] + (list at-rule)) + +;; @keyframes expansion + +(defmethod expand-at-rule :keyframes + [{:keys [value]}] + (let [{:keys [identifier frames]} value] + (->> {:identifier (util/to-str identifier) + :frames (mapcat expand frames)} + (CSSAtRule. :keyframes) + (list)))) + +;; @media expansion + +(defn- expand-media-query-expression [expression] + (if-let [f (->> [:media-expressions :nesting-behavior] + (get-in *flags*) + (media-expression-behavior))] + (f expression *media-query-context*) + expression)) + +(defmethod expand-at-rule :media + [{:keys [value]}] + (let [{:keys [media-queries rules]} value + media-queries (expand-media-query-expression media-queries) + xs (with-media-query-context media-queries (doall (mapcat expand (expand rules)))) + ;; Though media-queries may be nested, they may not be nested + ;; at compile time. Here we make sure this is the case. + [subqueries rules] (divide-vec util/at-media? xs)] + (cons + (CSSAtRule. :media {:media-queries media-queries + :rules rules}) + subqueries))) + +;; --------------------------------------------------------------------- +;; Stylesheet expansion + +(defn- expand-stylesheet [xs] + (->> (expand xs) + (map expand) + (apply concat))) + +(extend-protocol IExpandable + + #?(:clj clojure.lang.ISeq + :cljs IndexedSeq) + (expand [this] (expand-seqs this)) + + #?(:cljs LazySeq) + #?(:cljs (expand [this] (expand-seqs this))) + + #?(:cljs RSeq) + #?(:cljs(expand [this] (expand-seqs this))) + + #?(:cljs NodeSeq) + #?(:cljs (expand [this] (expand-seqs this))) + + #?(:cljs ArrayNodeSeq) + #?(:cljs (expand [this] (expand-seqs this))) + + #?(:cljs Cons) + #?(:cljs ( + expand [this] (expand-seqs this))) + + #?(:cljs ChunkedCons) + #?(:cljs (expand [this] (expand-seqs this))) + + #?(:cljs ChunkedSeq) + (expand [this] (expand-seqs this)) + + #?(:cljs PersistentArrayMapSeq) + #?(:cljs (expand [this] (expand-seqs this))) + + #?(:cljs List) + #?(:cljs (expand [this] (expand-seqs this))) + + #?(:clj clojure.lang.IPersistentVector + :cljs PersistentVector) + (expand [this] (expand-rule this)) + + #?(:cljs Subvec) + #?(:cljs (expand [this] (expand-rule this))) + + #?(:cljs BlackNode) + #?(:cljs (expand [this] (expand-rule this))) + + #?(:cljs RedNode) + #?(:cljs (expand [this] (expand-rule this))) + + #?(:clj clojure.lang.IPersistentMap + :cljs PersistentArrayMap) + (expand [this] (list (expand-declaration this))) + + #?(:cljs PersistentHashMap) + #?(:cljs (expand [this] (list (expand-declaration this)))) + + #?(:cljs PersistentTreeMap) + #?(:cljs (expand [this] (list (expand-declaration this)))) + + #?(:clj Object + :cljs default) + (expand [this] (list this)) + + CSSFunction + (expand [this] (list this)) + + CSSAtRule + (expand [this] (expand-at-rule this)) + + CSSColor + (expand [this] (list this)) + + nil + (expand [this] nil)) + +;; --------------------------------------------------------------------- +;; Rendering + +(defprotocol CSSRenderer + (render-css [this] + "Convert a Clojure data type in to a string of CSS.")) + +;; --------------------------------------------------------------------- +;; Punctuation + +(def ^:private comma ", ") +(def ^:private colon ": ") +(def ^:private semicolon ";") +(def ^:private l-brace " {\n") +(def ^:private r-brace "\n}") +(def ^:private l-brace-1 " {\n\n") +(def ^:private r-brace-1 "\n\n}") +(def ^:private rule-sep "\n\n") +(def ^:private indent " ") + +(defn- space-separated-list + "Return a space separated list of values." + ([xs] + (space-separated-list render-css xs)) + ([f xs] + (string/join " " (map f xs)))) + +(defn- comma-separated-list + "Return a comma separated list of values. Subsequences are joined with + spaces." + ([xs] + (comma-separated-list render-css xs)) + ([f xs] + (let [ys (for [x xs] + (if (sequential? x) + (space-separated-list f x) + (f x)))] + (string/join comma ys)))) + +(defn- rule-join [xs] + (string/join rule-sep xs)) + +(def + ^{:private true + :doc "Match the start of a line if the characters immediately + after it are spaces or used in a CSS id (#), class (.), or tag name."} + indent-loc-re + #?(:clj + #"(?m)(?=[\sA-z#.}-]+)^") + #?(:cljs + (js/RegExp. "(?=[ A-Za-z#.}-]+)^" "gm"))) + +(defn- indent-str [s] + #?(:clj + (string/replace s indent-loc-re indent)) + #?(:cljs + (.replace s indent-loc-re indent))) + +;; --------------------------------------------------------------------- +;; Declaration rendering + +(defn- render-value + "Render the value portion of a declaration." + [x] + (if (util/at-keyframes? x) + (util/to-str (get-in x [:value :identifier])) + (render-css x))) + +(defn- render-property-and-value + [[prop val]] + (if (set? val) + (->> (interleave (repeat prop) val) + (partition 2) + (map render-property-and-value) + (string/join "\n")) + (let [val (if (sequential? val) + (comma-separated-list render-value val) + (render-value val))] + (util/as-str prop colon val semicolon)))) + +(defn- add-blocks + "For each block in `declaration`, add sequence of blocks + returned from calling `f` on the block." + [f declaration] + (mapcat #(cons % (f %)) declaration)) + +(defn- prefixed-blocks + "Sequence of blocks with their properties prefixed by + each vendor in `vendors`." + [vendors [p v]] + (for [vendor vendors] + [(util/vendor-prefix vendor (name p)) v])) + +(defn- prefix-all-properties + "Add prefixes to all blocks in `declaration` using + vendor prefixes in `vendors`." + [vendors declaration] + (add-blocks (partial prefixed-blocks vendors) declaration)) + +(defn- prefix-auto-properties + "Add prefixes to all blocks in `declaration` when property + is in the `:auto-prefix` set." + [vendors declaration] + (add-blocks + (fn [block] + (let [[p _] block] + (when (auto-prefix? (name p)) + (prefixed-blocks vendors block)))) + declaration)) + +(defn- prefix-declaration + "Prefix properties within a `declaration` if `{:prefix true}` is + set in its meta, or if a property is in the `:auto-prefix` set." + [declaration] + (let [vendors (or (:vendors (meta declaration)) (vendors)) + prefix-fn (if (:prefix (meta declaration)) + prefix-all-properties + prefix-auto-properties)] + (prefix-fn vendors declaration))) + +(defn- render-declaration + [declaration] + (->> (prefix-declaration declaration) + (map render-property-and-value) + (string/join "\n"))) + +;; --------------------------------------------------------------------- +;; Rule rendering + +(defn- render-selector + [selector] + (comma-separated-list selector)) + +(defn- render-rule + "Convert a vector to a CSS rule string. The vector is expected to be + fully expanded." + [[selector declarations :as rule]] + (when (and (seq rule) (every? seq rule)) + (str (render-selector selector) + l-brace + (->> (map render-css declarations) + (string/join "\n") + (indent-str)) + r-brace))) + +;; --------------------------------------------------------------------- +;; Media query rendering + +(defn- render-media-expr-part + "Render the individual components of a media expression." + [[k v]] + (let [[sk sv] (map render-value [k v])] + (cond + (true? v) sk + (false? v) (str "not " sk) + (= "only" sv) (str "only " sk) + :else (if (and v (seq sv)) + (str "(" sk colon sv ")") + (str "(" sk ")"))))) + +(defn- render-media-expr + "Make a media query expession from one or more maps. Keys are not + validated but values have the following semantics: + + `true` as in `{:screen true}` == \"screen\" + `false` as in `{:screen false}` == \"not screen\" + `:only` as in `{:screen :only} == \"only screen\"" + [expr] + (if (sequential? expr) + (->> (map render-media-expr expr) + (comma-separated-list)) + (->> (map render-media-expr-part expr) + (string/join " and ")))) + +;; --------------------------------------------------------------------- +;; Garden type rendering + +(defn- render-unit + "Render a CSSUnit." + [css-unit] + (let [{:keys [magnitude unit]} css-unit + magnitude #?(:cljs magnitude) + #?(:clj (if (ratio? magnitude) + (float magnitude) + magnitude))] + (str magnitude (name unit)))) + +(defn- render-function + "Render a CSS function." + [css-function] + (let [{:keys [function args]} css-function + args (if (sequential? args) + (comma-separated-list args) + (util/to-str args))] + (util/format "%s(%s)" (util/to-str function) args))) + +(defn ^:private render-color [c] + (if-let [a (:alpha c)] + (let [{:keys [hue saturation lightness]} (color/as-hsl c) + [s l] (map units/percent [saturation lightness])] + (util/format "hsla(%s)" (comma-separated-list [hue s l a]))) + (color/as-hex c))) + +;; --------------------------------------------------------------------- +;; At-rule rendering + +(defmulti ^:private render-at-rule + "Render a CSS at-rule" + :identifier) + +(defmethod render-at-rule :default [_] nil) + +;; @import + +(defmethod render-at-rule :import + [{:keys [value]}] + (let [{:keys [url media-queries]} value + url (if (string? url) + (util/wrap-quotes url) + (render-css url)) + queries (when media-queries + (render-media-expr media-queries))] + (str "@import " + (if queries (str url " " queries) url) + semicolon))) + +;; @keyframes + +(defmethod render-at-rule :keyframes + [{:keys [value]}] + (let [{:keys [identifier frames]} value] + (when (seq frames) + (let [body (str (util/to-str identifier) + l-brace-1 + (->> (map render-css frames) + (rule-join) + (indent-str)) + r-brace-1) + prefix (fn [vendor] + (str "@" (util/vendor-prefix vendor "keyframes ")))] + (->> (map prefix (vendors)) + (cons "@keyframes ") + (map #(str % body)) + (rule-join)))))) + +;; @media + +(defmethod render-at-rule :media + [{:keys [value]}] + (let [{:keys [media-queries rules]} value] + (when (seq rules) + (str "@media " + (render-media-expr media-queries) + l-brace-1 + (-> (map render-css rules) + (rule-join) + (indent-str)) + r-brace-1)))) + + +;; --------------------------------------------------------------------- +;; CSSRenderer implementation + +(extend-protocol CSSRenderer + #?(:clj clojure.lang.ISeq + :cljs IndexedSeq) + (render-css [this] (map render-css this)) + + #?(:cljs LazySeq) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs RSeq) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs NodeSeq) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs ArrayNodeSeq) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs Cons) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs ChunkedCons) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs ChunkedSeq) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs PersistentArrayMapSeq) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:cljs List) + #?(:cljs (render-css [this] (map render-css this))) + + #?(:clj clojure.lang.IPersistentVector + :cljs PersistentVector) + (render-css [this] (render-rule this)) + + #?(:cljs Subvec) + #?(:cljs (render-css [this] (render-rule this))) + + #?(:cljs BlackNode) + #?(:cljs (render-css [this] (render-rule this))) + + #?(:cljs RedNode) + #?(:cljs (render-css [this] (render-rule this))) + + #?(:clj clojure.lang.IPersistentMap + :cljs PersistentArrayMap) + (render-css [this] (render-declaration this)) + + #?(:cljs PersistentHashMap) + #?(:cljs (render-css [this] (render-declaration this))) + + #?(:cljs PersistentTreeMap) + #?(:cljs (render-css [this] (render-declaration this))) + + #?(:clj clojure.lang.Ratio) + #?(:clj (render-css [this] (str (float this)))) + + #?(:cljs number) + #?(:cljs (render-css [this] (str this))) + + #?(:clj clojure.lang.Keyword + :cljs Keyword) + (render-css [this] (name this)) + + CSSUnit + (render-css [this] (render-unit this)) + + CSSFunction + (render-css [this] (render-function this)) + + CSSAtRule + (render-css [this] (render-at-rule this)) + + #?(:clj CSSColor + :cljs color/CSSColor) + (render-css [this] (render-color this)) + + #?(:clj Object + :cljs default) + (render-css [this] (str this)) + + nil + (render-css [this] "")) + + +;; --------------------------------------------------------------------- +;; Compilation + +(defn compile-style + "Convert a sequence of maps into CSS for use with the HTML style + attribute." + [ms] + (->> (filter util/declaration? ms) + (reduce merge) + (expand) + (render-css) + (first))) + +(defn- do-compile + "Return a string of CSS." + [flags rules] + (binding [*flags* flags] + (->> (expand-stylesheet rules) + (filter top-level-expression?) + (map render-css) + (remove nil?) + (rule-join)))) + +(defn- do-preamble + "Prefix stylesheet with files in preamble. Not available in + ClojureScript." + [{:keys [preamble]} stylesheet] + #?(:clj + (string/join "\n" (conj (mapv slurp preamble) stylesheet))) + #?(:cljs + stylesheet)) + +(defn- do-compression + "Compress CSS if the pretty-print(?) flag is true." + [{:keys [pretty-print? pretty-print]} stylesheet] + ;; Also accept pretty-print like CLJS. + (if (or pretty-print? pretty-print) + stylesheet + (compression/compress-stylesheet stylesheet))) + +(defn- do-output-to + "Write contents of stylesheet to disk." + [{:keys [output-to]} stylesheet] + #?(:clj + (when output-to + (save-stylesheet output-to stylesheet) + (println "Wrote:" output-to))) + stylesheet) + +(defn compile-css + "Convert any number of Clojure data structures to CSS." + [flags & rules] + (let [[flags rules] (if (and (util/hash-map? flags) + (some (set (keys flags)) (keys *flags*))) + [(merge *flags* flags) rules] + [*flags* (cons flags rules)])] + (->> (do-compile flags rules) + (do-preamble flags) + (do-compression flags) + (do-output-to flags)))) diff --git a/src/mranderson047/garden/v1v3v3/garden/compression.cljc b/src/mranderson047/garden/v1v3v3/garden/compression.cljc new file mode 100644 index 0000000..df6bf39 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/compression.cljc @@ -0,0 +1,97 @@ +(ns mranderson047.garden.v1v3v3.garden.compression + "Stylesheet compression utilities." + #?(:clj + (:import (java.io StringReader StringWriter) + (com.yahoo.platform.yui.compressor CssCompressor)))) + +;; --------------------------------------------------------------------- +;; Clojure + +;; Clojure stylesheet compression leverages the YUI Compressor as it +;; provides a performant and excellent solution to CSS compression. + +#?(:clj + (defn compress-stylesheet + "Compress a stylesheet with the YUI CSSCompressor. Set + line-break-position to -1 for no line breaks, 0 for a line break + after each rule, and n > 0 for a line break after at most n + columns. Defaults to no -1" + ([stylesheet] + (compress-stylesheet stylesheet -1)) + ([^String stylesheet line-break-position] + (with-open [reader (StringReader. stylesheet) + writer (StringWriter.)] + (doto (CssCompressor. reader) + (.compress writer line-break-position)) + (str writer))))) + +;; --------------------------------------------------------------------- +;; ClojureScript + +;; ClojureScript stylesheet compression uses a simple tokenizer and +;; loop/recur to construct a new string of minified CSS. + +#?(:cljs + (defn- token-fn + "Return a function which when given a string will return a map + containing the chunk of text matched by re, it's size, and tag." + [[tag re]] + (fn [s] + (when-let [chunk (re-find re s)] + {:tag tag + :chunk chunk + :size (count chunk)})))) + +#?(:cljs + (defn- tokenizer + "Given an arbitrary number of [tag regex] pairs, return a function + which when given a string s will return the first matching token of s. + Token precedence is determined by the order of the pairs. The first + and last pairs have the highest and lowest precedence respectively." + [& tags+regexes] + (let [fs (map token-fn tags+regexes)] + (fn [s] + (some #(% s) fs))))) + +#?(:cljs + (def + ^{:private true + :doc "Tokenizer used during stylesheet compression."} + stylesheet-tokenizer + (tokenizer + ;; String literals + [:string #"^\"(?:\\.|[^\"])*\""] + ;; Delimiters + [:r-brace #"^\s*\{\s*"] + [:l-brace #"^;?\s*}"] + [:r-paren #"^\s*\(\s*"] + [:l-paren #"^\s*\)"] + [:comma #"^,\s*"] + [:colon #"^:\s*"] + [:semicolon #"^;"] + ;; White space + [:space+ #"^ +"] + [:white-space+ #"^\s+"] + ;; Everything else + [:any #"^."]))) + +#?(:cljs + (defn compress-stylesheet + "Compress a string of CSS using a basic compressor." + [stylesheet] + (loop [s1 stylesheet s2 ""] + (if-let [{:keys [tag chunk size]} (stylesheet-tokenizer s1)] + (recur (subs s1 size) + (str s2 (case tag + :string chunk + :r-brace "{" + :l-brace "}" + :r-paren "(" + :l-paren ")" + :comma "," + :semi-comma ";" + :colon ":" + :space+ " " + :white-space+ "" + chunk))) + s2)))) diff --git a/src/mranderson047/garden/v1v3v3/garden/core.cljc b/src/mranderson047/garden/v1v3v3/garden/core.cljc new file mode 100644 index 0000000..c8c582d --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/core.cljc @@ -0,0 +1,17 @@ +(ns mranderson047.garden.v1v3v3.garden.core + "Convert Clojure data structures to CSS." + (:require [mranderson047.garden.v1v3v3.garden.compiler :as compiler])) + +(defn ^String css + "Convert a variable number of Clojure data structure to a string of + CSS. The first argument may be a list of flags for the compiler." + {:arglists '([rules] [flags? rules])} + [& rules] + (apply compiler/compile-css rules)) + +(defn ^String style + "Convert a variable number of maps into a string of CSS for use with + the HTML `style` attribute." + [& maps] + (compiler/compile-style maps)) + diff --git a/src/mranderson047/garden/v1v3v3/garden/def.clj b/src/mranderson047/garden/v1v3v3/garden/def.clj new file mode 100644 index 0000000..9d83e6d --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/def.clj @@ -0,0 +1,119 @@ +(ns mranderson047.garden.v1v3v3.garden.def + (:require [mranderson047.garden.v1v3v3.garden.types] + [mranderson047.garden.v1v3v3.garden.util :as util] + [mranderson047.garden.v1v3v3.garden.core]) + (:import garden.types.CSSFunction + garden.types.CSSAtRule)) + +(defmacro defstyles + "Convenience macro equivalent to `(def name (list styles*))`." + [name & styles] + `(def ~name (list ~@styles))) + +(defmacro defstylesheet + "Convenience macro equivalent to `(def name (css opts? styles*))`." + [name & styles] + `(def ~name (mranderson047.garden.v1v3v3.garden.core/css ~@styles))) + +(defmacro defrule + "Define a function for creating rules. If only the `name` argument is + provided the rule generating function will default to using it as the + primary selector. + + Ex. + (defrule a) + ;; => #'user/a + + (a {:text-decoration \"none\"}) + ;; => [:a {:text-decoration \"none\"}] + + Ex. + (defrule sub-headings :h4 :h5 :h6) + ;; => #'user/sub-headings + + (sub-headings {:font-weight \"normal\"}) + ;; => [:h4 :h5 :h6 {:font-weight \"normal\"}]" + [sym & selectors] + (let [rule (if (seq selectors) + `(vec '~selectors) + [(keyword sym)]) + [_ sym spec] (macroexpand `(defn ~sym [~'& ~'children] + (into ~rule ~'children)))] + `(def ~sym ~spec))) + +(defmacro ^{:arglists '([name] [name docstring? & fn-tail])} + defcssfn + "Define a function for creating custom CSS functions. The generated + function will automatically create an instance of + `garden.types.CSSFunction` of which the `:args` field will be set + to whatever the return value of the original function is. The + `:function` field will be set to `(str name)`. + + If only the `name` argument is provided the returned function will + accept any number of arguments. + + Ex. + (defcssfn url) + ;; => #'user/url + + (url \"http://fonts.googleapis.com/css?family=Lato\") + ;; => #garden.types.CSSFunction{:function \"url\", :args \"http://fonts.googleapis.com/css?family=Lato\"} + + (css (url \"http://fonts.googleapis.com/css?family=Lato\")) + ;; => url(http://fonts.googleapis.com/css?family=Lato) + + Ex. + (defcssfn attr + ([name] name) + ([name type-or-unit] + [[name type-or-unit]]) + ([name type-or-unit fallback] + [name [type-or-unit fallback]])) + ;; => #'user/attr + + (attr :vertical :length) + ;; => #garden.types.CSSFunction{:function \"url\", :args [:vertical :length]} + + (css (attr :vertical :length)) + ;; => \"attr(vertical length)\" + + (attr :end-of-quote :string :inherit) + ;; => #garden.types.CSSFunction{:function \"url\", :args [:end-of-quote [:string :inherit]]} + + (css (attr :end-of-quote :string :inherit)) + ;; => \"attr(end-of-quote string, inherit)\"" + ([sym] + (let [[_ sym fn-tail] (macroexpand + `(defn ~sym [& ~'args] + (CSSFunction. ~(str sym) ~'args)))] + `(def ~sym ~fn-tail))) + ([sym & fn-tail] + (let [[_ sym [_ & fn-spec]] (macroexpand `(defn ~sym ~@fn-tail)) + cssfn-name (str sym)] + `(def ~sym + (fn [& args#] + (CSSFunction. ~cssfn-name (apply (fn ~@fn-spec) args#))))))) + +(defmacro defkeyframes + "Define a CSS @keyframes animation. + + Ex. + (defkeyframes my-animation + [:from + {:background \"red\"}] + + [:to + {:background \"yellow\"}]) + + (css {:vendors [\"webkit\"]} + my-animation ;; Include the animation in the stylesheet. + [:div + ^:prefix ;; Use vendor prefixing (optional). + {:animation [[my-animation \"5s\"]]}])" + [sym & frames] + (let [value {:identifier `(str '~sym) + :frames `(list ~@frames)} + obj `(CSSAtRule. :keyframes ~value)] + `(def ~sym ~obj))) + + diff --git a/src/mranderson047/garden/v1v3v3/garden/media.cljc b/src/mranderson047/garden/v1v3v3/garden/media.cljc new file mode 100644 index 0000000..4e20ead --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/media.cljc @@ -0,0 +1,27 @@ +(ns mranderson047.garden.v1v3v3.garden.media + "Utility functions for working with media queries.") + +;; See: http://www.w3.org/TR/css3-mediaqueries/#media1 +(def media-features + #{:all + :aspect-ratio :min-aspect-ratio :max-aspect-ratio + :braille + :color :min-color :max-color + :color-index :min-color-index :max-color-index + :device-height :min-device-height :max-device-height + :device-width :min-device-width :max-device-width + :embossed + :grid + :handheld + :height :min-height :max-height + :monochrome :min-monochrome :max-monochrome + :orientation + :print + :projection + :resolution :min-resolution :max-resolution + :scan + :screen + :speech + :tty + :tv + :width :min-width :max-width}) diff --git a/src/mranderson047/garden/v1v3v3/garden/repl.clj b/src/mranderson047/garden/v1v3v3/garden/repl.clj new file mode 100644 index 0000000..7cd25ce --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/repl.clj @@ -0,0 +1,31 @@ +(ns mranderson047.garden.v1v3v3.garden.repl + "Method definitions for `print-method` with Garden types." + (:require [mranderson047.garden.v1v3v3.garden.compiler :as compiler] + [mranderson047.garden.v1v3v3.garden.util :as util] + [mranderson047.garden.v1v3v3.garden.types] + [mranderson047.garden.v1v3v3.garden.color] + [mranderson047.garden.v1v3v3.garden.selectors :as selectors]) + (:import (mranderson047.garden.v1v3v3.garden.types CSSUnit + CSSFunction + CSSAtRule) + (mranderson047.garden.v1v3v3.garden.color CSSColor) + (mranderson047.garden.v1v3v3.garden.selectors CSSSelector))) + +(defmethod print-method CSSUnit [css-unit writer] + (.write writer (compiler/render-css css-unit))) + +(defmethod print-method CSSFunction [css-function writer] + (.write writer (compiler/render-css css-function))) + +(defmethod print-method CSSColor [color writer] + (.write writer (compiler/render-css color))) + +(defmethod print-method CSSAtRule [css-at-rule writer] + (let [f (if (or (util/at-keyframes? css-at-rule) + (util/at-media? css-at-rule)) + compiler/compile-css + compiler/render-css)] + (.write writer (f css-at-rule)))) + +(defmethod print-method CSSSelector [css-selector writer] + (.write writer (selectors/css-selector css-selector))) diff --git a/src/mranderson047/garden/v1v3v3/garden/selectors.cljc b/src/mranderson047/garden/v1v3v3/garden/selectors.cljc new file mode 100644 index 0000000..8122b93 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/selectors.cljc @@ -0,0 +1,1057 @@ +(ns mranderson047.garden.v1v3v3.garden.selectors + "Macros and functions for working with CSS selectors." + (:require + [clojure.string :as string]) + #?(:clj + (:refer-clojure :exclude [+ - > empty first map meta not time var])) + #?(:clj + (:import clojure.lang.Keyword + clojure.lang.Symbol + clojure.lang.IFn + clojure.lang.Named)) + #?(:cljs + (:refer-clojure :exclude [+ - > empty first map meta not time])) + #?(:cljs + (:require-macros + [mranderson047.garden.v1v3v3.garden.selectors :refer [defselector + defid + defpseudoclass + defpseudoelement + gen-type-selector-defs + gen-pseudo-class-defs]]))) + +(defprotocol ICSSSelector + (css-selector [this])) + +(defn selector? [x] + (satisfies? ICSSSelector x)) + +(extend-protocol ICSSSelector + #?(:clj String + :cljs string) + (css-selector [this] this) + + Keyword + (css-selector [this] + (name this)) + + Symbol + (css-selector [this] + (name this))) + +#?(:clj + (defrecord CSSSelector [selector] + ICSSSelector + (css-selector [this] + (css-selector (:selector this))) + + IFn + (invoke [this] + this) + (invoke [this a] + (CSSSelector. (str (css-selector this) + (css-selector a)))) + (invoke [this a b] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b)))) + (invoke [this a b c] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c)))) + (invoke [this a b c d] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d)))) + (invoke [this a b c d e] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e)))) + (invoke [this a b c d e f] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f)))) + (invoke [this a b c d e f g] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g)))) + (invoke [this a b c d e f g h] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h)))) + (invoke [this a b c d e f g h i] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i)))) + (invoke [this a b c d e f g h i j] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j)))) + (invoke [this a b c d e f g h i j k] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k)))) + (invoke [this a b c d e f g h i j k l] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l)))) + (invoke [this a b c d e f g h i j k l m] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m)))) + (invoke [this a b c d e f g h i j k l m n] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n)))) + (invoke [this a b c d e f g h i j k l m n o] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o)))) + (invoke [this a b c d e f g h i j k l m n o p] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p)))) + (invoke [this a b c d e f g h i j k l m n o p q] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q)))) + (invoke [this a b c d e f g h i j k l m n o p q r] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r)))) + (invoke [this a b c d e f g h i j k l m n o p q r s] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s)))) + (invoke [this a b c d e f g h i j k l m n o p q r s t] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s) + (css-selector t)))) + + (applyTo [this args] + (clojure.lang.AFn/applyToHelper this args)))) + +#?(:cljs + (defrecord CSSSelector [selector] + ICSSSelector + (css-selector [this] + (css-selector (:selector this))) + + IFn + (-invoke [this] + this) + (-invoke [this a] + (CSSSelector. (str (css-selector this) + (css-selector a)))) + (-invoke [this a b] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b)))) + (-invoke [this a b c] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c)))) + (-invoke [this a b c d] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d)))) + (-invoke [this a b c d e] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e)))) + (-invoke [this a b c d e f] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f)))) + (-invoke [this a b c d e f g] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g)))) + (-invoke [this a b c d e f g h] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h)))) + (-invoke [this a b c d e f g h i] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i)))) + (-invoke [this a b c d e f g h i j] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j)))) + (-invoke [this a b c d e f g h i j k] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k)))) + (-invoke [this a b c d e f g h i j k l] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l)))) + (-invoke [this a b c d e f g h i j k l m] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m)))) + (-invoke [this a b c d e f g h i j k l m n] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n)))) + (-invoke [this a b c d e f g h i j k l m n o] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o)))) + (-invoke [this a b c d e f g h i j k l m n o p] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p)))) + (-invoke [this a b c d e f g h i j k l m n o p q] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q)))) + (-invoke [this a b c d e f g h i j k l m n o p q r] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r)))) + (-invoke [this a b c d e f g h i j k l m n o p q r s] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s)))) + (-invoke [this a b c d e f g h i j k l m n o p q r s t] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s) + (css-selector t)))))) + + +(defn selector [x] + (CSSSelector. x)) + +;; --------------------------------------------------------------------- +;; Macros + +#?(:clj + (defmacro defselector + "Define an instance of a CSSSelector named sym for creating a + CSS selector. This instance doubles as both a function and a + literal (when passed to the css-selector). When the function is called + it will return a new instance that possesses the same properties. All + arguments to the function must satisfy ICSSSelector. + + Example: + + (defselector a) + ;; => #'user/a + (a \":hover\") + ;; => # + (css-selector a) + ;; => \"a\" + (css-selector (a \":hover\")) + ;; => \"a:hover\" + " + ([sym] + `(defselector ~sym ~(name sym))) + ([sym strval] + {:pre [(string? strval)]} + (let [[_ sym v] (macroexpand `(def ~sym (selector ~strval))) + sym (vary-meta sym assoc :arglists `'([~'& ~'selectors]))] + `(def ~sym ~v))))) + +#?(:clj + (defmacro defclass [sym] + `(defselector ~sym ~(str "." (name sym))))) + +#?(:clj + (defmacro defid [sym] + `(defselector ~sym ~(str "#" (name sym))))) + +#?(:clj + (defmacro defpseudoclass + "Define an instance of a CSSSelector named sym for creating a CSS + pseudo class. This instance doubles as both a function and a + literal (when passed to the css-selector). When the function is called + it will return a new instance that possesses the same properties. All + arguments to the function must satisfy ICSSSelector. + + Optionally fn-tail may be passed to create a structual pseudo class. + The return value of the function constructed from fn-tail will be + cast to a string via css-selector or str. + + Example: + + (defselector a) + ;; => #'user/a + (defpseudoclass hover) + ;; => #'user/hover + (hover) + ;; => # + (p/selector (a hover)) + ;; => \"a:hover\" + + Example: + + (defpseudoclass not [x] + (p/selector x)) + ;; => #'user/not + (p/selector (a hover (not \"span\")) + ;; => a:hover:not(span) + + ;; Where p/selector is mranderson047.garden.v1v3v3.garden.protocols/selector + " + [sym & fn-tail] + (if (seq fn-tail) + (let [fn1 (macroexpand `(fn ~fn-tail)) + arglists (clojure.core/map clojure.core/first (rest fn1)) + [_ sym fn2] (macroexpand + `(defn ~sym [& args#] + (let [v# (apply ~fn1 args#) + v# (if (selector? v#) + (css-selector v#) + v#)] + (selector (str \: ~(name sym) "(" v# ")"))))) + sym (vary-meta sym assoc :arglists `'~arglists)] + `(def ~sym ~fn2)) + `(defselector ~sym ~(str \: (name sym)))))) + +#?(:clj + (defmacro defpseudoelement + "Define an instance of a CSSSelector named sym for creating a CSS + pseudo element. This instance doubles as both a function and a + literal (when passed to the css-selector). When the function is called + it will return a new instance that possesses the same properties. All + arguments to the function must satisfy ICSSSelector. + + Example: + + (defselector p) + ;; => #'user/p + (defpseudoelement first-letter) + ;; => #'user/first-letter + (first-letter) + ;; => # + (p/selector (p first-letter)) + ;; => \"p::first-letter\" + + ;; Where p/selector is mranderson047.garden.v1v3v3.garden.protocols/selector + " + [sym] + `(defselector ~sym ~(str "::" (name sym))))) + +;;---------------------------------------------------------------------- +;; Type selectors classes + +(def ^:private html-tags + '[a + abbr + address + area + article + aside + audio + b + base + bdi + bdo + blockquote + body + br + button + canvas + caption + cite + code + col + colgroup + command + datalist + dd + del + details + dfn + div + dl + dt + em + embed + fieldset + figcaption + figure + footer + form + h1 + h2 + h3 + h4 + h5 + h6 + head + header + hgroup + hr + html + i + iframe + img + input + ins + kbd + keygen + label + legend + li + link + map + mark + math + menu + meta + meter + nav + noscript + object + ol + optgroup + option + output + p + param + pre + progress + q + rp + rt + ruby + s + samp + script + section + select + small + source + span + strong + style + sub + summary + sup + svg + table + tbody + td + textarea + tfoot + th + thead + time + title + tr + track + u + ul + var + video + wbr]) + +#?(:clj + (defmacro ^:private gen-type-selector-defs [] + `(do + ~@(for [tag html-tags + :let [doc (str "CSS " tag " type selector.") + tag (vary-meta tag assoc :doc doc)]] + `(defselector ~tag))))) + +(gen-type-selector-defs) + +;;---------------------------------------------------------------------- +;; Pseudo classes + +(def ^:private pseudo-classes + '[active + checked + default + disabled + empty + enabled + first + first-child + first-of-type + fullscreen + focus + hover + indeterminate + in-range + invalid + last-child + last-of-type + left + links + only-child + only-of-type + optional + out-of-range + read-only + read-write + required + right + root + scope + target + valid + visited]) + +#?(:clj + (defn- gen-pseudo-class-def [p] + (let [p (vary-meta p assoc :doc (str "CSS :" p " pseudo-class selector."))] + `(defpseudoclass ~p)))) + +#?(:clj + (defmacro ^:private gen-pseudo-class-defs [] + `(do + ~@(for [p pseudo-classes] + (gen-pseudo-class-def p))))) + +(gen-pseudo-class-defs) + +;;---------------------------------------------------------------------- +;; Structural pseudo classes + +(defpseudoclass lang [language] + (name language)) + +(defpseudoclass not [selector] + (css-selector selector)) + +;; SEE: http://www.w3.org/TR/selectors/#nth-child-pseudo +(def nth-child-re + #?(:clj + #"\s*(?i:[-+]?\d+n\s*(?:[-+]\s*\d+)?|[-+]?\d+|odd|even)\s*") + #?(:cljs + (js/RegExp. "\\s*(?:[-+]?\\d+n\\s*(?:[-+]\\s*\\d+)?|[-+]?\\d+|odd|even)\\s*" + "i"))) + +(defn nth-x + "nth-child helper." + [x] + (assert (or (string? x) (keyword? x) (symbol? x)) + "Agument must be a string, keyword, or symbol") + (let [s (name x)] + (if-let [m (re-matches nth-child-re s)] + m + (throw (ex-info + "Selector must be either a keyword, string, or symbol." (str "Invalid value " (pr-str s))))))) + +(defpseudoclass + ^{:doc "CSS :nth-child pseudo class selector."} + nth-child [x] + (if (number? x) + (nth-x (str x "n")) + (nth-x x))) + +(defpseudoclass + ^{:doc "CSS :nth-last-child pseudo class selector."} + nth-last-child [x] + (nth-x x)) + +(defpseudoclass + ^{:doc "CSS :nth-of-type pseudo class selector."} + nth-of-type [x] + (nth-x x)) + +(defpseudoclass + ^{:doc "CSS :nth-last-of-type pseudo class selector."} + nth-last-of-type [x] + (nth-x x)) + +;; --------------------------------------------------------------------- +;; Pseudo elements + +(defpseudoelement + ^{:doc "CSS ::after pseudo element selector."} + after) + +(defpseudoelement + ^{:doc "CSS ::before pseudo element selector."} + before) + +(defpseudoelement + ^{:doc "CSS ::first-letter pseudo element selector."} + first-letter) + +(defpseudoelement + ^{:doc "CSS ::first-line pseudo element selector."} + first-line) + +;; --------------------------------------------------------------------- +;; Attribute selectors + +;; SEE: http://www.w3.org/TR/selectors/#attribute-selectors + +(defn attr + ([attr-name] + (selector (str \[ (name attr-name) \]))) + ([attr-name op attr-value] + (let [v (name attr-value) + ;; Wrap the value in quotes unless it's already + ;; quoted to prevent emitting bad selectors. + v (if (re-matches #"\"(\\|[^\"])*\"|'(\\|[^\'])*'" v) + v + (pr-str v))] + (selector (str \[ (name attr-name) (name op) v \]))))) + +(defn attr= [attr-name attr-value] + (attr attr-name "=" attr-value)) + +(defn attr-contains [attr-name attr-value] + (attr attr-name "~=" attr-value)) + +(defn attr-starts-with [attr-name attr-value] + (attr attr-name "^=" attr-value)) + +;; TODO: This needs a better name. +(defn attr-starts-with* [attr-name attr-value] + (attr attr-name "|=" attr-value)) + +(defn attr-ends-with [attr-name attr-value] + (attr attr-name "$=" attr-value)) + +(defn attr-matches [attr-name attr-value] + (attr attr-name "*=" attr-value)) + +;;---------------------------------------------------------------------- +;; Selectors combinators + +;; SEE: http://www.w3.org/TR/selectors/#combinators + +(defn descendant + "Descendant combinator." + ([a b] + (selector (str (css-selector a) " " (css-selector b)))) + ([a b & more] + (->> (cons (descendant a b) more) + (clojure.core/map css-selector) + (string/join " ") + (selector)))) + +(defn + + "Adjacent sibling combinator." + [a b] + (selector (str (css-selector a) " + " (css-selector b)))) + +(defn - + "General sibling combinator." + [a b] + (selector (str (css-selector a) " ~ " (css-selector b)))) + +(defn > + "Child combinator." + ([a] + (selector a)) + ([a b] + (selector (str (css-selector a) " > " (css-selector b)))) + ([a b & more] + (->> (cons (> a b) more) + (clojure.core/map css-selector) + (string/join " > ") + (selector)))) + +;; --------------------------------------------------------------------- +;; Special selectors + +(defselector + ^{:doc "Parent selector."} + &) + +;;---------------------------------------------------------------------- +;; Specificity + +;; SEE: http://www.w3.org/TR/selectors/#specificity + +(defn- lex-specificity [s] + (let [id-selector-re #"^\#[a-zA-Z][\w-]*" + class-selector-re #"^\.[a-zA-Z][\w-]*" + attribute-selector-re #"^\[[^\]]*\]" + type-selector-re #"^[a-zA-Z][\w-]" + pseudo-class-re #"^:[a-zA-Z][\w-]*(?:\([^\)]+\))?" + pseudo-element-re #"^::[a-zA-Z][\w-]*"] + (some + (fn [[re k]] + (if-let [m (re-find re s)] + [m k])) + [[id-selector-re :a] + [class-selector-re :b] + [attribute-selector-re :b] + [pseudo-class-re :b] + [type-selector-re :c] + [pseudo-element-re :c]]))) + +(defn- specificity* [selector] + (let [s (css-selector selector) + score {:a 0 :b 0 :c 0}] + (loop [s s, score score] + (if (empty? s) + score + (if-let [[m k] (lex-specificity s)] + ;; The negation pseudo class is a special case. + (if-let [[_ inner] (re-find #"^:not\(([^\)]*)\)" m)] + (recur (subs s (count m)) + (merge-with clojure.core/+ score (specificity* inner))) + (recur (subs s (count m)) (update-in score [k] inc))) + (recur (subs s 1) score)))))) + +(defn specificity + "Calculate a CSS3 selector's specificity. + + Example: + + (specificity \"#s12:not(FOO)\") + ;; => 101 + (specificity (a hover)) + ;; => 10 + " + [selector] + {:pre [(satisfies? ICSSSelector selector)]} + (let [{:keys [a b c]} (specificity* selector) + sv (string/replace (str a b c) #"^0*" "")] + (if (empty? sv) + 0 + #?(:clj (Integer. sv) + :cljs (js/parseInt sv))))) diff --git a/src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc b/src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc new file mode 100644 index 0000000..8d0b1a1 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc @@ -0,0 +1,79 @@ +(ns mranderson047.garden.v1v3v3.garden.stylesheet + "Utility functions for CSS properties, directives and functions." + (:require [mranderson047.garden.v1v3v3.garden.util :as util] + [mranderson047.garden.v1v3v3.garden.color :as color] + [mranderson047.garden.v1v3v3.garden.types :as t]) + #?(:clj + (:import garden.types.CSSFunction + garden.types.CSSAtRule))) + +;;;; ## Stylesheet helpers + +(defn rule + "Create a rule function for the given selector. The `selector` + argument must be valid selector (ie. a keyword, string, or symbol). + Additional arguments may consist of extra selectors or + declarations. + + The returned function accepts any number of arguments which represent + the rule's children. + + Ex. + (let [text-field (rule \"[type=\"text\"])] + (text-field {:border [\"1px\" :solid \"black\"]})) + ;; => [\"[type=\"text\"] {:boder [\"1px\" :solid \"black\"]}]" + [selector & more] + (if-not (or (keyword? selector) + (string? selector) + (symbol? selector)) + (throw (ex-info + "Selector must be either a keyword, string, or symbol." {})) + (fn [& children] + (into (apply vector selector more) children)))) + +(defn cssfn [fn-name] + (fn [& args] + (t/CSSFunction. fn-name args))) + +;;;; ## At-rules + +(defn- at-rule [identifier value] + (t/CSSAtRule. identifier value)) + +(defn at-font-face + "Create a CSS @font-face rule." + [& font-properties] + ["@font-face" font-properties]) + +(defn at-import + "Create a CSS @import rule." + ([url] + (at-rule :import {:url url + :media-queries nil})) + ([url & media-queries] + (at-rule :import {:url url + :media-queries media-queries}))) + +(defn at-media + "Create a CSS @media rule." + [media-queries & rules] + (at-rule :media {:media-queries media-queries + :rules rules})) + +(defn at-keyframes + "Create a CSS @keyframes rule." + [identifier & frames] + (at-rule :keyframes {:identifier identifier + :frames frames})) + +;;;; ## Functions + +(defn rgb + "Create a color from RGB values." + [r g b] + (color/rgb [r g b])) + +(defn hsl + "Create a color from HSL values." + [h s l] + (color/hsl [h s l])) diff --git a/src/mranderson047/garden/v1v3v3/garden/types.cljc b/src/mranderson047/garden/v1v3v3/garden/types.cljc new file mode 100644 index 0000000..841021e --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/types.cljc @@ -0,0 +1,8 @@ +(ns mranderson047.garden.v1v3v3.garden.types + "Internal types used by Garden.") + +(defrecord CSSUnit [unit magnitude]) + +(defrecord CSSFunction [function args]) + +(defrecord CSSAtRule [identifier value]) diff --git a/src/mranderson047/garden/v1v3v3/garden/units.cljc b/src/mranderson047/garden/v1v3v3/garden/units.cljc new file mode 100644 index 0000000..0da5cf5 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/units.cljc @@ -0,0 +1,327 @@ +(ns mranderson047.garden.v1v3v3.garden.units + "Functions and macros for working with CSS units." + (:refer-clojure :exclude [rem]) + #?@(:clj + [(:require + [mranderson047.garden.v1v3v3.garden.types :as types] + [mranderson047.garden.v1v3v3.garden.util :as util]) + (:import + [mranderson047.garden.v1v3v3.garden.types CSSUnit])]) + #?@(:cljs + [(:require + [cljs.reader :refer [read-string]] + [mranderson047.garden.v1v3v3.garden.types :as types :refer [CSSUnit]] + [mranderson047.garden.v1v3v3.garden.util :as util]) + (:require-macros + [mranderson047.garden.v1v3v3.garden.units :refer [defunit]])])) + +;;;; ## Unit families + +(def length-units + #{:in :cm :pc :mm :pt :px (keyword "%")}) + +(def angular-units + #{:deg :grad :rad :turn}) + +(def time-units + #{:s :ms}) + +(def frequency-units + #{:Hz :kHz}) + +(def resolution-units + #{:dpi :dpcm :dppx}) + +;;;; ## Unit predicates + +(defn unit? + "True if x is of type CSSUnit." + [x] + (instance? CSSUnit x)) + +(defn length? + [x] + (and (unit? x) + (contains? length-units (:unit x)))) + +(defn angle? + [x] + (and (unit? x) + (contains? angular-units (:unit x)))) + +(defn time? + [x] + (and (unit? x) + (contains? time-units (:unit x)))) + +(defn frequency? + [x] + (and (unit? x) + (contains? frequency-units (:unit x)))) + +(defn resolution? + [x] + (and (unit? x) + (contains? resolution-units (:unit x)))) + +;;;; ## Unit conversion + +(def ^{:private true + :doc "Map associating CSS unit types to their conversion values."} + conversions + {;; Absolute units + :cm {:cm 1 + :mm 10 + :pc 2.36220473 + :pt 28.3464567 + :px 37.795275591} + :in {:cm 2.54 + :in 1 + :mm 25.4 + :pc 6 + :pt 72 + :px 96} + :mm {:mm 1 + :pt 2.83464567 + :px 3.7795275591} + :pc {:mm 4.23333333 + :pc 1 + :pt 12 + :px 16} + :pt {:pt 1 + :px 1.3333333333} + :px {:px 1} + (keyword "%") {(keyword "%") 1} + + ;; Relative untis + :em {:em 1} + :rem {:rem 1} + + ;; Angular units + :deg {:deg 1 + :grad 1.111111111 + :rad 0.0174532925 + :turn 0.002777778} + :grad {:grad 1 + :rad 63.661977237 + :turn 0.0025} + :rad {:rad 1 + :turn 0.159154943} + :turn {:turn 1} + + ;; Time units + :s {:ms 1000 + :s 1} + :ms {:ms 1} + + ;; Frequency units + :Hz {:Hz 1 + :kHz 0.001} + :kHz {:kHz 1}}) + +(defn- convertable? + "True if unit is a key of convertable-units, false otherwise." + [unit] + (contains? conversions unit)) + +(defn- convert + "Convert a Unit with :unit left to a Unit with :unit right if possible." + [{m :magnitude left :unit} right] + (if (every? convertable? [left right]) + (let [v1 (get-in conversions [left right]) + v2 (get-in conversions [right left])] + (cond + v1 + (CSSUnit. right (* v1 m)) + + v2 + (CSSUnit. right (/ m v2)) + + ;; Both units are convertible but no conversion between them exists. + :else + (throw + (ex-info + (util/format "Can't convert %s to %s" (name left) (name right)) {})))) + ;; Display the inconvertible unit. + (let [x (first (drop-while convertable? [left right]))] + (throw (ex-info (str "Inconvertible unit " (name x)) {}))))) + +;;;; ## Unit helpers + +(def ^{:doc "Regular expression for matching a CSS unit. The magnitude + and unit are captured." + :private true} + unit-re + #"([+-]?\d+(?:\.?\d+)?)(p[xtc]|in|[cm]m|%|r?em|ex|ch|v(?:[wh]|m(?:in|ax))|deg|g?rad|turn|m?s|k?Hz|dp(?:i|cm|px))") + +(defn read-unit + "Read a `CSSUnit` object from the string `s`." + [s] + (when-let [[_ magnitude unit] (re-matches unit-re s)] + (let [unit (keyword unit) + magnitude (if magnitude (read-string magnitude) 0)] + (CSSUnit. unit magnitude)))) + +(defn make-unit-predicate + "Creates a function for verifying the given unit type." + [unit] + (fn [x] (and (unit? x) (= (:unit x) unit)))) + +(defn make-unit-fn + "Creates a function for creating and converting `CSSUnit`s for the + given unit. If a number n is passed the function it will produce a + new `CSSUnit` record with a the magnitude set to n. If a `CSSUnit` + is passed the function will attempt to convert it." + [unit] + (fn [x] + (cond + (number? x) + (CSSUnit. unit x) + + (unit? x) + (if (and (= (unit x) unit)) + x + (convert x unit)) + + :else + (let [;; Does `.getName` even work in CLJS? -- @noprompt + ex-message (util/format "Unable to convert from %s to %s" + (.getName type) + (name unit)) + ;; TODO: This needs to be populated with more helpful + ;; data. + ex-data {:given {:type type + :unit unit}}] + (throw + (ex-info ex-message ex-data)))))) + +(defn make-unit-adder + "Create a addition function for adding Units." + [unit] + (let [u (make-unit-fn unit)] + (fn u+ + ([] (u 0)) + ([x] (u x)) + ([x y] + (let [{m1 :magnitude} (u x) + {m2 :magnitude} (u y)] + (u (+ m1 m2)))) + ([x y & more] + (reduce u+ (u+ x y) more))))) + +(defn make-unit-subtractor + "Create a subtraction function for subtracting Units." + [unit] + (let [u (make-unit-fn unit)] + (fn u- + ([x] (u (- x))) + ([x y] + (let [{m1 :magnitude} (u x) + {m2 :magnitude} (u y)] + (u (- m1 m2)))) + ([x y & more] + (reduce u- (u- x y) more))))) + +(defn make-unit-multiplier + "Create a multiplication function for multiplying Units." + [unit] + (let [u (make-unit-fn unit)] + (fn u* + ([] (u 1)) + ([x] (u x)) + ([x y] + (let [{m1 :magnitude} (u x) + {m2 :magnitude} (u y)] + (u (* m1 m2)))) + ([x y & more] + (reduce u* (u* x y) more))))) + +(defn make-unit-divider + "Create a division function for dividing Units." + [unit] + (let [u (make-unit-fn unit)] + (fn ud + ([x] (u (/ 1 x))) + ([x y] + (let [{m1 :magnitude} (u x) + {m2 :magnitude} (u y)] + (u (/ m1 m2)))) + ([x y & more] + (reduce ud (ud x y) more))))) + +#?(:clj + (defmacro defunit + "Create a suite of functions for unit creation, conversion, + validation, and arithmetic." + ([name] + `(defunit ~name ~name)) + ([name unit] + (let [k (keyword unit) + append #(symbol (str name %))] + `(do + (def ~name (make-unit-fn ~k)) + (def ~(append \?) (make-unit-predicate ~k)) + (def ~(append \+) (make-unit-adder ~k)) + (def ~(append \-) (make-unit-subtractor ~k)) + (def ~(append \*) (make-unit-multiplier ~k)) + (def ~(append "-div") (make-unit-divider ~k))))))) + +(comment + ;; This: + (defunit px) + ;; Is equivalent to: + (def px (make-unit-fn :px)) + (def px? (make-unit-predicate :px)) + (def px+ (make-unit-adder :px)) + (def px- (make-unit-subtractor :px)) + (def px* (make-unit-multiplier :px)) + (def px-div (make-unit-divider :px))) + +;; # Predefined units + +;; Absolute units + +(defunit cm) +(defunit mm) +(defunit in) +(defunit px) +(defunit pt) +(defunit pc) +(defunit percent "%") + +;; Font-relative units + +(defunit em) +(defunit ex) +(defunit ch) +(defunit rem) + +;; Viewport-percentage lengths + +(defunit vw) +(defunit vh) +(defunit vmin) +(defunit vmax) + +;; Angles + +(defunit deg) +(defunit grad) +(defunit rad) +(defunit turn) + +;; Times + +(defunit s) +(defunit ms) + +;; Frequencies + +(defunit Hz) +(defunit kHz) + +;; Resolutions + +(defunit dpi) +(defunit dpcm) +(defunit dppx) diff --git a/src/mranderson047/garden/v1v3v3/garden/util.cljc b/src/mranderson047/garden/v1v3v3/garden/util.cljc new file mode 100644 index 0000000..d8c1e16 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/util.cljc @@ -0,0 +1,179 @@ +(ns mranderson047.garden.v1v3v3.garden.util + "Utility functions used by Garden." + (:require + [clojure.string :as str] + [mranderson047.garden.v1v3v3.garden.types :as t] + #?@(:cljs + [[goog.string] + [goog.string.format]])) + #?(:clj + (:refer-clojure :exclude [format])) + #?(:clj + (:import garden.types.CSSAtRule))) + +;; --------------------------------------------------------------------- +;; String utilities + +#?(:cljs + (defn format + "Formats a string using goog.string.format." + [fmt & args] + (apply goog.string/format fmt args))) + +;; To avoid the pain of #?cljs :refer. +#?(:clj + (def format #'clojure.core/format)) + +(defprotocol ToString + (^String to-str [this] "Convert a value into a string.")) + +(extend-protocol ToString + #?(:clj clojure.lang.Keyword) + #?(:cljs Keyword) + (to-str [this] (name this)) + + #?(:clj Object) + #?(:cljs default) + (to-str [this] (str this)) + + nil (to-str [this] "")) + +(defn ^String as-str + "Convert a variable number of values into strings." + [& args] + (apply str (map to-str args))) + +(defn string->int + "Convert a string to an integer with optional base." + [s & [radix]] + (let [radix (or radix 10)] + #?(:clj + (Integer/parseInt ^String s ^Long radix)) + #?(:cljs + (js/parseInt s radix)))) + +(defn int->string + "Convert an integer to a string with optional base." + [i & [radix]] + (let [radix (or radix 10)] + #?(:clj + (Integer/toString ^Long i ^Long radix)) + #?(:cljs + (.toString i radix)))) + +(defn space-join + "Return a space separated list of values." + [xs] + (str/join " " (map to-str xs))) + +(defn comma-join + "Return a comma separated list of values. Subsequences are joined with + spaces." + [xs] + (let [ys (for [x xs] + (if (sequential? x) + (space-join x) + (to-str x)))] + (str/join ", " ys))) + +(defn wrap-quotes + "Wrap a string with double quotes." + [s] + (str \" s \")) + +;; --------------------------------------------------------------------- +;; Predicates + +(defn hash-map? + "True if `(map? x)` and `x` does not satisfy `clojure.lang.IRecord`." + [x] + (and (map? x) (not (record? x)))) + +(def + ^{:doc "Alias to `vector?`."} + rule? vector?) + +(def + ^{:doc "Alias to `hash-map?`."} + declaration? hash-map?) + +(defn at-rule? + [x] + (instance? #?(:clj CSSAtRule) #?(:cljs t/CSSAtRule) x)) + +(defn at-media? + "True if `x` is a CSS `@media` rule." + [x] + (and (at-rule? x) (= (:identifier x) :media))) + +(defn at-keyframes? + "True if `x` is a CSS `@keyframes` rule." + [x] + (and (at-rule? x) (= (:identifier x) :keyframes))) + +(defn at-import? + "True if `x` is a CSS `@import` rule." + [x] + (and (at-rule? x) (= (:identifier x) :import))) + +(defn prefix + "Attach a CSS style prefix to s." + [p s] + (let [p (to-str p)] + (if (= \- (last p)) + (str p s) + (str p \- s)))) + +(defn vendor-prefix + "Attach a CSS vendor prefix to s." + [p s] + (let [p (to-str p)] + (if (= \- (first p)) + (prefix p s) + (prefix (str \- p) s)))) + +;; --------------------------------------------------------------------- +;; Math utilities + +(defn natural? + "True if n is a natural number." + [n] + (and (integer? n) (pos? n))) + +(defn between? + "True if n is a number between a and b." + [n a b] + (let [bottom (min a b) + top (max a b)] + (and (>= n bottom) (<= n top)))) + +(defn clip + "Return a number such that n is no less than a and no more than b." + [a b n] + (let [[a b] (if (<= a b) [a b] [b a])] + (max a (min b n)))) + +(defn average + "Return the average of two or more numbers." + [n m & more] + (/ (apply + n m more) (+ 2.0 (count more)))) + +;; Taken from clojure.math.combinatorics. +(defn cartesian-product + "All the ways to take one item from each sequence." + [& seqs] + (let [v-original-seqs (vec seqs) + step + (fn step [v-seqs] + (let [increment + (fn [v-seqs] + (loop [i (dec (count v-seqs)), v-seqs v-seqs] + (if (= i -1) nil + (if-let [rst (next (v-seqs i))] + (assoc v-seqs i rst) + (recur (dec i) (assoc v-seqs i (v-original-seqs i)))))))] + (when v-seqs + (cons (map first v-seqs) + (lazy-seq (step (increment v-seqs)))))))] + (when (every? seq seqs) + (lazy-seq (step v-original-seqs)))))