Color lib swap thi.ng

src/afterglow/effects/channel.clj

@@ -227,12 +227,13 @@
     (math/round (+ (:start function-spec) (* (/ percent 100) range)))))
 
 ;; Resolves the assignment of a level to a named function on a head or fixture.
-(defmethod fx/resolve-assignment :function [assignment show snapshot buffers]
+(defmethod fx/resolve-assignment :function [{:keys [target target-id value]} show snapshot buffers]
   ;; Resolve in case it is frame dynamic
-  (let [target (:target assignment)
-        resolved (params/resolve-param (:value assignment) show snapshot target)
-        [_ function-key] (:target-id assignment)
+  (let [resolved (params/resolve-param value show snapshot target)
+        [_ function-key] target-id
+        id-key (keyword (str (name function-key) "-" (:id target)))
         [channel function-spec] (function-key (:function-map target))]
+    (swap! (:movement *show*) #(assoc-in % [:current id-key] resolved))
     (apply-channel-value buffers channel (function-percentage-to-dmx resolved function-spec))))
 
 ;; Fades between two assignments to a function. Because different functions often share the same channel,

src/afterglow/effects/color.clj

@@ -10,8 +10,11 @@
             [afterglow.rhythm :as rhythm]
             [afterglow.show-context :refer [*show*]]
             [afterglow.util :as util]
+            [afterglow.transform :as tf]
             [clojure.math.numeric-tower :as math]
             [com.evocomputing.colors :as colors]
+            [thi.ng.color.core :as clr]
+            [thi.ng.math.core :as cmath]
             [taoensso.timbre :as timbre]
             [taoensso.tufte :as tufte])
   (:import (afterglow.effects Assigner Effect)))
@@ -23,10 +26,10 @@
   the highest green component, and the highest blue component."
   [previous current]
   (if (some? previous)
-    (let [red (max (colors/red previous) (colors/red current))
-          green (max (colors/green previous) (colors/green current))
-          blue (max (colors/blue previous) (colors/blue current))]
-      (colors/create-color :r red :g green :b blue))
+    (->> (map clr/as-rgba [previous current])
+         (map deref)
+         (apply map max)
+         (apply clr/rgba)) ;get alpha support for free (when we dont need it)! but what about white
     current))
 
 (defn build-htp-color-assigner
@@ -40,13 +43,13 @@
   assignment held the highest."
   [head param show snapshot]
   (let [resolved (params/resolve-unless-frame-dynamic param show snapshot head)]
-    (fx/build-head-assigner :color head
-                            (fn [show snapshot target previous-assignment]
-                              (if (some? previous-assignment)
-                                (let [current (params/resolve-param resolved show snapshot head)
-                                      previous (params/resolve-param previous-assignment show snapshot head)]
-                                  (htp-merge previous current))
-                                resolved)))))
+    (fx/build-head-assigner
+     :color head
+     (fn [show snapshot target previous-assignment]
+       (if (some? previous-assignment)
+         (apply htp-merge (map #(params/resolve-param % show snapshot head)
+                               [previous-assignment resolved])))
+       resolved))))
 
 (defn build-htp-color-assigners
   "Returns a list of assigners which apply highest-takes-precedence
@@ -66,11 +69,11 @@
   assigned to the affected fixtures."
   [name color fixtures & {:keys [include-color-wheels? htp?]}]
   {:pre [(some? *show*) (some? name) (sequential? fixtures)]}
-  (params/validate-param-type color :com.evocomputing.colors/color)
+  (params/validate-param-type color thi.ng.color.core.HSLA)
   (let [heads (channels/find-rgb-heads fixtures include-color-wheels?)
         assigners (if htp?
                     (build-htp-color-assigners heads color *show*)
-                    (fx/build-head-parameter-assigners :color heads color *show*))]
+                    (fx/build-head-parameter-assigners :color heads color *show*))] ;wont support multiple shows like this right?
     (Effect. name fx/always-active (fn [show snapshot] assigners) fx/end-immediately)))
 
 ;;; Multimethod implementations to support color effects
@@ -85,49 +88,47 @@
 ;; saturation must also be at least 40% for the color wheel to be
 ;; considered; that minimum can be adjusted by setting a value in the
 ;; show variable :color-wheel-min-saturation.
