Working on stepinator - monophonic sequencer.

* starting on basic color theme support
* fixing ir? check function so duty works with a numeric reset argument
* trying (unsuccessfully) to get adjustment-popup working with stepinator
 - (Dave Ray, help! ;-)
* using with-error-log to catch exceptions in swing thread handlers

examples/gui.clj

@@ -1,6 +1,8 @@
 (ns examples.gui
   (:use overtone.core
-        [overtone.gui info control wavetable sequencer mixer]
+        [overtone.gui
+           info control wavetable sequencer mixer
+           stepinator]
         [overtone.inst synth drum]))
 
 ; Show the server info window
@@ -65,5 +67,38 @@
 (m :bpm 128)
 (step-sequencer m 8 ks1 ping)
 
-(use 'overtone.gui.mixer)
+; Create a mixer for all currently defined instruments
 (mixing-console)
+
+; Bring up a monophonic step sequencer
+(def pstep (stepinator))
+
+;  * parameters used in synthdefs
+(definst step-pad
+  [note 60 amp 0.7 attack 0.009 release 0.6]
+  (let [freq  (midicps note)
+        env   (env-gen (perc attack release) :action FREE)
+        f-env (+ freq (* 3 freq (env-gen (perc 0.012 (- release 0.1)))))
+        bfreq (/ freq 2)
+        mod-seq (demand (
+        sig   (apply +
+                     (concat (* 0.7 (sin-osc [bfreq (* 0.99 bfreq)]))
+                             (lpf (saw [freq (* freq 1.01)]) f-env)))
+        audio (* amp env sig)]
+    audio))
+
+; You can access the sequence once when creating a synth
+(demo 2
+  (let [note (duty (dseq [0.2 0.1] INF)
+                   0
+                   (dseq (map #(+ 60 %) (:steps @(:state pstep)))))
+        src (saw (midicps note))]
+    (* [0.2 0.2] src)))
+
+; or access the sequence steps in a player function
+(defn step-player [b]
+  (at (m b)
+      (bar (+ 60 (nth (:steps @(:state pstep)) (mod b 16)))))
+  (apply-at (m (inc b)) #'step-player [(inc b)]))
+
+(step-player (m))

src/overtone/gui/adjustment_popup.clj

@@ -1,5 +1,6 @@
 (ns overtone.gui.adjustment-popup
-  (:use [seesaw core color font])
+  (:use [seesaw core color font]
+        [overtone.util log])
   (:require [seesaw.bind :as bind])
   (:import javax.swing.JWindow))
 
@@ -9,51 +10,54 @@
 (def ^{:private true} label-font (font :name "Arial" :size 14 :style :bold))
 (def ^{:private true} value-font (font :name "Arial" :size 14 :style :bold))
 
-(defn adjustment-popup-for
+(defn adjustment-popup
   "Create a temporary popup window showing a changing value for a bindable widget.
 
   Example:
-    (adjustment-popup-for widget \"Volume:\")
+  (adjustment-popup widget \"Volume:\")
   "
-  [widget popup-label]
+  [& {:keys [widget label value bindable]
+      :or {label "Value:" value "0.0"}}]
   (invoke-now
-    (let [popup (JWindow.)
-          txt-label (label :id :popup-label :text popup-label :font label-font)
-          val-label (label :id :popup-value :text (value widget) :font value-font
-                           :foreground (color 0 140 236))
-          body (border-panel :border BORDER
-                 :north txt-label
-                 :center (flow-panel :align :center :items [val-label]))]
-      (doto popup
-        (.setBackground (color :black))
-        (.add body)
-        (.pack))
-      (bind/bind widget val-label)
-      (listen widget
-              :mouse-pressed (fn [ev]
-                               (let [{:keys [x y]} (bean (.getLocationOnScreen widget))
-                                     w (.getWidth widget)
-                                     h (.getHeight widget)
-                                     popup-y (- (+ y (/ h 2)) (/ (.getHeight popup) 2))
-                                     popup-x (+ x w OFFSET)]
-                                 (move! popup :to [popup-x popup-y])
-                                 (show! popup)))
-              :mouse-released (fn [_]
-                                (hide! popup)))
-      (bind/bind widget (bind/b-do [_] (repaint! widget)))
-      popup)))
-
+    (with-error-log "adjustment-popup"
+                    (let [popup (JWindow.)
+                          txt-label (seesaw.core/label :id :popup-label :text label :font label-font)
+                          val-label (seesaw.core/label :id :popup-value :text value
+                                                       :font value-font
+                                                       :foreground (color 0 140 236))
+                          body (border-panel :border BORDER
+                                             :north txt-label
+                                             :center (flow-panel :align :center :items [val-label]))
+                          bindable (or bindable widget)]
+                      (doto popup
+                        (.setBackground (color :black))
+                        (.add body)
+                        (.pack))
+                      (bind/bind bindable val-label)
+                      (listen widget
+                              :mouse-pressed (fn [ev]
+                                               (let [{:keys [x y]} (bean (.getLocationOnScreen widget))
+                                                     w (.getWidth widget)
+                                                     h (.getHeight widget)
+                                                     popup-y (- (+ y (/ h 2)) (/ (.getHeight popup) 2))
+                                                     popup-x (+ x w OFFSET)]
+                                                 (move! popup :to [popup-x popup-y])
+                                                 (show! popup)))
+                              :mouse-released (fn [_]
+                                                (hide! popup)))
+                      ;(bind/bind bindable (bind/b-do [_] (repaint! widget)))
+                      popup))))
 
 (comment
 
 (require '[seesaw.core :as saw])
 (use 'overtone.gui.adjustment-popup)
 (use 'overtone.gui.dial)
 (def s (saw/slider :value 50 :min 0 :max 100 :orientation :vertical))
-(def s-adj (adjustment-popup-for s "Value:"))
+(def s-adj (adjustment-popup s "Value:"))
 
 (def d (dial :value 50 :min 0 :max 100))
-(def d-adj (adjustment-popup-for d "Pan:"))
+(def d-adj (adjustment-popup d "Pan:"))
 (def f (saw/frame :title "testing" :minimum-size [200 :by 400]
               :content (saw/vertical-panel :items [s d])))
 (saw/show! f)

src/overtone/gui/color.clj

@@ -0,0 +1,53 @@
+(ns overtone.gui.color
+  (:use [seesaw core color]))
+
+(def theme* (atom
+              {
+               :background-fill (color 40 40 40)
+               :background-stroke (color 30 30 30)
+
+               :highlight (color 100 100 255)
+
+               :fill-1 (color 0 130 226 150)
+               :stroke-1 (color 0 140 236)
+
+               :fill-2 (color 170 170 170 150)
+               :stroke-2 (color 170 170 170)
+
+               :fill-3 (color  170 30 30 150)
+               :stroke-3 (color 170 30 30)
+
+               :bounding-box (color 250 20 20 150)
+               }))
+
+(defn theme-color [tag]
+  (get @theme* tag))
+
+(defn adjust-brightness
+  "Adjust color brightness by adding an amount to each of red, green, and blue."
+  ([color amount]
+   (let [{:keys [red green blue]} (bean color)]
+   (color (max 0 (+ red amount))
+           (max 0 (+ green amount))
+           (max 0 (+ blue amount))))))
+
+(defn darken-color
+  "Darken a color in steps of -10 for each of r, g, and b."
+  ([color] (adjust-brightness color 1))
+  ([color factor]
+   (adjust-brightness color (* factor -10))))
+
+(defn lighten-color
+  "Lighten a color in steps of 10 for each of r, g, and b."
+  ([color] (lighten-color color 1))
+  ([color factor]
+   (adjust-brightness color (* factor 10))))
+
+(defn clarify-color
+  "Increase the color transparency in steps of 10."
+  ([color] (clarify-color color 1))
+  ([color factor]
+   (let [r (.getRed color)
+         g (.getGreen color)
+         b (.getBlue color)]
+     (color r g b (- (.getTransparency color) (* factor 10))))))