Add virtual dimmers, issue #43

src/afterglow/channels.clj

@@ -74,6 +74,27 @@
   [fixtures pred]
   (filter #(some pred (:channels %)) (expand-heads fixtures)))
 
+(defn find-rgb-heads
+  "Returns all heads of the supplied fixtures which are capable of
+  mixing RGB color, in other words they have at least a red, green,
+  and blue color channel. If the second argument is present and
+  `true`, also returns heads with color wheels."
+  ([fixtures]
+   (find-rgb-heads fixtures false))
+  ([fixtures include-color-wheels?]
+   (filter #(or (= 3 (count (filter #{:red :green :blue} (map :color (:channels %)))))
+                (and include-color-wheels? (seq (:color-wheel-hue-map %))))
+           (expand-heads fixtures))))
+
+(defn has-rgb-heads?
+  "Given a fixture, returns a truthy value if it has any heads capable
+  of mixing RGB color. If the second argument is present and `true`,
+  having a head with a color wheel is good enough."
+  ([fixture]
+   (has-rgb-heads? fixture false))
+  ([fixture include-color-wheels?]
+   (seq (find-rgb-heads [fixture] include-color-wheels?))))
+
 (defn build-function
   "Returns a function spefication that encompasses a range of possible
   DMX values for a channel. If start and end are not specified, the

src/afterglow/effects/color.clj

@@ -16,6 +16,35 @@
             [taoensso.timbre.profiling :refer [pspy]])
   (:import (afterglow.effects Assigner Effect)))
 
+(defn find-rgb-heads
+  "In version 0.1.6 this was moved to the `afterglow.channels` namespace,
+  and this stub was left for backwards compatibility, but is deprecated
+  and will be removed in a future release.
+
+  Returns all heads of the supplied fixtures which are capable of mixing
+  RGB color, in other words they have at least a red, green, and blue
+  color channel. If the second argument is present and `true`, also
+  returns heads with color wheels."
+  {:deprecated "0.1.6"}
+  ([fixtures]
+   (find-rgb-heads fixtures false))
+  ([fixtures include-color-wheels?]
+   (channels/find-rgb-heads fixtures include-color-wheels?)))
+
+(defn has-rgb-heads?
+  "In version 0.1.6 this was moved to the `afterglow.channels` namespace,
+  and this stub was left for backwards compatibility, but is deprecated
+  and will be removed in a future release.
+
+  Given a fixture, returns a truthy value if it has any heads capable
+  of mixing RGB color. If the second argument is present and `true`,
+  having a head with a color wheel is good enough."
+  {:deprecated "0.1.6"}
+  ([fixture]
+   (has-rgb-heads? fixture false))
+  ([fixture include-color-wheels?]
+   (channels/has-rgb-heads? fixture include-color-wheels?)))
+
 (defn htp-merge
   "Helper function for assigners that want to use
   highest-takes-priority blending for RGB colors. Returns a color
@@ -29,27 +58,6 @@
       (colors/create-color :r red :g green :b blue))
     current))
 
