Merge branch 'master' of github.com:overtone/overtone

README.md

@@ -1,3 +1,4 @@
+
           _,,ddP"""Ybb,,_
         ,dP"'         `"Yb
       ,d"                 .gPPRg,
@@ -13,7 +14,6 @@
           `""YbbgggddP""'         Y88P    "Y8888  888      "Y888 "Y88P"  888  888  "Y8888
 
 
-
 # Programmable Music.
 
 ## Live-coding & musical exploration

src/overtone/gui/adjustment_popup.clj

@@ -0,0 +1,61 @@
+(ns overtone.gui.adjustment-popup
+  (:use [seesaw core color font])
+  (:require [seesaw.bind :as bind])
+  (:import javax.swing.JWindow))
+
+(def ^{:private true} OFFSET 12)
+(def ^{:private true} BORDER 8)
+
+(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
+  "Create a temporary popup window showing a changing value for a bindable widget.
+
+  Example:
+    (adjustment-popup-for widget \"Volume:\")
+  "
+  [widget popup-label]
+  (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)))
+
+
+(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 d (dial :value 50 :min 0 :max 100))
+(def d-adj (adjustment-popup-for 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/control.clj

@@ -1,9 +1,9 @@
 (ns overtone.gui.control
-  (:use [overtone.gui dial]
-        [seesaw core mig])
+  (:use [overtone.gui dial spinner-label]
+        [seesaw core mig]
+        [seesaw.border :only [line-border]])
   (:require [seesaw.bind :as bind]))
 
-(native!)
 
 (defn scale-val [[from-min from-max] [to-min to-max] v]
   (let [from-min (double from-min)
@@ -23,8 +23,11 @@
                                    :from (double min-val) 
                                    :to (double max-val) 
                                    :by (double step))
-        spinner     (spinner :class :synth-control-spinner
-                             :model spin-model)
+        spinner     (spinner-label
+                      :class :synth-control-spinner
+                      :halign :center
+                      :border (line-border :thickness 1 :color :darkgrey)
+                      :model spin-model)
         slider-max  (int (/ (- max-val min-val) step))
         scaled-init (scale-val [min-val max-val] [0 slider-max] init-val)
         slider      (slider :class :synth-control-slider
@@ -102,9 +105,9 @@
     (let [panels  (map synth-controller-panel synths)
           cleanup (apply juxt (map :cleanup panels))
           frame (frame :title "Synth Controllers"
-                       :content (vertical-panel 
+                       :content (scrollable (vertical-panel 
                                   :border 5
-                                  :items (map :panel panels))
+                                  :items (map :panel panels)))
                        :on-close :dispose)]
       ; When the window is closed, unhook everything from the synth
       ; so the ui can be garbage collected, etc.

src/overtone/gui/mixer.clj

@@ -2,6 +2,7 @@
   (:use [seesaw core border]
         overtone.studio.mixer
         overtone.gui.dial
+        overtone.gui.adjustment-popup
         [overtone.libs event])
   (:require [seesaw.bind :as bind]))
 
@@ -14,10 +15,10 @@
 
 (defn- mixing-channel
   [ins]
-  (let [v-slider (slider :value (* @(:volume ins) 100.0) :min 0 :max 100
+  (let [volume-slider (slider :value (* @(:volume ins) 100.0) :min 0 :max 100
                     :orientation :vertical)
-        vsp (border-panel :center v-slider)
-        p-slider (dial :size [45 :by 45] :min -100 :max 100 :value (* @(:pan ins)))
+        vsp (border-panel :center volume-slider)
+        pan-dial (dial :size [45 :by 45] :min -100 :max 100 :value (* @(:pan ins)))
         mute-state (atom false)
         mute-toggle #(if @mute-state
                        (do
@@ -30,14 +31,16 @@
                                (button :text "M"
                                        :listen [:action mute-toggle]))
         solo-btn (border-panel :center (button :text "S"))]
-    (bind/bind v-slider
+    (adjustment-popup-for volume-slider "Volume:")
+    (adjustment-popup-for pan-dial "Pan:")
+    (bind/bind volume-slider
                (bind/transform (fn [v] (/ v 100.0)))
                (bind/b-do [v] (inst-volume ins v)))
-    (bind/bind p-slider
+    (bind/bind pan-dial
                (bind/transform (fn [p] (/ p 100.0)))
                (bind/b-do [p] (inst-pan ins p)))
     (vertical-panel :size [CHAN-WIDTH :by CHAN-HEIGHT] :border (to-border (inst-name ins))
-                    :items [vsp p-slider mute-btn solo-btn])))
+                    :items [vsp pan-dial mute-btn solo-btn])))
 
 (defn mixing-console
   ([] (mixing-console (vals @instruments*)))

src/overtone/gui/spinner_label.clj

@@ -0,0 +1,107 @@
+(ns overtone.gui.spinner-label
+  (:use [seesaw.core]
+        [seesaw.behave :only [when-mouse-dragged]]
+        [seesaw.meta :only [get-meta put-meta!]]
+        [seesaw.options :only [apply-options option-map default-option]]
+        [seesaw.keymap :only [map-key]]
+        [seesaw.widget-options :only [WidgetOptionProvider]]
+        [seesaw.value :only [Value value* value!*]]
+        [seesaw.selection :only [Selection]])
+  (:require [seesaw.bind :as bind]))
+
+(defn spinner-label-proxy []
+  (proxy [javax.swing.JLabel] []))
+
+(def ^{:private true} SpinnerLabelClass (class (spinner-label-proxy)))
+
+(defn- make-state [this]
+  { :model (atom nil)
+    :unbind (atom (fn []))
+    :update (fn [v this]
+              (.setText
+                this
+                (if (number? v)
+                  (format "%.2f" v) ; TODO make format configurable
+                  (str v))))})
+
+(defn- get-model [this] @(:model (get-meta this ::state)))
+(defn- set-model [this m]
+  (let [{:keys [model unbind update]} (get-meta this ::state)]
+    (@unbind)
+    (reset! model m)
+    (reset! unbind (bind/bind m (bind/b-do* update this)))
+    (update (.getValue m) this)))
+
+(defn spinner-label
+  "Same API as #'seesaw.core/spinner, but only a label is displayed and the
+  current value is modified by dragging the mouse up and down over it."
+  [& opts]
+  (let [widget (spinner-label-proxy)
+        state  (make-state widget)]
+    (put-meta! widget ::state state)
+    (set-model widget (spinner-model 0.0))
+    (when-mouse-dragged
+      widget
+      :start (fn [_]
+               (config! widget :background :lightyellow))
+      :drag (fn [e [dx dy]]
+              (let [m @(:model state)
+                    next (.getNextValue m)
+                    prev (.getPreviousValue m)]
+                (cond
+                  (and next (neg? dy)) (.setValue m next)
+                  (and prev (pos? dy)) (.setValue m prev))))
+      :finish (fn [_]
+                (-> widget
+                  (config! :opaque? false)
+                  repaint!)))
+    (apply-options
+      widget
+      (concat
+        [:cursor :n-resize
+         :tip "Drag to adjust"]
+        opts))
+    widget))
+
+(def spinner-label-options
+  (merge
+    label-options
+    (option-map
+      (default-option :model
+        set-model
+        get-model
+        "A spinner-model"))))
+
+(extend-type (do SpinnerLabelClass)
+  WidgetOptionProvider
+    (get-widget-option-map* [this] [spinner-label-options])
+    (get-layout-option-map* [this] nil)
+
+  Value
+    (container?* [this] false)
+    (value* [this] (.getValue (get-model this)))
+    (value!* [this v] (.setValue (get-model this) v))
+
+  Selection
+    (get-selection [this] [(value this)])
+    (set-selection [this [v]] (value! this v))
+
+  bind/ToBindable
+    (to-bindable* [this] (config this :model)))
+
+(comment
+  (use 'overtone.gui.spinner-label
+       'seesaw.core
+       'seesaw.border
+       'seesaw.dev)
+  (require '[seesaw.bind :as bind])
+  (def sl (spinner-label
+            :id :my-spin-label
+            :halign :center
+            :border [(line-border :color :darkgrey :thickness 1)]
+            :model (spinner-model 10.0 :from 0.0 :to 100.0 :by 0.5)))
+  (selection! sl 99.5)
+  (bind/bind sl (bind/b-do [v] (println "new value " (value sl) ", " (selection sl))))
+  (-> (frame :content sl) pack! show!)
+  )
+

src/overtone/inst/drum.clj

@@ -123,7 +123,7 @@
 (definst soft-hat
   [freq   {:default 6000 :min 3000 :max 12000 :step 1}
    amp    {:default 0.3 :min 0.001 :max 1 :step 0.01}
-   attack {:default 0.0001 :min 0.1 :max 1.0 :step 0.01}
+   attack {:default 0.0001 :min 0.0001 :max 1.0 :step 0.01}
    decay  {:default 0.1 :min 0.1 :max 1.0 :step 0.01}]
   (let [env (env-gen (perc attack decay) :action FREE)
         noiz (bpf (* amp (gray-noise)) freq 0.3)