Bundle garden to avoid source conflicts with garden 2.0.0
This commit is contained in:
Daniel Compton
parent
547822e7d9
commit
f20dd1b0d0
|
|
@ -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]]]}})
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
@ -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))))
|
||||
|
|
@ -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))))
|
||||
|
|
@ -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))))
|
||||
|
|
@ -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))
|
||||
|
||||
|
|
@ -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)))
|
||||
|
||||
|
||||
|
|
@ -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})
|
||||
|
|
@ -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)))
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -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]))
|
||||
|
|
@ -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])
|
||||
|
|
@ -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)
|
||||
|
|
@ -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)))))
|
||||
Loading…
Reference in New Issue