-(defn find-rgb-heads
-  "Returns all heads of the supplied fixtures which are capable of
-  mixing RGB color, in other words they have at least a red, green,
-  and blue color channel. If the second argument is present and
-  `true`, also returns heads with color wheels."
-  ([fixtures]
-   (find-rgb-heads fixtures false))
-  ([fixtures include-color-wheels?]
-   (filter #(or (= 3 (count (filter #{:red :green :blue} (map :color (:channels %)))))
-                (and include-color-wheels? (seq (:color-wheel-hue-map %))))
-           (channels/expand-heads fixtures))))
-
-(defn has-rgb-heads?
-  "Given a fixture, returns a truthy value if it has any heads capable
-  of mixing RGB color. If the second argument is present and `true`,
-  having a head with a color wheel is good enough."
-  ([fixture]
-   (has-rgb-heads? fixture false))
-  ([fixture include-color-wheels?]
-   (seq (find-rgb-heads [fixture] include-color-wheels?))))
-
 (defn build-htp-color-assigner
   "Returns an assigner that applies highest-takes-precedence color
   mixing of a dynamic color parameter to the supplied head or fixture.
@@ -88,7 +96,7 @@
   [name color fixtures & {:keys [include-color-wheels? htp?]}]
   {:pre [(some? *show*) (some? name) (sequential? fixtures)]}
   (params/validate-param-type color :com.evocomputing.colors/color)
-  (let [heads (find-rgb-heads fixtures include-color-wheels?)
+  (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*))]
@@ -200,7 +208,7 @@
   also be transformed."
   [fixtures & {:keys [transform-fn beyond-server] :or {transform-fn (build-saturation-transformation)
                                                        beyond-server nil}}]
-  (let [heads (find-rgb-heads fixtures)
+  (let [heads (channels/find-rgb-heads fixtures)
         f (fn [show snapshot target previous-assignment]  ;; Assigners for regular light colors; have heads
             (pspy :transform-colors
                   (when-let [resolved (params/resolve-param previous-assignment show snapshot target)]

src/afterglow/effects/dimmer.clj

@@ -28,12 +28,12 @@
   (:require [afterglow.channels :as channels]
             [afterglow.effects.channel :as chan-fx]
             [afterglow.effects.params :as params]
-            [afterglow.effects :refer [always-active end-immediately]]
+            [afterglow.effects :as fx :refer [always-active end-immediately]]
             [afterglow.rhythm :refer [metro-snapshot]]
             [afterglow.show-context :refer [*show*]]
             [afterglow.util :refer [valid-dmx-value?]]
-            [com.evocomputing.colors :refer [clamp-percent-float
-                                             clamp-rgb-int]]
+            [com.evocomputing.colors :as colors :refer [clamp-percent-float
+                                                        clamp-rgb-int]]
             [taoensso.timbre.profiling :refer [pspy]]
             [taoensso.timbre :as timbre])
   (:import (afterglow.effects Effect)))
@@ -64,6 +64,16 @@
              (not= :dimmer (:type (first dimmer))))
           (channels/expand-heads fixtures)))
 
+(defn gather-no-dimmer-rgb-heads
+  "Finds all the RGB heads from the supplied fixture list which have
+  no dimmer capability at either the head or fixture level. These
+  heads are suitable for creating virtual dimmer effects when
+  desired."
+  [fixtures]
+  (let [no-dimmers (filter #(not (:dimmer (into #{} (mapcat keys (map :function-map (channels/expand-heads [%]))))))
+                           fixtures)]
+    (channels/find-rgb-heads no-dimmers)))
+
 (defonce
   ^{:private true
     :doc "Protect protocols against namespace reloads"}
@@ -111,9 +121,10 @@
 
 (defn- build-parameterized-dimmer-effect
   "Returns an effect which assigns a dynamic value to all the supplied
-  dimmers (which are broken into two lists: full dedicated dimmer
-  channels, and heads that have a dimmer function on a multipurpose
-  channel).
+  dimmers (which are broken into three lists: full dedicated dimmer
+  channels, heads that have a dimmer function on a multipurpose
+  channel, and RGB heads with no dimmer at all that should be assigned
+  a virtual dimmer effect).
 
   If `htp?` is true, applies highest-takes-precedence (i.e. compares
   the value to the previous assignment for the channel, and lets the
@@ -122,24 +133,35 @@
   All dimmer cues are associated with a master chain which can scale
   down the values to which they are set. If none is supplied when
   creating the dimmer cue, the show's grand master is used."
-  [name level show full-channels function-heads htp? master]
+  [name level show full-channels function-heads virtual-heads htp? master]
   (params/validate-param-type master Master)
   (let [full-f (if htp?  ; Assignment function for dedicated dimmer channels
                  (fn [show snapshot target previous-assignment]
                    (clamp-rgb-int (max (master-scale master (params/resolve-param level show snapshot))
-                                       (or previous-assignment 0))))
+                                       (or (params/resolve-param previous-assignment show snapshot) 0))))
                  (fn [show snapshot target previous-assignment]
                    (clamp-rgb-int (master-scale master (params/resolve-param level show snapshot)))))
         full-assigners (chan-fx/build-raw-channel-assigners full-channels full-f)
         func-f (if htp?  ; Assignment function for dimmer functions on multipurpose channels
                  ;; We must scale dimmer level from 0-255 to 0-100, since function effects use percentages.
                  (fn [show snapshot target previous-assignment]
                    (max (/ (master-scale master (params/resolve-param level show snapshot)) 2.55)
-                        (or previous-assignment 0)))
+                        (or (params/resolve-param previous-assignment show snapshot) 0)))
                  (fn [show snapshot target previous-assignment]
                    (/ (master-scale master (params/resolve-param level show snapshot)) 2.55)))
-        func-assigners (chan-fx/build-head-function-assigners :dimmer function-heads func-f)]
-    (Effect. name always-active (fn [show snapshot] (concat full-assigners func-assigners)) end-immediately)))
+        func-assigners (chan-fx/build-head-function-assigners :dimmer function-heads func-f)
+        virtual-f (fn [show snapshot target previous-assignment]
+                    (when previous-assignment
+                      (let [resolved (params/resolve-param previous-assignment show snapshot target)
+                            fraction (/ (master-scale master (params/resolve-param level show snapshot)) 255)]
+                        (colors/create-color :h (colors/hue resolved)
+                                             :s (colors/saturation resolved)
+                                             :l (clamp-percent-float (* (colors/lightness resolved) fraction))
+                                             :a (colors/alpha resolved)))))
+        virtual-assigners (fx/build-head-assigners :color virtual-heads virtual-f)]
+    (Effect. name always-active
+             (fn [show snapshot] (concat full-assigners func-assigners virtual-assigners))
+             end-immediately)))
 
 (defn dimmer-effect
   "Returns an effect which assigns a dynamic value to all the supplied
@@ -156,17 +178,32 @@
   defined over only part of a multi-purpose channel, where the
   function `:type` is `:dimmer`, and the channel `:type` must be
   something else. A single head cannot have both types of dimmer,
-  since a function can only exist on one channel in a given head."
-  [level fixtures & {:keys [htp? master effect-name] :or {htp? true master (:grand-master *show*)}}]
-  {:pre [(some? *show*)]}
+  since a function can only exist on one channel in a given head.
+
+  If you have any fixtures that are capable of RGB color mixing, but
+  lack dedicated dimmer channels, you can have this effect simulate a
+  dimmer channel for those fixtures by passing a `true` value with
+  `add-virtual-dimmers?`. The virtual dimmer works by modifying any
+  color effect that has already run for those fixtures, to reduce the
+  brightness of the color being assigned. To do that, this dimmer
+  effect needs to run at a higher effect priority than any color
+  effect you want it to modify, so be sure to add it to your show with
+  an appropriate priority value. Virtual dimmers are incompatible with
+  hightest-takes-precedence dimming, because there is no actual
+  previous dimmer value for them to work with, so you cannot use both
+  `htp?` and `add-virtual-dimmers` at the same time."
+  [level fixtures & {:keys [htp? master effect-name add-virtual-dimmers?]
+                     :or {htp? true master (:grand-master *show*)}}]
+  {:pre [(some? *show*) (not (and htp? add-virtual-dimmers?))]}
   (let [level (params/bind-keyword-param level Number 255)
         master (params/bind-keyword-param master Master (:grand-master *show*))]
     (let [full-channels (gather-dimmer-channels fixtures)
           function-heads (gather-partial-dimmer-function-heads fixtures)
+          virtual-heads (when add-virtual-dimmers? (gather-no-dimmer-rgb-heads fixtures))
           snapshot (metro-snapshot (:metronome *show*))
           level (params/resolve-unless-frame-dynamic level *show* snapshot)
           master (params/resolve-param master *show* snapshot)  ; Can resolve now; value is inherently static.
           label (if (params/param? level) "<dynamic>" level)]
       (build-parameterized-dimmer-effect (or effect-name (str "Dimmers=" label (when htp? " (HTP)")))
-                                         level *show* full-channels function-heads htp? master))))
+                                         level *show* full-channels function-heads virtual-heads htp? master))))
 

