[svg] refactor color related functionality due to new architecture in…

… thi.ng/color

geom-svg/src/core.org

@@ -101,20 +101,22 @@ introduce uneccessary dependencies.
 Colors in SVG need to be defined as CSS color strings and hence are
 completely opaque to other parts of the code base and which might deal
 with the dynamic generation of color values. Therefore we allow the
-=:stroke= and =:fill= attributes to be defined as RGB(A) or HSV(A)
-vectors (e.g. in conjuction with the color utilities defined in the
-[[http://thi.ng/color][thi.ng/color]] library. If these attributes are present and *not*
-already a string value, they will be converted into a CSS color
-automatically (using the =rgba->css= or =hsva->css= fns). In order to
-specify HSV colors, use the =:stoke-hsv= or =:fill-hsv= attributes.
+=:stroke= and =:fill= attributes to be defined as any color type
+defined by the [[http://thi.ng/color][thi.ng/color]] library (RGB, HSV, HSL, CMYK, YUV etc.).
+If these attributes are present and *not* already a string value, they
+will be converted into a CSS color automatically (using the
+polymorphic =as-css= protocol method of thi.ng/color).
+
+*Note:* The same applies to specifying colors in gradients (see
+=linear-gradient= and =radial-gradient= functions below).
 
 #+BEGIN_SRC clojure :noweb-ref helpers
   (defn color-attrib
-    [attribs id id2 f]
+    [attribs id]
     (if-let [att (attribs id)]
       (if (string? att)
         attribs
-        (-> attribs (dissoc id) (assoc id2 (apply f att))))
+        (assoc attribs id (col/unwrap (col/as-css att))))
       attribs))
 #+END_SRC
 
@@ -152,10 +154,8 @@ and will be automatically converted.
     [attribs base]
     (if (seq attribs)
       (-> (filter-attribs attribs)
-          (color-attrib :stroke :stroke col/rgba->css)
-          (color-attrib :stroke-hsv :stroke col/hsva->css)
-          (color-attrib :fill :fill col/rgba->css)
-          (color-attrib :fill-hsv :fill col/hsva->css)
+          (color-attrib :stroke)
+          (color-attrib :fill)
           (matrix-attrib :transform)
           (into base))
       base))
@@ -179,33 +179,21 @@ and will be automatically converted.
     [:defs defs])
 
   (defn gradient-stop
-    [f [pos col]]
-    (let [col (if (string? col) col (apply f col))]
+    [[pos col]]
+    (let [col (if (string? col) col (col/unwrap (col/as-css col)))]
       [:stop {:offset (*fmt-percent* pos) :stop-color col}]))
 
-  (defn linear-gradient-rgb
+  (defn linear-gradient
     [id attribs & stops]
     [:linearGradient
      (assoc attribs :id id)
-     (map #(gradient-stop col/rgba->css %) stops)])
+     (map gradient-stop stops)])
 
-  (defn radial-gradient-rgb
+  (defn radial-gradient
     [id attribs & stops]
     [:radialGradient
      (assoc attribs :id id)
-     (map #(gradient-stop col/rgba->css %) stops)])
-
-  (defn linear-gradient-hsv
-    [id attribs & stops]
-    [:linearGradient
-     (assoc attribs :id id)
-     (map #(gradient-stop col/hsva->css %) stops)])
-
-  (defn radial-gradient-hsv
-    [id attribs & stops]
-    [:radialGradient
-     (assoc attribs :id id)
-     (map #(gradient-stop col/hsva->css %) stops)])
+     (map gradient-stop stops)])
 
   (defn group
     [attribs & body]
@@ -232,12 +220,16 @@ and will be automatically converted.
       attribs
       {:cx (*ff* x) :cy (*ff* y) :r radius})])
 
-  (defn arc
-    [center radius theta1 theta2 great? ccw? & [attribs]]
+  (defn arc-segment
+    [center radius theta1 theta2 great? ccw?]
     (let [radius (vec2 radius)
           p (g/+ (vec2 center) (g/as-cartesian (vec2 (v/x radius) theta1)))
           q (g/+ (vec2 center) (g/as-cartesian (vec2 (v/y radius) theta2)))]
-      (path [[:M p] [:A radius 0 (if great? 1 0) (if ccw? 1 0) q]] attribs)))
+      [[:M p] [:A radius 0 (if great? 1 0) (if ccw? 1 0) q]]))
+
+  (defn arc
+    [center radius theta1 theta2 great? ccw? & [attribs]]
+    (path (arc-segment center radius theta1 theta2 great? ccw?) attribs))
 
   (defn rect
     [[x y] w h & [attribs]]

geom-svg/src/examples.org

@@ -197,6 +197,7 @@ is defined in its own namespace and can be loaded from the REPL via:
      [thi.ng.geom.core :as g]
      [thi.ng.geom.core.vector :refer [vec2]]
      [thi.ng.geom.svg.core :as svg]
+     [thi.ng.color.core :as col]
      [thi.ng.math.core :as m]
      [thi.ng.math.macros :as mm]))
 
@@ -207,12 +208,12 @@ is defined in its own namespace and can be loaded from the REPL via:
      (range r1 r2 (mm/subdiv r2 r1 steps))
      (range start end (mm/subdiv end start steps))))
 
-  (def rainbow-gradient (map (fn [h] [h [h 1 1]]) (m/norm-range 12)))
+  (def rainbow-gradient (map (fn [h] [h (col/hsva h 1 1)]) (m/norm-range 12)))
 
   (->> (svg/svg
         {:width 300 :height 300}
         (svg/defs
-          (apply svg/radial-gradient-hsv "rainbow" {} rainbow-gradient))
+          (apply svg/radial-gradient "rainbow" {} rainbow-gradient))
         (svg/line-strip
          (spiral [150 150] 0 (* 6 m/TWO_PI) 0 140 300)
          (assoc svg/stroke-round
@@ -233,6 +234,7 @@ is defined in its own namespace and can be loaded from the REPL via:
      [thi.ng.geom.core.vector :refer [vec2]]
      [thi.ng.geom.core.matrix :refer [M32]]
      [thi.ng.geom.svg.core :as svg]
+     [thi.ng.color.core :as col]
      [thi.ng.math.core :as m]
      [thi.ng.math.macros :as mm]))
 
@@ -243,13 +245,13 @@ is defined in its own namespace and can be loaded from the REPL via:
      (range r1 r2 (mm/subdiv r2 r1 steps))
      (range start end (mm/subdiv end start steps))))
 
-  (def rainbow-gradient (map (fn [h] [h [h 1 1]]) (m/norm-range 12)))
+  (def rainbow-gradient (map (fn [h] [h (col/hsva h 1 1)]) (m/norm-range 12)))
 
   (->> (svg/svg
         {:width 600 :height 300}
         (svg/defs
-          (apply svg/radial-gradient-hsv "rainbow-rad" {} rainbow-gradient)
-          (apply svg/linear-gradient-hsv "rainbow-lin" {} rainbow-gradient)
+          (apply svg/radial-gradient "rainbow-rad" {} rainbow-gradient)
+          (apply svg/linear-gradient "rainbow-lin" {} rainbow-gradient)
           (svg/line-strip
            (spiral [0 0] 0 (* 6 m/TWO_PI) 0 140 300)
            (assoc svg/stroke-round :id "spiral")))

geom-svg/src/shaders.org

@@ -41,8 +41,8 @@
       PShader
       (shade-facet [_ f f' z]
         (cond-> {}
-                fill   (assoc :fill   (if (fn? fill) (fill f f' z) fill))
-                stroke (assoc :stroke (if (fn? stroke) (stroke f f' z) stroke))))
+                fill   (assoc :fill   (col/rgba (if (fn? fill) (fill f f' z) fill)))
+                stroke (assoc :stroke (col/rgba (if (fn? stroke) (stroke f f' z) stroke)))))
       (uniforms [_] uniforms)
       (solid? [_] (:solid flags true))))
 
@@ -93,7 +93,8 @@
      [thi.ng.geom.core :as g]
      [thi.ng.geom.core.utils :as gu]
      [thi.ng.geom.core.vector :refer [vec3 V3Z]]
-     [thi.ng.geom.core.matrix :as mat :refer [M44]]))
+     [thi.ng.geom.core.matrix :as mat :refer [M44]]
+     [thi.ng.color.core :as col]))
 
   <<protos>>
 

geom-viz/src/core.org

@@ -59,6 +59,7 @@
      - [[#value-formatting][Value formatting]]
      - [[#custom-shapes][Custom shapes]]
      - [[#todo-3d-plotting][TODO 3D Plotting]]
+     - [[#date--time-helpers][Date & time helpers]]
      - [[#complete-namespace-definitions][Complete namespace definitions]]
 
 * Namespace: thi.ng.geom.viz.core
@@ -1606,6 +1607,68 @@ file).
 
 TBD
 
+** Date & time helpers
+
+#+BEGIN_SRC clojure :noweb-ref date-helpers
+  (defn epoch->cal
+    [epoch] (doto (GregorianCalendar.) (.setTimeInMillis (long epoch))))
+
+  (defn clear-millis [^GregorianCalendar cal] (.set cal Calendar/MILLISECOND 0) cal)
+  (defn clear-second [^GregorianCalendar cal] (.set Calendar/SECOND 0) (clear-millis cal))
+  (defn clear-minute [^GregorianCalendar cal] (.set Calendar/MINUTE 0) (clear-second cal))
+  (defn clear-hour [^GregorianCalendar cal] (.set cal Calendar/HOUR 0) (clear-minute cal))
+  (defn clear-day-of-month [^GregorianCalendar cal] (.set cal Calendar/DAY_OF_MONTH 1) (clear-hour cal))
+  (defn clear-day-of-week [^GregorianCalendar cal] (.set cal Calendar/DAY_OF_WEEK 1) (clear-hour cal))
+  (defn clear-month [^GregorianCalendar cal] (.set cal Calendar/MONTH 0) (clear-day-of-month cal))
+
+  (defn year [^GregorianCalendar cal] (.get cal Calendar/YEAR))
+  (defn month [^GregorianCalendar cal] (.get cal Calendar/MONTH))
+  (defn day-of-month [^GregorianCalendar cal] (.get cal Calendar/DAY_OF_MONTH))
+  (defn day-of-week [^GregorianCalendar cal] (.get cal Calendar/DAY_OF_WEEK))
+  (defn hour [^GregorianCalendar cal] (.get cal Calendar/HOUR))
+  (defn minute [^GregorianCalendar cal] (.get cal Calendar/MINUTE))
+  (defn second [^GregorianCalendar cal] (.get cal Calendar/SECOND))
+
+  (defn round-to-year
+    [epoch]
+    (let [cal (epoch->cal epoch)]
+      (doto cal
+        (.add Calendar/MONTH 6)
+        (clear-month))))
+
+  (defn round-to-month
+    [epoch]
+    (doto (epoch->cal epoch)
+      (.setTimeInMillis (long epoch))
+      (.add Calendar/DAY_OF_MONTH 16)
+      (clear-day-of-month)))
+
+  (defn round-to-week
+    [epoch]
+    (doto (epoch->cal epoch)
+      (.setTimeInMillis (long epoch))
+      (.add Calendar/DAY_OF_WEEK 4)
+      (clear-day-of-week)))
+
+  (defn round-to-day-of-month
+    [epoch]
+    (doto (epoch->cal epoch)
+      (.add Calendar/HOUR 12)
+      (clear-hour)))
+
+  (defn round-to-day-of-week
+    [epoch]
+    (doto (epoch->cal epoch)
+      (.add Calendar/HOUR 12)
+      (clear-hour)))
+
+  (defn round-to-hour
+    [epoch]
+    (doto (epoch->cal epoch)
+      (.add Calendar/MINUTE 30)
+      (clear-minute)))
+#+END_SRC
+
 ** Complete namespace definitions
 
 #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/geom/viz/core.cljc :noweb yes :mkdirp yes :padline no