-(defmethod fx/resolve-assignment :color [assignment show snapshot buffers]
+(defmethod fx/resolve-assignment :color [{:keys [target value] :as assignment} show snapshot buffers]
   ;; Resolve in case assignment is still frame dynamic
-  (let [target (:target assignment)
-        resolved (params/resolve-param (:value assignment) show snapshot target)
-        color-key (keyword (str "color-" (:id target)))]
+  (let [resolved (params/resolve-param value show snapshot target) ;only taking 0.5 us now...
+        color-key (keyword (str "color-" (:id target)))
+        channels (:channels target)
+        vs (mapv #(int (* 255 %)) @(clr/as-rgba resolved))]
     ;; Start with RGB mixing
-    (doseq [c (filter #(= (:color %) :red) (:channels target))]
-      (chan-fx/apply-channel-value buffers c (colors/red resolved)))
-    (doseq [c (filter #(= (:color %) :green) (:channels target))]
-      (chan-fx/apply-channel-value buffers c (colors/green resolved)))
-    (doseq [c (filter #(= (:color %) :blue) (:channels target))]
-      (chan-fx/apply-channel-value buffers c (colors/blue resolved)))
-    (swap! (:movement *show*) #(assoc-in % [:current color-key] resolved))
+    (doseq [[rgb-key i] {:red 0 :green 1 :blue 2}
+            ch (filter #(= (:color %) rgb-key) channels)]
+      (chan-fx/apply-channel-value buffers ch (vs i)))
+
+  (swap! (:movement *show*) #(assoc-in % [:current color-key] resolved))
     ;; Expermental: Does this work well in bringing in the white channel?
-    (when-let [whites (filter #(= (:color %) :white) (:channels target))]
-      (let [l (/ (colors/lightness resolved) 100)
-            s (/ (colors/saturation resolved) 100)
+  (when-let [whites (filter #(= (:color %) :white) channels)]
+      (let [[l s] (map #(% resolved) [clr/luminance clr/saturation])
             s-scale (if (< l 0.5) 1.0 (- 1.0 (* 2.0 (- l 0.5))))
-            level (* 255.0 l (- 1.0 (* s s-scale)))]
-        (doseq [c whites]
-          (chan-fx/apply-channel-value buffers c level))))
+            level (int (* 255 l (- 1.0 (* s s-scale))))]
+        (doseq [ch whites]
+          (chan-fx/apply-channel-value buffers ch level))))
     ;; Even more experimental: Support other arbitrary color channels
-    (doseq [c (filter :hue (:channels target))]
-      (let [as-if-red (colors/adjust-hue resolved (- (:hue c)))]
-        (chan-fx/apply-channel-value buffers c (colors/red as-if-red))))
+  (doseq [ch (filter :hue channels)]
+      (let [as-if-red (clr/rotate-hue resolved (- (tf/degrees (:hue ch))))]
+        (chan-fx/apply-channel-value buffers ch (int (* 255 (clr/red as-if-red))))))
     ;; Finally, see if there is a color wheel color close enough to select
-    (when (and (seq (:color-wheel-hue-map target))
-               (>= (colors/saturation resolved) (:color-wheel-min-saturation @(:variables show) 40)))
-      (let [found (util/find-closest-key (:color-wheel-hue-map target) (colors/hue resolved))
-            [channel function-spec] (get (:color-wheel-hue-map target) found)]
-        (when (< (math/abs (- (colors/hue resolved) found)) (:color-wheel-hue-tolerance @(:variables show) 60))
+  (when (and (seq (:color-wheel-hue-map target))
+               (>= (clr/saturation resolved) (:color-wheel-min-saturation @(:variables show) 40)))
+      (let [found (util/find-closest-key (:color-wheel-hue-map target) (clr/hue resolved))
+            [channel function-spec] ((:color-wheel-hue-map target) found)]
+        (when (< (math/abs (- (clr/hue resolved) found)) (:color-wheel-hue-tolerance @(:variables show) 60))
           (chan-fx/apply-channel-value buffers channel (chan-fx/function-percentage-to-dmx 50 function-spec)))))))
 
 (def ^:private default-color
   "The color to mix with when fading from a non-assignment."
-  (colors/create-color :black))
+  (clr/as-hsla (apply clr/rgba (map #(/ % 255) (:rgba (colors/create-color :black))))))
 
 (defn- blackened-color
   "Determine the color to fade to when one side of a fade is nil;
   return the fully darkened version of the other color in the fade, if
   there is one, or a default black if both were nil."
   [color]
-  (if color (colors/darken color 100.0) default-color))
+  (if color (clr/adjust-luminance color -1.0) default-color)) ;does nothing on this lib it resets hue but maybe someday
 
 (defn fade-colors
   "Calculate a weighted HSL blend between two colors, which may be
@@ -137,18 +138,17 @@
   ;; Resolve any remaining dynamic parameters now, and make sure fraction really
   ;; does only range between 0 and 1, then convert it to the percentage wanted by
   ;; the colors library.
-  (let [from (params/resolve-param from show snapshot target)
-        to (params/resolve-param to show snapshot target)
-        weight (* 100 (colors/clamp-unit-float fraction))]
+  (let [[from to] (map #(params/resolve-param % show snapshot target) [from to])
+        weight (cmath/clamp fraction 0.0 1.0)]
     ;; Weight goes in the opposite direction you might expect, so the following order works:
-    (colors/mix-hsl (or to (blackened-color from)) (or from (blackened-color to)) weight)))
+    (cmath/mix (or from (blackened-color to)) (or to (blackened-color from)) weight))) ;;nvm comment above
 
 ;; Fades between two color assignments to a fixture or head.
 (defmethod fx/fade-between-assignments :color [from-assignment to-assignment fraction show snapshot]
   (cond (<= fraction 0) from-assignment
         (>= fraction 1) to-assignment
         :else (merge from-assignment {:value (fade-colors (:value from-assignment) (:value to-assignment) fraction
-                                                          show snapshot (:target from-assignment))})))
+                                                          show snapshot (:target from-assignment))}))) ;shouldnt target/head be to-assignment??
 
 ;;; Effects which transform other color effects
 
@@ -162,8 +162,8 @@
   parameter with the `:param` optional keyword argument."
   [& {:keys [param] :or {param (osc/build-oscillated-param (osc/sawtooth :down? true) :max 100)}}]
   (fn [color show snapshot head]
-    (let [saturation (colors/clamp-percent-float (params/resolve-param param show snapshot head))]
-      (colors/create-color {:h (colors/hue color) :s saturation :l (colors/lightness color)}))))
+    (let [saturation (cmath/clamp (params/resolve-param param show snapshot head) 0.0 1.0)]
+      (clr/hsla (clr/hue color) saturation (clr/luminance color) (clr/alpha color)))))
 
 (defn transform-colors
   "Creates an effect which modifies any effect that is currently

src/afterglow/effects/cues.clj

@@ -609,7 +609,7 @@
   cue based on the value of a dynamic parameter. If the parameter
   evaluates to `nil`, the non-dynamic cue color is returned."
   [param]
-  (params/validate-param-type param :com.evocomputing.colors/color)
+  (params/validate-param-type param thi.ng.color.core.HSLA)
   (fn [cue active show snapshot]
     (or (params/evaluate param show snapshot nil) (:color cue))))
 

src/afterglow/effects/params.clj

@@ -12,6 +12,8 @@
             [afterglow.util :as util]
             [clojure.math.numeric-tower :as math]
             [com.evocomputing.colors :as colors]
+            [thi.ng.color.core :as clr]
+            [thi.ng.math.core :as cmath]
             [taoensso.timbre :as timbre :refer [error]])
   (:import [afterglow.rhythm MetronomeSnapshot]
            [javax.media.j3d Transform3D]
@@ -92,6 +94,8 @@
   ([value type-expected name]
    `(when (some? ~value) (check-type ~value ~type-expected ~name))))
 
+(def color-type thi.ng.color.core.HSLA)
+
 (defn param?
   "Checks whether the argument is an [[IParam]]."
   [arg]
@@ -395,22 +399,24 @@
   to the jolby/colors `create-color` function."
   [color]
   (cond (string? color)
-        (colors/create-color color)
+        (clr/as-hsla (apply clr/rgba (map #(/ % 255) (:rgba (colors/create-color color)))))
 
-        (keyword? color)
+        (keyword? color) ;should pass back a bound color??
         color
 
-        (= (type color) :com.evocomputing.colors/color)
+        (= (type color) thi.ng.color.core.HSLA)
+        color
+        (= (type color) :com.evocomputing.colors/color) ;comparing speed
         color
 
-        (satisfies? IParam color)
+        (param? color)
         color
 
         :else
         (throw (IllegalArgumentException. (str "Unable to interpret color parameter:" color)))))
 
-  (def ^:private default-color "The default color for build-color-param."
-    (colors/create-color [0 0 0]))
+(def default-color "The default color for build-color-param (and others)"
+  (clr/as-hsla (apply clr/rgba (map #(/ % 255) (:rgba (colors/create-color :black))))))
 
 (defn build-color-param
   "Returns a dynamic color parameter. If supplied, `:color` is passed

src/afterglow/util.clj

@@ -2,7 +2,7 @@
   "Utility functions that are likely to be widely useful"
   {:author "James Elliott"}
   (:require [clojure.math.numeric-tower :as math]
-            [com.evocomputing.colors :as colors]))
+            [thi.ng.color.core :as clr]))
 
 (defn ubyte
   "Convert small integer to its signed byte equivalent. Necessary for convenient handling of DMX values
@@ -99,10 +99,10 @@
   [color]
   (if (and color
            ;; Calculate the perceived brightness of the color.
-           (let [[r g b] (map #(/ % 255) [(colors/red color) (colors/green color) (colors/blue color)])]
+           (let [[r g b] @(clr/as-rgba color)]
              (> (Math/sqrt (+ (* 0.299 r r) (* 0.587 g g) (* 0.114 b b))) 0.6)))
-    "#000"
-    "#fff"))
+    "#222"
+    "#edc"))
 
 (defn normalize-cue-variable-value
   "Given a raw value that has been looked up for a cue variable,

src/afterglow/web/routes/show_control.clj

@@ -14,7 +14,9 @@
             (clj-time core format coerce)
             [clojure.string :as string]
             [com.evocomputing.colors :as colors]
-            [overtone.at-at :refer [now]]
+            [thi.ng.color.core :as clr]
+            [org.httpkit.server :refer [with-channel on-receive on-close]]
+            [overtone.at-at :refer [now after]]
             [ring.middleware.anti-forgery :refer [*anti-forgery-token*]]
             [ring.util.response :refer [response]]
             [selmer.parser :as parser]
@@ -28,21 +30,21 @@
   [show active-keys cue cue-effect held? snapshot]
   (let [ending (and cue-effect (:ending cue-effect))
         color (cues/current-cue-color cue cue-effect show snapshot)
-        l-boost (if (zero? (colors/saturation color)) 10.0 0.0)]
-    (colors/create-color
-     :h (colors/hue color)
+        l-boost (if (zero? (clr/saturation color)) 0.1 0.0)
      ;; Figure the lightness. Held cues are the lightest, followed by active, non-ending
      ;; cues. When ending, cues blink between middle and low. If they are not active,
      ;; they are at middle lightness unless there is another active effect with the same
      ;; keyword, in which case they are dim.
-     :s (colors/saturation color)
-     :l (+ (if cue-effect
-             (if ending
-               (if (> (rhythm/snapshot-beat-phase snapshot) 0.4) 25.0 50.0)
-               (if held? 90.0 80.0))
-             (if (or (active-keys (:key cue))
-                     (seq (clojure.set/intersection active-keys (set (:end-keys cue))))) 25.0 50.0))
-           l-boost))))
+        l (+ (if cue-effect
+               (if ending
+                 (if (> (rhythm/snapshot-beat-phase snapshot) 0.4) 0.25 0.50)
+                 (if held? 0.90 0.80))
+               (if (or (active-keys (:key cue))
+                       (seq (clojure.set/intersection active-keys (set (:end-keys cue))))) 0.25 0.50))
+                l-boost)]
+    (clr/hsla (clr/hue color) (clr/saturation color) l)))
+
+(defn rgb-hexstr [color] @(-> color clr/as-int24 clr/as-css))
 
 (defn cue-view
   "Returns a nested structure of rows of cue information starting at the
@@ -63,7 +65,7 @@
            (let [held? (and holding (= holding [x y (:id active)]))
                  color (current-cue-color show active-keys cue active held? snapshot)]
              (assoc cue :current-color color
-                    :style-color (str "style=\"background-color: " (colors/rgb-hexstr color)
+                    :style-color (str "style=\"background-color: " (rgb-hexstr color)
                                       "; color: " (util/contrasting-text-color color) "\"")))
            ;; No actual cue found, start with an empty map
            {})
@@ -223,7 +225,7 @@
           :var (merge {:name (name (:key v))}
                       (select-keys v [:key :name :min :max :type]))
           :value (case (:type v)
-                   :color (when value (colors/rgb-hexstr value))
+                   :color (when value (rgb-hexstr value))
                    value)})))))
 
 (defn- cue-var-changes
@@ -393,7 +395,7 @@
                                                 {:id (:id cell)
                                                  :name (:name cell)
                                                  :color (if (:current-color cell)
-                                                          (colors/rgb-hexstr (:current-color cell))
+                                                          (rgb-hexstr (:current-color cell))
                                                           "")
                                                  :textColor (util/contrasting-text-color (:current-color cell))})))))]
     (record-page-grid page-id grid left bottom width height)
@@ -593,8 +595,8 @@
   [cues-with-vars]
   (mapv (fn [[x y vars]]
           [x y (reduce (fn [r [k v]]
-                         (assoc r k (if (= (type v) :com.evocomputing.colors/color)
-                                      (list 'colors/create-color (str \" (colors/rgb-hexstr v) \"))
+                         (assoc r k (if (= (type v) thi.ng.color.core.HSLA)
+                                      (list 'clr/hsla (str \" (rgb-hexstr v) \"))
                                       v))) {} vars)])
         cues-with-vars))
 
@@ -706,7 +708,7 @@
           var-spec (some #(when (= (name (:key %)) var-key) %) (:variables cue))]
       (when (every? some? [cue var-spec value])
         (let [value (case (:type var-spec)
-                      :color (colors/create-color value)
+                      :color (clr/as-hsla (clr/css value))
                       :boolean (Boolean/valueOf value)
                       :integer (Integer/valueOf value)
                       (Double/valueOf value))]