src/afterglow/effects/fun.clj

@@ -2,7 +2,8 @@
   "A collection of neat effects that are both useful in shows, and
   examples of how to create such things."
   {:author "James Elliott"}
-  (:require [afterglow.effects :as fx]
+  (:require [afterglow.channels :as channels]
+            [afterglow.effects :as fx]
             [afterglow.effects.channel :as chan-fx]
             [afterglow.effects.color :as color-fx]
             [afterglow.effects.dimmer :as dimmer-fx]
@@ -57,7 +58,7 @@
     (params/validate-param-type down-beat-color :com.evocomputing.colors/color)
     (params/validate-param-type other-beat-color :com.evocomputing.colors/color)
     (params/validate-param-type metronome Metronome)
-    (let [heads (color-fx/find-rgb-heads fixtures)
+    (let [heads (channels/find-rgb-heads fixtures)
           running (atom true)
           ;; Need to use the show metronome as a snapshot to resolve our metronome parameter first
           metronome (params/resolve-param metronome *show* (rhythm/metro-snapshot (:metronome *show*)))
@@ -127,7 +128,7 @@
   (let [color (params/bind-keyword-param color :com.evocomputing.colors/color default-sparkle-color)
         chance (params/bind-keyword-param chance Number 0.001)
         fade-time (params/bind-keyword-param fade-time Number 500)]
-    (let [heads (color-fx/find-rgb-heads fixtures)
+    (let [heads (channels/find-rgb-heads fixtures)
           running (atom true)
           sparkles (atom {})  ; A map from head to creation timestamp for active sparkles
           snapshot (rhythm/metro-snapshot (:metronome *show*))
@@ -194,7 +195,7 @@
   (let [chance (params/bind-keyword-param chance Number 0.001)
         fade-time (params/bind-keyword-param fade-time Number 500)
         master (params/bind-keyword-param master Master (:grand-master *show*))
-        fixtures (if include-rgb-fixtures? fixtures (filter (complement color-fx/has-rgb-heads?) fixtures))]
+        fixtures (if include-rgb-fixtures? fixtures (filter (complement channels/has-rgb-heads?) fixtures))]
     (let [full-channels (dimmer-fx/gather-dimmer-channels fixtures)
           function-heads (dimmer-fx/gather-partial-dimmer-function-heads fixtures)
           running (atom true)
@@ -418,7 +419,7 @@
                          color-cycle default-color-cycle)]
     (doseq [arg color-cycle]
       (params/validate-param-type arg :com.evocomputing.colors/color))
-    (let [heads (color-fx/find-rgb-heads fixtures)
+    (let [heads (channels/find-rgb-heads fixtures)
           ending (atom nil)
           color-cycle (map #(params/resolve-unless-frame-dynamic % *show* (rhythm/metro-snapshot (:metronome *show*)))
                            color-cycle)

src/afterglow/examples.clj

@@ -109,8 +109,10 @@
   parameters exist, it can vary in response to a MIDI mapped show
   variable, an oscillator, or the location of the fixture. You can
   override the default name by passing in a value with :effect-name"
-  [level & {:keys [effect-name]}]
-  (dimmer-effect level (show/all-fixtures) :effect-name effect-name))
+  [level & {:keys [effect-name add-virtual-dimmers?]}]
+  (let [htp? (not add-virtual-dimmers?)]
+    (dimmer-effect level (show/all-fixtures) :effect-name effect-name :htp? htp?
+                   :add-virtual-dimmers? add-virtual-dimmers?)))
 
 (defn fiat-lux
   "Start simple with a cool blue color from all the lights."

test/afterglow/effects/color_test.clj

@@ -8,4 +8,4 @@
 
 (deftest test-extract-rgb
   (testing "Finding RGB color channels")
-  (is (= [:12-channel] (map :mode (#'afterglow.effects.color/find-rgb-heads [(chauvet/slimpar-hex3-irc)])))))
+  (is (= [:12-channel] (map :mode (channels/find-rgb-heads [(chauvet/slimpar-hex3-irc)])))))