├── src ├── main │ └── pink │ │ ├── core.clj │ │ ├── Utils.java │ │ ├── node │ │ ├── Message.java │ │ ├── IFnList.java │ │ └── MessageBuffer.java │ │ ├── EngineUtils.java │ │ ├── io │ │ ├── audio.clj │ │ ├── mouse.clj │ │ └── midi.clj │ │ ├── space.clj │ │ ├── config.clj │ │ ├── noise.clj │ │ ├── control.clj │ │ ├── dynamics.clj │ │ ├── Operator.java │ │ ├── effects │ │ ├── ringmod.clj │ │ ├── distortion.clj │ │ ├── chorus.clj │ │ └── reverb.clj │ │ ├── instruments │ │ ├── drums.clj │ │ ├── pluck.clj │ │ └── horn.clj │ │ ├── gen.clj │ │ ├── simple.clj │ │ ├── delays.clj │ │ ├── processes.clj │ │ └── event.clj ├── test │ └── pink │ │ ├── core_test.clj │ │ ├── envelopes_test.clj │ │ ├── control_test.clj │ │ ├── live_code_test.clj │ │ ├── engine_test.clj │ │ ├── filters_test.clj │ │ ├── processes_test.clj │ │ ├── delays_test.clj │ │ ├── event_test.clj │ │ └── util_test.clj ├── demo │ └── pink │ │ └── demo │ │ ├── midi_debug.clj │ │ ├── mouse.clj │ │ ├── demo_tempo.clj │ │ ├── pluck.clj │ │ ├── demo_distortion.clj │ │ ├── demo7.clj │ │ ├── demo_duration.clj │ │ ├── demo6.clj │ │ ├── cache.clj │ │ ├── demo2.clj │ │ ├── demo_node.clj │ │ ├── demo4.clj │ │ ├── demo_piano.clj │ │ ├── demo1.clj │ │ ├── demo3.clj │ │ ├── demo_audio_file_load.clj │ │ ├── demo5.clj │ │ ├── midi.clj │ │ ├── midi_keys.clj │ │ ├── demo9.clj │ │ ├── demo8.clj │ │ ├── processes.clj │ │ ├── demo_feedback.clj │ │ ├── demo_disk.clj │ │ ├── processes_signals.clj │ │ ├── demo_band_limited.clj │ │ ├── demo_effects.clj │ │ ├── live_code_study.clj │ │ └── demo_filters.clj ├── benchmarks │ └── pink │ │ └── benchmark │ │ ├── Benchmark.java │ │ └── benchmark.clj └── plotting │ └── pink │ └── plotting.clj ├── yourkit.png ├── doc ├── architecture.png ├── examples.md ├── intro.md ├── workflow.md ├── terminology.md ├── processes.md ├── architecture.md └── events.md ├── .travis.yml ├── .gitignore ├── mkdocs.yml ├── README.md └── project.clj /src/main/pink/core.clj: -------------------------------------------------------------------------------- 1 | (ns pink.core) 2 | 3 | -------------------------------------------------------------------------------- /yourkit.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kunstmusik/pink/HEAD/yourkit.png -------------------------------------------------------------------------------- /doc/architecture.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kunstmusik/pink/HEAD/doc/architecture.png -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | jdk: 3 | - openjdk7 4 | - oraclejdk7 5 | - oraclejdk8 6 | sudo: false 7 | -------------------------------------------------------------------------------- /src/test/pink/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.core-test) 2 | 3 | ;(deftest a-test 4 | ; (testing "FIXME, I fail." 5 | ; (is (= 0 1)))) 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | /site 6 | /docs/** 7 | pom.xml 8 | pom.xml.asc 9 | *.jar 10 | *.class 11 | *.swp 12 | *.swo 13 | .lein-deps-sum 14 | .lein-failures 15 | .lein-plugins 16 | .lein-repl-history 17 | .idea 18 | .classpath 19 | audio-seq.iml 20 | .nrepl-port 21 | -------------------------------------------------------------------------------- /src/demo/pink/demo/midi_debug.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.midi-debug 2 | (:require [pink.io.midi :as midi])) 3 | 4 | (comment 5 | (midi/list-devices) 6 | (midi/list-input-devices) 7 | 8 | (midi/device-debug "nanoKONTROL SLIDER/KNOB") 9 | 10 | (midi/device-debug "nanoKEY KEYBOARD") 11 | (midi/device-debug "MPKmini2") 12 | 13 | ) 14 | -------------------------------------------------------------------------------- /mkdocs.yml: -------------------------------------------------------------------------------- 1 | site_name: Pink 2 | docs_dir: doc 3 | pages: 4 | - [intro.md, Home] 5 | - [workflow.md, Workflow] 6 | - [terminology.md, Terminology] 7 | - [architecture.md, Architecture] 8 | - [ugen.md, Unit Generators] 9 | - [events.md, Events] 10 | - [performance.md, Performance] 11 | - [examples.md, Example Usage] 12 | theme: readthedocs 13 | -------------------------------------------------------------------------------- /doc/examples.md: -------------------------------------------------------------------------------- 1 | # Example Usage 2 | 3 | A full set of tutorials guiding the user from simple sounds to full pieces is currently planned to be written. Until those are released, you can best learn Pink and Score by looking at the [Music Examples](https://github.com/kunstmusik/music-examples) project on Github. There you'll find some sample files that show various commented examples of using Pink and Score together. 4 | -------------------------------------------------------------------------------- /src/main/pink/Utils.java: -------------------------------------------------------------------------------- 1 | package pink; 2 | 3 | import clojure.lang.IFn; 4 | 5 | public class Utils { 6 | 7 | /* from Zach Tellman's Primitive Math library 8 | * https://github.com/ztellman/primitive-math 9 | */ 10 | public static boolean neq(double a, double b) { 11 | return a != b; 12 | } 13 | 14 | /* from Zach Tellman's Primitive Math library 15 | * https://github.com/ztellman/primitive-math 16 | */ 17 | public static boolean neq(long a, long b) { 18 | return a != b; 19 | } 20 | 21 | } 22 | -------------------------------------------------------------------------------- /src/main/pink/node/Message.java: -------------------------------------------------------------------------------- 1 | package pink.node; 2 | 3 | import clojure.lang.IFn; 4 | import clojure.lang.Keyword; 5 | 6 | public class Message { 7 | private Keyword msgType; 8 | private IFn msg; 9 | 10 | public void setMessage(Keyword msgType, IFn msg) { 11 | this.msgType = msgType; 12 | this.msg = msg; 13 | } 14 | 15 | public void reset() { 16 | this.msgType = null; 17 | this.msg = null; 18 | } 19 | 20 | public IFn getMsg() { 21 | return msg; 22 | } 23 | 24 | public Keyword getMsgType() { 25 | return msgType; 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Pink User's Manual 2 | 3 | Author: Steven Yi 4 | 5 | This manual serves as a guide to understanding and using Pink. It covers high-level design as well as explores how to achieve various use cases. For low-level reference information for functions, please see the function's documentation string or source code. 6 | 7 | ## Sections 8 | * [Workflow](workflow.md) 9 | * [Terminology](terminology.md) 10 | * [Architecture](architecture.md) 11 | * [Unit Generators](ugen.md) 12 | * [Events](events.md) 13 | * [Processes](processes.md) 14 | * [Performance](performance.md) 15 | * [Example Usage](examples.md) 16 | -------------------------------------------------------------------------------- /src/main/pink/EngineUtils.java: -------------------------------------------------------------------------------- 1 | package pink; 2 | import java.nio.ByteBuffer; 3 | 4 | public final class EngineUtils { 5 | 6 | public static void writeDoublesToByteBufferAsShorts(double[] audio, ByteBuffer buffer) { 7 | int len = audio.length; 8 | double val; 9 | short min = Short.MIN_VALUE; 10 | short max = Short.MAX_VALUE; 11 | 12 | for(int i = 0; i < len; i++) { 13 | val = audio[i] * max; 14 | 15 | if (val < min) { 16 | buffer.putShort(min); 17 | } else if (val > max) { 18 | buffer.putShort(max); 19 | } else { 20 | buffer.putShort((short)val); 21 | } 22 | } 23 | } 24 | 25 | } 26 | -------------------------------------------------------------------------------- /src/demo/pink/demo/mouse.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.mouse 2 | (:require [pink.io.mouse :refer :all] 3 | [pink.simple :refer :all] 4 | [pink.filters :refer :all] 5 | [pink.space :refer :all] 6 | [pink.envelopes :refer :all] 7 | [pink.oscillators :refer :all] 8 | [pink.util :refer :all] 9 | )) 10 | 11 | ;; create instrument 12 | 13 | 14 | (defn instr-saw 15 | [amp freq] 16 | (pan 17 | (mul (tone (blit-saw freq) 1000) amp) 18 | 0.5)) 19 | 20 | (comment 21 | 22 | (start-engine) 23 | 24 | (add-afunc 25 | (instr-saw (mul (sub 1 (mul (port (mouse-y) 0.1) (/ 1 (get-screen-height))))) 26 | (sum 200 (mul (port (mouse-x) 0.1) 2000 (/ 1 (get-screen-width)))))) 27 | 28 | ) 29 | -------------------------------------------------------------------------------- /src/test/pink/envelopes_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.envelopes-test 2 | (:require [pink.envelopes :refer :all]) 3 | (:require [clojure.test :refer :all])) 4 | 5 | 6 | (defmacro with-private-fns [[ns fns] & tests] 7 | "Refers private fns from ns and runs tests in context." 8 | `(let ~(reduce #(conj %1 %2 `(ns-resolve '~ns '~%2)) [] fns) 9 | ~@tests)) 10 | 11 | 12 | (def pts [0.0 0.001 0.05 1.0 0.3 0.001]) 13 | ;(def t (exp-env pts)) 14 | ;(def pts-data (make-exp-env-data pts)) 15 | ;(def pts-data2 (make-env-data pts)) 16 | 17 | (deftest test-make-env-data 18 | (with-private-fns [pink.envelopes [make-env-data]] 19 | (let [[start-val & pts] (make-env-data pts #(/ (- %1 %2) %3))] 20 | (is (= 2205.0 (ffirst pts))) 21 | (is (= 2 (count pts))) 22 | ))) 23 | 24 | -------------------------------------------------------------------------------- /src/benchmarks/pink/benchmark/Benchmark.java: -------------------------------------------------------------------------------- 1 | package pink.benchmark; 2 | 3 | public class Benchmark { 4 | 5 | public static class Phasor { 6 | 7 | private double cur_phase = 0.0; 8 | double[] buffer = new double[64]; 9 | double freq, phase; 10 | double phase_incr; 11 | int buffer_size; 12 | 13 | public Phasor(double freq, double phase, int sr, int buffer_size) { 14 | this.freq = freq; 15 | this.phase = phase; 16 | this.phase_incr = freq / sr; 17 | this.buffer_size = buffer_size; 18 | } 19 | 20 | public double[] tick() { 21 | double phs = this.phase; 22 | 23 | for(int i = 0; i < buffer_size; i++) { 24 | buffer[i] = phs; 25 | phs = (phs + phase_incr) / 1.0; 26 | } 27 | 28 | this.phase = phs; 29 | 30 | return buffer; 31 | } 32 | 33 | } 34 | 35 | } 36 | -------------------------------------------------------------------------------- /src/test/pink/control_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.control-test 2 | (:require [pink.control :refer :all] 3 | [pink.config :refer [*sr* *buffer-size*]] 4 | [clojure.test :refer :all] 5 | [clojure.pprint :refer [pprint]] 6 | )) 7 | 8 | 9 | (deftest test-chain 10 | (let [counter (atom 0) 11 | fn1 (fn [] (let [v (swap! counter inc)] 12 | (not (> v 3)))) 13 | fn2 (fn [] (let [v (swap! counter #(* 2 %))] 14 | (not (> v 16)))) 15 | c (chain fn1 fn2) 16 | ] 17 | (is (= 0 @counter)) 18 | (is (c)) 19 | (is (= 1 @counter)) 20 | (is (c)) 21 | (is (= 2 @counter)) 22 | (is (c)) 23 | (is (= 3 @counter)) 24 | (is (c)) 25 | (is (= 8 @counter)) 26 | (is (c)) 27 | (is (= 16 @counter)) 28 | (is (not (c))) 29 | )) 30 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_tempo.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-tempo 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.instruments.horn :refer :all] 5 | [pink.util :refer [mul try-func]] 6 | [pink.oscillators :refer :all] 7 | [pink.envelopes :refer :all] 8 | [pink.filters :refer :all] 9 | [pink.node :refer :all] 10 | [pink.space :refer :all] 11 | )) 12 | 13 | (defn instr 14 | [amp pitch] 15 | (-> 16 | (blit-saw pitch) 17 | (moogladder 2000 0.5) 18 | (mul amp (adsr 0.02 0.02 0.95 0.1)) 19 | (pan 0.0))) 20 | 21 | (comment 22 | 23 | (start-engine) 24 | 25 | (add-audio-events 26 | (i instr 0.0 0.4 0.25 400) 27 | (i instr 0.5 0.4 0.25 800)) 28 | 29 | (set-tempo 30) 30 | (set-tempo 60) 31 | (set-tempo 120) 32 | 33 | ) 34 | -------------------------------------------------------------------------------- /src/demo/pink/demo/pluck.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.pluck 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.space :refer [pan]] 5 | [pink.instruments.pluck :refer :all] 6 | )) 7 | 8 | (defn panks 9 | [& args] 10 | (-> 11 | (apply pluck args) 12 | (pan 0.1))) 13 | 14 | (comment 15 | 16 | (start-engine) 17 | 18 | (add-audio-events 19 | (i panks 0 3.0 0.25 100)) 20 | 21 | (add-audio-events 22 | (i panks 0 0.5 0.25 200) 23 | (i panks 0 0.5 0.25 300) 24 | (i panks 0 0.5 0.25 350)) 25 | 26 | (add-audio-events 27 | (i panks 0 0.5 0.25 220) 28 | (i panks 3.0 0.5 0.25 330) 29 | (i panks 5.0 0.5 0.25 440) 30 | (i panks 5.2 0.5 0.25 400)) 31 | 32 | (add-audio-events 33 | (i panks 0 0.5 0.25 440)) 34 | 35 | 36 | (clear-engine) 37 | 38 | (stop-engine) 39 | 40 | ) 41 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_distortion.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-distortion 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.space :refer [pan]] 5 | [pink.instruments.pluck :refer :all] 6 | [pink.effects.distortion :refer :all] 7 | [pink.util :refer [!*!]] 8 | )) 9 | 10 | (defn guit1 11 | [pch sat] 12 | (-> 13 | (pluck 1.0 pch) 14 | (distort sat) 15 | (pan 0.0))) 16 | 17 | 18 | (defn guit2 19 | [pch sat] 20 | (-> 21 | (pluck 1.0 pch) 22 | (distort1 sat 1 0.8 0) 23 | (pan 0.0))) 24 | 25 | (comment 26 | 27 | (start-engine) 28 | 29 | (add-audio-events 30 | (i guit1 0 1.0 200 4) 31 | (i guit1 1 1.0 400 2) 32 | (i guit1 2 1.0 800 1)) 33 | 34 | (add-audio-events 35 | (i guit2 0 1.0 200 1) 36 | (i guit2 3 1.0 200 4) 37 | (i guit2 6 1.0 200 8)) 38 | 39 | (clear-engine) 40 | 41 | (stop-engine) 42 | 43 | ) 44 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo7.clj: -------------------------------------------------------------------------------- 1 | ;; Test of Events 2 | 3 | (ns pink.demo.demo7 4 | (:require [pink.engine :refer :all] 5 | [pink.envelopes :refer [env exp-env adsr xar]] 6 | [pink.oscillators :refer [oscil sine2]] 7 | [pink.util :refer [mul swapd! sum const create-buffer getd setd! arg shared let-s reader]] 8 | [pink.event :refer :all] )) 9 | 10 | 11 | (defn table-synth [freq] 12 | (mul 13 | (oscil 0.5 freq) 14 | (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0]))) 15 | 16 | (comment 17 | 18 | (let [e (engine-create) 19 | eng-events 20 | (audio-events e 21 | (event table-synth 0.0 440.0) 22 | (event table-synth 0.5 550.0) 23 | (event table-synth 1.0 660.0) 24 | (event table-synth 1.5 880.0)) 25 | ] 26 | 27 | (engine-start e) 28 | (engine-add-events e eng-events) 29 | 30 | (Thread/sleep 2200) 31 | (engine-stop e) 32 | (engine-clear e)) 33 | 34 | 35 | ) 36 | 37 | -------------------------------------------------------------------------------- /src/test/pink/live_code_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.live-code-test 2 | (:require [pink.live-code :refer :all] 3 | [clojure.test :refer :all])) 4 | 5 | 6 | (deftest test-redef! 7 | (testing "redef! redefines a to b" 8 | (defn a [] 1) 9 | (defn b [] 2) 10 | 11 | 12 | (is (= 1 (a))) 13 | (is (= 2 (b))) 14 | 15 | (redef! a b) 16 | 17 | (is (= 2 (a))) 18 | (is (= 2 (b))) 19 | 20 | (defn b [] 3) 21 | 22 | (is (= 2 (a))) 23 | (is (= 3 (b))) 24 | )) 25 | 26 | 27 | (deftest test-kill-recur! 28 | (testing "kill-recur! redefines function to n-arity" 29 | (defn a [x y] (+ x y)) 30 | (is (= 5 (a 2 3))) 31 | (kill-recur! a) 32 | (is (nil? (a 2 3))) 33 | )) 34 | 35 | (deftest test-next-beat 36 | (is (= (- 84 81.11) (next-beat 81.11 4))) 37 | (is (= (- 82 81.11) (next-beat 81.11 2))) 38 | (is (= (- 84 81.98) (next-beat 81.98 2))) 39 | (is (= (- 81.5 81.11) (next-beat 81.11 1/2))) 40 | (is (= (- 1032.5 1031.998) (next-beat 1031.998 1/2))) 41 | (is (= (- 14/4 2.25343 ) (next-beat 2.25343 7/4)))) 42 | 43 | -------------------------------------------------------------------------------- /src/main/pink/node/IFnList.java: -------------------------------------------------------------------------------- 1 | package pink.node; 2 | 3 | import clojure.lang.IFn; 4 | import java.util.ArrayList; 5 | 6 | 7 | /** Utility class to hold lists of IFn classes (i.e., Clojure functions). 8 | * Designed to eliminate runtime object allocations but still grow if 9 | * necessary. Also designed to be used by single-thread, single-owner. 10 | * 11 | * @author Steven Yi 12 | */ 13 | 14 | public class IFnList { 15 | 16 | private ArrayList activeList; 17 | private ArrayList backList; 18 | 19 | public IFnList() { 20 | activeList = new ArrayList<>(128); 21 | backList = new ArrayList<>(128); 22 | } 23 | 24 | public ArrayList getActiveList() { 25 | return activeList; 26 | } 27 | 28 | public boolean isEmpty() { 29 | return activeList.size() == 0; 30 | } 31 | 32 | 33 | public void putBack(IFn func) { 34 | backList.add(func); 35 | } 36 | 37 | /** Used at end of function list processing */ 38 | public void swap() { 39 | ArrayList temp = backList; 40 | backList = activeList; 41 | activeList = temp; 42 | backList.clear(); 43 | } 44 | 45 | } 46 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_duration.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-duration 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.space :refer [pan]] 5 | [pink.oscillators :refer [blit-saw blit-square]] 6 | [pink.envelopes :refer [adsr]] 7 | [pink.util :refer :all] 8 | [pink.node :refer :all] 9 | [pink.filters :refer [tone butterlp]] 10 | [pink.delays :refer [adelay]] 11 | [pink.config :refer [*duration*]] 12 | )) 13 | 14 | (defn instr-saw 15 | [amp freq loc] 16 | (let-s [e (adsr 0.03 0.01 0.9 3.0)] 17 | (pan 18 | (mul e 19 | (butterlp (blit-saw freq) 20 | (sum 100 (mul e 400)))) 21 | loc))) 22 | 23 | (comment 24 | 25 | (start-engine) 26 | 27 | (add-afunc (instr-saw 0.5 440.0 0.0)) 28 | 29 | (add-afunc 30 | (binding [*duration* 2.0] 31 | (instr-saw 0.5 440.0 0.0))) 32 | 33 | (add-afunc 34 | (with-duration 1.35 35 | (instr-saw 0.5 (+ 220.0 (* 440.0 (rand))) 0.0))) 36 | 37 | (stop-engine) 38 | 39 | 40 | ) 41 | 42 | -------------------------------------------------------------------------------- /src/main/pink/io/audio.clj: -------------------------------------------------------------------------------- 1 | (ns 2 | ^{:doc "Functions for handling Audio I/O using Javasound" 3 | :author "Steven Yi"} 4 | pink.io.audio 5 | (:import [javax.sound.sampled AudioSystem SourceDataLine 6 | TargetDataLine 7 | ])) 8 | 9 | 10 | (defn open-line [audio-format buffer-size] 11 | (let [#^SourceDataLine line (AudioSystem/getSourceDataLine audio-format)] 12 | (doto line 13 | (.open audio-format buffer-size) 14 | (.start)))) 15 | 16 | (defn open-input-line [audio-format] 17 | (let [#^TargetDataLine line (AudioSystem/getTargetDataLine audio-format)] 18 | (doto line 19 | (.open audio-format) 20 | (.start)))) 21 | 22 | 23 | (defn print-java-sound-info 24 | "Print out available JavaSoundMixers" 25 | [] 26 | (let [mixers (AudioSystem/getMixerInfo) 27 | cnt (alength mixers)] 28 | (println "Mixers Found: " cnt) 29 | (loop [indx 0] 30 | (when (< indx cnt) 31 | (let [mixer ^Mixer$Info (aget mixers indx)] 32 | (println "Mixer " indx " :" mixer) 33 | (recur (unchecked-inc indx)) 34 | ))))) 35 | 36 | -------------------------------------------------------------------------------- /src/benchmarks/pink/benchmark/benchmark.clj: -------------------------------------------------------------------------------- 1 | (ns pink.benchmark.benchmark 2 | (:import [pink.benchmark Benchmark$Phasor]) 3 | (:require [pink.config :refer :all] 4 | [pink.oscillators :refer :all] 5 | [pink.util :refer :all] 6 | [clojure.pprint :refer [pprint]] 7 | )) 8 | 9 | (defn run-phasor-test 10 | [] 11 | (let [p (Benchmark$Phasor. 440.0 0.0 *sr* *buffer-size*)] 12 | (println "Java Phasor Test") 13 | (doseq [_ (range 5)] 14 | (time 15 | (doseq [_ (range 1000000)] 16 | (.tick p))))) 17 | (let [p (phasor 440.0 0.0)] 18 | (println "Pink Phasor Test") 19 | (doseq [_ (range 5)] 20 | (time 21 | (doseq [_ (range 1000000)] 22 | (p)))))) 23 | 24 | (defn run-mul-test 25 | [] 26 | (let [p (mul 440.0 2.0)] 27 | (println "Pink Mul Test") 28 | (doseq [_ (range 5)] 29 | (time 30 | (doseq [_ (range 1000000)] 31 | (p))))) 32 | (let [p (mul2 440.0 2.0)] 33 | (println "Pink Mul2 Test") 34 | (doseq [_ (range 5)] 35 | (time 36 | (doseq [_ (range 1000000)] 37 | (p)))))) 38 | 39 | 40 | (comment 41 | 42 | (run-mul-test) 43 | (run-phasor-test) 44 | 45 | ) 46 | 47 | -------------------------------------------------------------------------------- /src/test/pink/engine_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.engine-test 2 | (:require [pink.engine :refer :all] 3 | [pink.event :refer :all] 4 | [clojure.test :refer :all]) 5 | (:import [pink.engine Engine])) 6 | 7 | ;; Hmm, I don't remember what this tests, if anything... 8 | ;; should definitely rewrite this one! :) 9 | (deftest test-engine-kill-all 10 | (engines-clear) 11 | (let [a ^Engine (engine-create) 12 | b ^Engine (engine-create)] 13 | (is (= :stopped (engine-status a))) 14 | (is (= :stopped (engine-status b))) 15 | (is (not @(.clear a))) 16 | (is (not @(.clear b))) 17 | 18 | (is a) 19 | (is b) 20 | 21 | (dosync 22 | (reset! (.status a) :running) 23 | (reset! (.status b) :running)) 24 | 25 | (is (= :running (engine-status a))) 26 | (is (= :running (engine-status b))) 27 | 28 | (engine-kill-all) 29 | 30 | (is (true? @(.clear a))) 31 | (is (true? @(.clear b))) 32 | 33 | 34 | )) 35 | 36 | (deftest audio-events-test 37 | (let [test-func #() 38 | e (engine-create) 39 | evts (audio-events 40 | e 41 | (map #(apply event %) 42 | [[test-func 0.5] 43 | [test-func 0.0]]))] 44 | (is (= 2 (count evts))) 45 | )) 46 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo6.clj: -------------------------------------------------------------------------------- 1 | ;; Test of Events 2 | 3 | (ns pink.demo.demo6 4 | (:require [pink.engine :refer :all] 5 | [pink.envelopes :refer [env exp-env adsr xar]] 6 | [pink.oscillators :refer [sine sine2]] 7 | [pink.util :refer [mul swapd! sum const create-buffer getd setd! arg shared let-s reader]] 8 | [pink.event :refer :all] )) 9 | 10 | 11 | (defn fm-synth [freq] 12 | (let-s [e (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0])] 13 | (mul 14 | (sine2 (sum freq (mul e 440 (sine freq)))) 15 | (mul 0.4 e)))) 16 | 17 | ;; test design work 18 | ;; mutable value will be held in an atom 19 | ;; reader will be the audio-func to read from the atom 20 | 21 | (def index (atom 1)) 22 | (def t (reader index)) 23 | (reset! index 3.25) 24 | 25 | (defn fm-bell [freq] 26 | ( 27 | ;let-s [e (exp-env [0.0 0.00001 0.05 1.0 3 0.000001])] 28 | let-s [e (xar 0.0001 1.3)] 29 | (mul 30 | (sine2 (sum freq (mul freq t (sine (* 4.77 freq))))) 31 | (mul 0.1 e)))) 32 | 33 | ;; 34 | 35 | (comment 36 | 37 | (let [e (engine-create) 38 | eng-events 39 | (audio-events e 40 | (event fm-bell 0.0 440.0) 41 | (event fm-bell 0.5 550.0) 42 | (event fm-bell 1.0 660.0) 43 | (event fm-bell 1.5 880.0)) 44 | ] 45 | 46 | (engine-start e) 47 | (engine-add-events e eng-events) 48 | 49 | (Thread/sleep 2200) 50 | (engine-stop e) 51 | (engine-clear e)) 52 | 53 | 54 | ) 55 | 56 | -------------------------------------------------------------------------------- /src/demo/pink/demo/cache.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.cache 2 | (:require [pink.engine :refer :all] 3 | [pink.config :refer :all] 4 | [pink.envelopes :refer [adsr]] 5 | [pink.oscillators :refer [sine]] 6 | [pink.util :refer :all] 7 | [pink.simple :refer [i]] 8 | [pink.space :refer :all] 9 | )) 10 | 11 | (defn i1 12 | [freq] 13 | (mul (adsr 0 1 0 1) 14 | (sine freq))) 15 | 16 | (defn play-from-cache 17 | [^doubles s] 18 | (let [^doubles out (create-buffer) 19 | s-size (alength s)] 20 | (println "SSIZE: " s-size) 21 | (generator 22 | [read-ptr 0] [] 23 | (if (and (= 0 int-indx) (>= read-ptr s-size)) 24 | nil 25 | (if (< read-ptr s-size) 26 | (do 27 | (aset out int-indx (aget s read-ptr)) 28 | (gen-recur (+ 1 read-ptr))) 29 | (do 30 | (aset out int-indx 0.0) 31 | (gen-recur (+ 1 read-ptr))) 32 | )) 33 | (yield out)))) 34 | 35 | (defn test-engine->buffer 36 | [] 37 | (let [e (engine-create :nchnls 1)] 38 | (->> 39 | (map #(apply i %) 40 | [[i1 0 1 440] 41 | [i1 1 1 550] 42 | [i1 2 1 660]]) 43 | (audio-events e) 44 | (engine-add-events e)) 45 | (engine->buffer e))) 46 | 47 | 48 | 49 | (defn test-it [] 50 | (let [e (engine-create :nchnls 2) 51 | buf (test-engine->buffer)] 52 | (engine-start e) 53 | (engine-add-afunc e (pan (play-from-cache buf) 0.0)) 54 | (Thread/sleep 3000.0) 55 | (engine-stop e))) 56 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo2.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo2 2 | (:require [pink.engine :refer :all] 3 | [pink.config :refer :all] 4 | [pink.envelopes :refer [env]] 5 | [pink.oscillators :refer [sine sine2]] 6 | [pink.util :refer [mul const create-buffer getd setd!]])) 7 | 8 | 9 | (defn fm-synth [freq] 10 | (mul 11 | (sine2 (mul 12 | freq 13 | (mul 14 | (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0]) 15 | (sine (* 1 freq))))) 16 | (mul 17 | 0.5 18 | (env [0.0 0.0 0.02 1 0.02 0.9 0.2 0.9 0.2 0])))) 19 | 20 | 21 | (defn demo [e] 22 | (let [melody (take (* 4 8) (cycle [220 330 440 330])) 23 | dur 0.25] 24 | (loop [[x & xs] melody] 25 | (when x 26 | (engine-add-afunc e (fm-synth x)) 27 | (engine-add-afunc e (fm-synth (* 2 x))) 28 | (recur xs))))) 29 | 30 | 31 | 32 | (defn demo-afunc [e] 33 | (let [melody (ref (take (* 4 8) (cycle [220 330 440 330]))) 34 | dur 0.25 35 | cur-time (double-array 1 0.0) 36 | time-incr (/ *buffer-size* 44100.0) 37 | out (create-buffer)] 38 | (engine-add-afunc e (fm-synth 440)) 39 | (fn ^doubles [] 40 | (let [t (+ (getd cur-time) time-incr)] 41 | (when (>= t dur) 42 | (engine-add-afunc e (fm-synth 440))) 43 | (setd! cur-time (rem t dur))) 44 | out 45 | ))) 46 | 47 | 48 | ;; 49 | 50 | (comment 51 | 52 | 53 | (def e (engine-create)) 54 | (engine-start e) 55 | (engine-add-afunc e (demo-afunc e)) 56 | (engine-stop e) 57 | 58 | (engine-clear e) 59 | e 60 | 61 | (let [e (engine-create)] 62 | (engine-start e) 63 | (demo e) 64 | (Thread/sleep 2000) 65 | (engine-stop e))) 66 | 67 | 68 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_node.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-node 2 | (:require [pink.engine :refer :all] 3 | [pink.event :refer :all] 4 | [pink.instruments.horn :refer :all] 5 | [pink.util :refer [mul try-func]] 6 | [pink.oscillators :refer :all] 7 | [pink.envelopes :refer [env]] 8 | [pink.node :refer :all] 9 | [pink.dynamics :refer [db->amp]] 10 | )) 11 | 12 | (comment 13 | 14 | (def e (engine-create :nchnls 2)) 15 | (engine-start e) 16 | 17 | ;(require '[pink.noise :refer :all]) 18 | ;(engine-add-afunc e (white-noise)) 19 | 20 | (def root-node (gain-node)) 21 | (engine-add-afunc e root-node) 22 | 23 | (def my-score 24 | (let [num-notes 5] 25 | (node-events root-node 26 | (map #(event horn (* % 0.5) 27 | (/ 0.75 (+ 1 %)) 28 | (* 220 (+ 1 %)) 29 | (- (* 2 (/ % (- num-notes 1))) 1)) 30 | (range num-notes))))) 31 | 32 | (engine-add-events e my-score) 33 | 34 | 35 | 36 | (def m-node (mixer-node)) 37 | (engine-add-afunc e m-node) 38 | 39 | (set-pan! m-node 0.25) 40 | (set-gain! m-node (db->amp -12)) 41 | 42 | (engine-add-events e 43 | (let [num-notes 5] 44 | (node-events m-node 45 | (map #(event horn (* % 0.5) 46 | (/ 0.75 (+ 1 %)) 47 | (* 220 (+ 1 %))) 48 | (range num-notes))))) 49 | 50 | 51 | ;(def s (sine 440.0)) 52 | ;(node-add-func root-node s) 53 | ;(node-remove-func root-node s) 54 | 55 | (engine-stop e) 56 | (engine-clear e) 57 | (engine-kill-all) 58 | 59 | 60 | ) 61 | 62 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo4.clj: -------------------------------------------------------------------------------- 1 | ;; Test of Mutable Control input 2 | ;; index is held in an atom, reader reads from atom and returns a buffer 3 | 4 | (ns pink.demo.demo4 5 | (:require [pink.engine :refer :all] 6 | [pink.config :refer :all] 7 | [pink.envelopes :refer [env]] 8 | [pink.oscillators :refer [sine sine2]] 9 | [pink.util :refer [mul swapd! sum const create-buffer getd setd! arg shared let-s reader]])) 10 | 11 | 12 | (defn fm-synth [freq] 13 | (let-s [e (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0])] 14 | (mul 15 | (sine2 (sum freq (mul e 440 (sine freq)))) 16 | (mul 0.4 e)))) 17 | 18 | ;; test design work 19 | ;; mutable value will be held in an atom 20 | ;; reader will be the audio-func to read from the atom 21 | 22 | (def index (atom 1)) 23 | (def t (reader index)) 24 | (reset! index 3.25) 25 | 26 | (aget ^doubles (t) 0) 27 | 28 | (defn fm-bell [freq] 29 | (let-s [e (env [0.0 0.0 0.05 1.0 0.3 0])] 30 | (mul 31 | (sine2 (sum freq (mul freq t (sine (* 4.77 freq))))) 32 | (mul 0.4 e)))) 33 | 34 | (defn demo-afunc [e] 35 | (let [melody (ref (take (* 4 8) (cycle [220 330 440 330]))) 36 | dur 0.25 37 | cur-time (double-array 1 0.0) 38 | time-incr (/ *buffer-size* 44100.0) 39 | out (create-buffer)] 40 | (engine-add-afunc e (fm-synth 440)) 41 | (fn ^doubles [] 42 | (let [t (+ (getd cur-time) time-incr)] 43 | (when (>= t dur) 44 | (engine-add-afunc e (fm-bell 220))) 45 | (setd! cur-time (rem t dur))) 46 | out 47 | ))) 48 | 49 | 50 | 51 | 52 | ;; 53 | 54 | (comment 55 | 56 | (def e (engine-create)) 57 | (engine-start e) 58 | (engine-add-afunc e (demo-afunc e)) 59 | (engine-stop e) 60 | 61 | (engine-clear e) 62 | e 63 | 64 | ) 65 | 66 | 67 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_piano.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-piano 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.instruments.piano :refer :all] 5 | [pink.util :refer [mul try-func hold-until with-duration]] 6 | [pink.filters :refer :all] 7 | [pink.node :refer :all] 8 | [pink.space :refer :all] 9 | [pink.config :refer :all] 10 | [pink.envelopes :refer [env]] 11 | )) 12 | 13 | (defn instr 14 | [amp key-num] 15 | (-> 16 | (piano :duration *duration* :keynum key-num :amp amp) 17 | ;(mul (hold-until 0.5 1.0 (env [0.0 1.0 0.1 0.0]))) 18 | (pan 0.0) 19 | )) 20 | 21 | 22 | (comment 23 | 24 | (start-engine) 25 | 26 | (add-audio-events 27 | (i instr 0.0 4.0 0.25 62)) 28 | (add-audio-events 29 | (i instr 0.0 1.0 0.25 60) 30 | (i instr 0.5 1.0 0.25 64)) 31 | 32 | (add-afunc (with-duration 4 (instr 0.5 60))) 33 | (add-afunc (with-duration 4 (instr 0.5 63))) 34 | 35 | (doseq [x (range 25)] 36 | (add-audio-events (i instr (* x 0.25) 1.0 0.25 (+ 60 x)))) 37 | 38 | (doseq [x (range 25)] 39 | (add-audio-events (i instr (* x 0.25) 1.0 0.25 (+ 67 x)))) 40 | 41 | (doseq [x (range 13)] 42 | (add-audio-events (i instr (* x 0.5) 2.0 0.25 (+ 40 x)))) 43 | 44 | (doseq [x (range 1000)] 45 | (add-audio-events (i instr (* x 0.125) 2.0 46 | (* (/ 1.0 (inc (mod x 48))) 0.25) 47 | (+ 48 (mod x 48))))) 48 | 49 | (doseq [x (range 1000)] 50 | (add-audio-events (i instr (* x 0.2) 2.0 51 | (* (/ 1.0 (inc (mod x 48))) 0.25) 52 | (+ 48 (mod x 48))))) 53 | 54 | (add-audio-events 55 | (i instr 0.0 0.4 0.25 62) 56 | (i instr 0.5 0.4 0.25 65)) 57 | 58 | 59 | ) 60 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo1.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo1 2 | (:require [pink.engine :refer :all] 3 | [pink.config :refer :all] 4 | [pink.envelopes :refer [env]] 5 | [pink.oscillators :refer [sine]] 6 | [pink.util :refer [sum mul const create-buffer getd setd!]])) 7 | 8 | 9 | (defn simple-synth [freq] 10 | (mul 11 | (sum 12 | (sine freq) 13 | (mul 0.5 (sine (* 2 freq))) 14 | (mul 0.25 (sine (* 3 freq))) 15 | (mul 0.125 (sine (* 4 freq)))) 16 | (mul 17 | 0.25 18 | (env [0.0 0.0 0.02 1 0.02 0.9 0.2 0.9 0.2 0])))) 19 | 20 | 21 | (defn demo [e] 22 | (let [melody (take (* 4 8) (cycle [220 330 440 330])) 23 | dur 0.25] 24 | (loop [[x & xs] melody] 25 | (when x 26 | (engine-add-afunc e (simple-synth x)) 27 | (engine-add-afunc e (simple-synth (* 2 x))) 28 | (recur xs))))) 29 | 30 | 31 | (defn demo-afunc [e] 32 | (let [melody (ref (take (* 4 8) (cycle [220 330 440 330]))) 33 | dur 0.25 34 | cur-time (double-array 1 0.0) 35 | time-incr (/ *buffer-size* 44100.0) 36 | out (create-buffer)] 37 | (engine-add-afunc e (simple-synth 440)) 38 | (fn ^doubles [] 39 | (let [t (+ (getd cur-time) time-incr)] 40 | (when (> t dur) 41 | (engine-add-afunc e (simple-synth 440))) 42 | (setd! cur-time (rem t dur))) 43 | out 44 | ))) 45 | 46 | 47 | ;; 48 | 49 | (comment 50 | 51 | ;(defn note-sender[e] 52 | ; (dosync 53 | ; (alter (e :pending-funcs) conj (simple-synth 440) (simple-synth 660)))) 54 | 55 | (def e (engine-create)) 56 | (engine-start e) 57 | (engine-add-afunc e (demo-afunc e)) 58 | (engine-stop e) 59 | (engine-clear e) 60 | 61 | e 62 | 63 | (let [e (engine-create)] 64 | (engine-start e) 65 | (demo e) 66 | (Thread/sleep 500) 67 | (engine-stop e)) 68 | 69 | ) 70 | 71 | 72 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo3.clj: -------------------------------------------------------------------------------- 1 | ;; Test of FM synthesis 2 | 3 | (ns pink.demo.demo3 4 | (:require [pink.engine :refer :all] 5 | [pink.config :refer :all] 6 | [pink.envelopes :refer [env]] 7 | [pink.oscillators :refer [sine sine2]] 8 | [pink.util :refer [mul sum const create-buffer getd setd! arg shared let-s]])) 9 | 10 | 11 | (defn fm-synth [freq] 12 | (let-s [e (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0])] 13 | (mul 14 | (sine2 (sum freq (mul e 440 (sine freq)))) 15 | (mul 0.4 e)))) 16 | 17 | (defn fm-bell [freq] 18 | (let-s [e (env [0.0 0.0 0.05 1.0 0.3 0])] 19 | (mul 20 | (sine2 (sum freq (mul 880.0 (sine (* 4.77 freq))))) 21 | (mul 0.4 e)))) 22 | 23 | (defn demo [e] 24 | (let [melody (take (* 4 8) (cycle [220 330 440 330])) 25 | dur 0.25] 26 | (loop [[x & xs] melody] 27 | (when x 28 | (engine-add-afunc e (fm-synth x)) 29 | (engine-add-afunc e (fm-synth (* 2 x))) 30 | (recur xs))))) 31 | 32 | 33 | 34 | (defn demo-afunc [e] 35 | (let [melody (ref (take (* 4 8) (cycle [220 330 440 330]))) 36 | dur 0.25 37 | cur-time (double-array 1 0.0) 38 | time-incr (/ *buffer-size* 44100.0) 39 | out (create-buffer)] 40 | (engine-add-afunc e (fm-synth 440)) 41 | (fn ^doubles [] 42 | (let [t (+ (getd cur-time) time-incr)] 43 | (when (>= t dur) 44 | (engine-add-afunc e (fm-bell 220))) 45 | (setd! cur-time (rem t dur))) 46 | out 47 | ))) 48 | 49 | 50 | 51 | ;; 52 | 53 | (comment 54 | 55 | (def e (engine-create)) 56 | (engine-start e) 57 | (engine-add-afunc e (demo-afunc e)) 58 | (engine-stop e) 59 | 60 | (engine-clear e) 61 | e 62 | 63 | (let [e (engine-create)] 64 | (engine-start e) 65 | (demo e) 66 | (Thread/sleep 500) 67 | (engine-stop e))) 68 | 69 | 70 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_audio_file_load.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-audio-file-load 2 | (:require [pink.engine :refer :all] 3 | [pink.event :refer :all] 4 | [pink.space :refer [pan]] 5 | [pink.io.sound-file :refer [load-table]] 6 | [pink.oscillators :refer [oscil3]] 7 | [pink.envelopes :refer [env]] 8 | [pink.util :refer [mul]] 9 | [pink.node :refer :all] 10 | [pink.config :refer [*sr*]] 11 | )) 12 | 13 | ;(def wave 14 | ; (load-table "/Users/stevenyi/work/csound/samples/akwf/AKWF_bw_sawbright/AKWF_bsaw_0001.wav")) 15 | 16 | (def wave (load-table "/Users/stevenyi/work/csound/samples/salamanderDrumkit/OH/kick_OH_FF_1.wav")) 17 | 18 | (def duration 19 | (let [d ^doubles (aget (:data wave) 0)] 20 | (/ (alength d) (double *sr*)))) 21 | 22 | (defn instr-waveform 23 | [amp freq loc] 24 | (pan 25 | (mul (env [0 0 0.02 amp (- duration 0.07) amp 0.05 0.0]) 26 | (oscil3 1.0 (/ 1.0 duration) (aget (:data wave) 0))) 27 | loc)) 28 | 29 | 30 | (comment 31 | 32 | (def e (engine-create :nchnls 2)) 33 | (engine-start e) 34 | 35 | (def root-node (audio-node :channels 2)) 36 | (engine-add-afunc e root-node) 37 | 38 | (def my-score 39 | (let [num-notes 10] 40 | (node-events root-node 41 | (map #(event instr-waveform (* % 0.5) 42 | (/ 0.75 (+ 1 %)) 43 | (* 220 (+ 1 %)) 44 | (- (* 2 (/ % (- num-notes 1))) 1)) 45 | (range num-notes))))) 46 | 47 | (engine-add-events e my-score) 48 | 49 | (node-add-func 50 | root-node 51 | (instr-waveform 0.25 (env [0.0 220 0.1 4000 0.0001 220 0.1 4000]) 0.0)) 52 | 53 | (engine-stop e) 54 | (engine-clear e) 55 | (engine-kill-all) 56 | 57 | 58 | ) 59 | 60 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo5.clj: -------------------------------------------------------------------------------- 1 | ;; Test of Exponential Envelope 2 | ;; index is held in an atom, reader reads from atom and returns a buffer 3 | 4 | (ns pink.demo.demo5 5 | (:require [pink.engine :refer :all] 6 | [pink.config :refer :all] 7 | [pink.envelopes :refer [env exp-env adsr xar]] 8 | [pink.oscillators :refer [sine sine2]] 9 | [pink.util :refer [mul swapd! sum const create-buffer getd setd! arg shared let-s reader]])) 10 | 11 | 12 | (defn fm-synth [freq] 13 | (let-s [e (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0])] 14 | (mul 15 | (sine2 (sum freq (mul e 440 (sine freq)))) 16 | (mul 0.4 e)))) 17 | 18 | ;; test design work 19 | ;; mutable value will be held in an atom 20 | ;; reader will be the audio-func to read from the atom 21 | 22 | (def index (atom 1)) 23 | (def t (reader index)) 24 | (reset! index 3.25) 25 | 26 | (aget ^doubles (t) 0) 27 | 28 | (defn fm-bell [freq] 29 | ( 30 | ;let-s [e (exp-env [0.0 0.00001 0.05 1.0 3 0.000001])] 31 | let-s [e (xar 0.0001 1.3)] 32 | (mul 33 | (sine2 (sum freq (mul freq t (sine (* 4.77 freq))))) 34 | (mul 0.2 e)))) 35 | 36 | (defn demo-afunc [e] 37 | (let [melody (ref (take (* 4 8) (cycle [220 330 440 330]))) 38 | dur 0.25 39 | cur-time (double-array 1 0.0) 40 | time-incr (/ *buffer-size* 44100.0) 41 | out (create-buffer)] 42 | (engine-add-afunc e (fm-synth 440)) 43 | (fn ^doubles [] 44 | (let [t (+ (getd cur-time) time-incr)] 45 | (when (>= t dur) 46 | (engine-add-afunc e (fm-bell 220))) 47 | (setd! cur-time (rem t dur))) 48 | out 49 | ))) 50 | 51 | 52 | 53 | ;; 54 | 55 | (comment 56 | 57 | (def e (engine-create)) 58 | (engine-start e) 59 | (engine-add-afunc e (demo-afunc e)) 60 | (engine-stop e) 61 | 62 | (engine-clear e) 63 | 64 | (engines-clear) 65 | 66 | e 67 | 68 | ) 69 | 70 | 71 | -------------------------------------------------------------------------------- /src/demo/pink/demo/midi.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.midi 2 | (:require [pink.simple :refer :all] 3 | [pink.io.midi :as midi] 4 | [pink.config :refer :all] 5 | [pink.space :refer :all] 6 | [pink.oscillators :refer [oscili]] 7 | [pink.envelopes :refer [env]] 8 | [pink.filters :refer [port]] 9 | [pink.util :refer [mul try-func create-buffer generator]]) 10 | (:import [java.util Arrays])) 11 | 12 | 13 | (comment 14 | 15 | (def midim (midi/create-manager)) 16 | (def sliders (midi/add-virtual-device midim "slider/knobs 1")) 17 | (def keyboard (midi/add-virtual-device midim "keyboard 1")) 18 | 19 | (midi/bind-device midim "nanoKONTROL SLIDER/KNOB" "slider/knobs 1") 20 | 21 | ;(midi-device-debug "nanoKONTROL SLIDER/KNOB") 22 | 23 | (def get-cc (partial midi/get-cc-atom sliders 0)) 24 | 25 | 26 | (defn midi-atom-reader 27 | [source-atom ^double target-mn ^double target-mx] 28 | (let [out ^doubles (create-buffer) 29 | cur-val (atom @source-atom) 30 | target-range (- target-mx target-mn)] 31 | (fn [] 32 | (let [v @source-atom] 33 | (when (not (= @cur-val v)) 34 | (let [new-v (+ target-mn (* target-range (/ (double v) 127.0)))] 35 | (reset! cur-val v) 36 | (Arrays/fill out new-v)))) 37 | out 38 | ))) 39 | 40 | (start-engine) 41 | 42 | (defn create-osc [space freq ampcc freqcc] 43 | (pan 44 | (oscili (port (midi-atom-reader (get-cc ampcc) 0.0 0.1) 0.05) 45 | (port (midi-atom-reader (get-cc freqcc) freq (* 2 freq)) 0.05)) 46 | space)) 47 | 48 | (defn scale-space [v low high] 49 | (+ low (* v (- high low)))) 50 | 51 | (doseq [x (range 1 10)] 52 | (let [f (+ 200 (* x 100))] 53 | (add-afunc 54 | (create-osc (scale-space (/ (- x 1) 8.0) -0.5 0.5) 55 | f x (+ x 10))))) 56 | ) 57 | -------------------------------------------------------------------------------- /src/main/pink/space.clj: -------------------------------------------------------------------------------- 1 | (ns pink.space 2 | "Functions for processing spatial qualities of sound" 3 | (:require [pink.config :refer :all] 4 | [pink.util :refer [create-buffer arg generator gen-recur not==]] 5 | [pink.dynamics :refer [db->amp]])) 6 | 7 | ;; Ensure unchecked math used for this namespace 8 | (set! *unchecked-math* :warn-on-boxed) 9 | 10 | (defn pan 11 | "Stereo panning using formula from MIDI GM-2 Default Pan Curve (RP-036) 12 | 13 | Left Channel Gain [dB] = 20*log (cos (Pi/2* max(0,CC#10 ? 1)/126)) 14 | Right Channel Gain [dB] = 20*log (sin (Pi /2* max(0,CC#10 ? 1)/126)) 15 | 16 | Instead of range 0-127, use [-1.0,1.0] 17 | 18 | If loc is an audio-function, it should be a non-ending signal generator 19 | otherwise on pre-mature end, the signal may zero out until the nil end 20 | signal is given. This would caues the loc to snap to center during the 21 | last buffer generated." 22 | [afn loc] 23 | (let [left ^doubles (create-buffer) 24 | right ^doubles (create-buffer) 25 | locfn (arg loc) 26 | out (into-array [left right]) 27 | PI2 (/ Math/PI 2)] 28 | (generator 29 | [last-loc Double/NEGATIVE_INFINITY 30 | last-loc-v Double/NEGATIVE_INFINITY 31 | last-l Double/NEGATIVE_INFINITY 32 | last-r Double/NEGATIVE_INFINITY] 33 | [ain afn 34 | loc locfn] 35 | (if (not== last-loc loc) 36 | (let [new-loc-v (+ 0.5 (* 0.5 loc)) 37 | new-l (db->amp (* 20 (Math/log (Math/cos (* PI2 new-loc-v ))))) 38 | new-r (db->amp (* 20 (Math/log (Math/sin (* PI2 new-loc-v )))))] 39 | (aset left int-indx (* new-l ain)) 40 | (aset right int-indx (* new-r ain)) 41 | (gen-recur loc new-loc-v new-l new-r)) 42 | (do 43 | (aset left int-indx (* last-l ain)) 44 | (aset right int-indx (* last-r ain)) 45 | (gen-recur loc last-loc-v last-l last-r))) 46 | (yield out)))) 47 | -------------------------------------------------------------------------------- /src/main/pink/io/mouse.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:doc "Control-rate functions for getting the mouse's x/y location" 2 | :author "Steven Yi" } 3 | pink.io.mouse 4 | (:import [java.awt MouseInfo Toolkit] 5 | [java.util Arrays]) 6 | (:require [pink.config :refer :all] 7 | [pink.util :refer [shared create-buffer not==]])) 8 | 9 | ;; Ensure unchecked math used for this namespace 10 | (set! *unchecked-math* :warn-on-boxed) 11 | 12 | (def mouse-x-val (atom 0.0)) 13 | (def mouse-y-val (atom 0.0)) 14 | 15 | (let [my-buf-num (long-array 1 -1)] 16 | (defn- update-mouse-vals! 17 | [] 18 | (when (not== (aget my-buf-num 0) (long *current-buffer-num*)) 19 | (aset my-buf-num 0 (long *current-buffer-num*)) 20 | (let [pt (.. MouseInfo getPointerInfo getLocation)] 21 | (reset! mouse-x-val (double (.x pt))) 22 | (reset! mouse-y-val (double (.y pt))))))) 23 | 24 | (defn mouse-read-impl 25 | [mouse-atom] 26 | (let [out ^doubles (create-buffer) 27 | last-val (double-array 1 @mouse-atom) 28 | buffer-size (double *buffer-size*) ] 29 | (Arrays/fill out ^double @mouse-atom) 30 | (fn [] 31 | (update-mouse-vals!) 32 | (let [last-x (aget last-val 0) 33 | cur-x (double @mouse-atom)] 34 | (if (not= last-x cur-x) 35 | (do 36 | (loop [i 0 37 | v last-x 38 | incr (/ (- cur-x last-x) (double *buffer-size*))] 39 | (when (< i buffer-size) 40 | (aset out i v) 41 | (recur (unchecked-inc i) 42 | (+ v incr) 43 | incr))) 44 | (aset last-val 0 cur-x)) 45 | (Arrays/fill out cur-x))) 46 | out))) 47 | 48 | (defn mouse-x [] 49 | (mouse-read-impl mouse-x-val)) 50 | 51 | (defn mouse-y [] 52 | (mouse-read-impl mouse-y-val)) 53 | 54 | (defn get-screen-width [] 55 | (.. Toolkit getDefaultToolkit getScreenSize getWidth)) 56 | 57 | (defn get-screen-height [] 58 | (.. Toolkit getDefaultToolkit getScreenSize getHeight)) 59 | -------------------------------------------------------------------------------- /src/test/pink/filters_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.filters-test 2 | (:require [pink.filters :refer :all] 3 | [pink.oscillators :refer [pulse]] 4 | [pink.config :refer [*sr* *buffer-size*]] 5 | [pink.util :refer [arg]] 6 | [clojure.test :refer :all] 7 | [clojure.pprint :refer [pprint]] 8 | )) 9 | 10 | (defn float= [^double x ^double y] 11 | (<= (Math/abs (- x y)) 0.00001)) 12 | 13 | (defn get-samples 14 | ^doubles [afn ^long num-samples] 15 | (let [out ^doubles (double-array num-samples)] 16 | (loop [^doubles vs (afn) index 0 buffer 0] 17 | (let [q (quot index (long *buffer-size*)) 18 | r (rem index (long *buffer-size*))] 19 | (if (< index num-samples) 20 | (if (> q buffer) 21 | (recur (afn) index q) 22 | (do 23 | ;(println q ":" r ": " (aget vs r)) 24 | (aset out index (aget vs r)) 25 | (recur vs (inc index) buffer))) 26 | out))))) 27 | 28 | (deftest test-one-zero 29 | (let [afn (one-zero (pulse 0.0) 0.5) 30 | samps (get-samples afn 20)] 31 | ;(pprint samps) 32 | (is (float= 1.0 (aget samps 0))) 33 | (is (float= -0.5 (aget samps 1))) 34 | (is (float= 0.0 (aget samps 2))) 35 | ) 36 | (let [afn (one-zero (pulse 0.0) (arg 0.5)) 37 | samps (get-samples afn 20)] 38 | ;(pprint samps) 39 | (is (float= 1.0 (aget samps 0))) 40 | (is (float= -0.5 (aget samps 1))) 41 | (is (float= 0.0 (aget samps 2))) 42 | )) 43 | 44 | (deftest test-one-pole 45 | (let [afn (one-pole (pulse 0.0) 0.5) 46 | samps (get-samples afn 20)] 47 | ;(pprint samps) 48 | (is (float= 1.0 (aget samps 0))) 49 | (is (float= 0.5 (aget samps 1))) 50 | (is (float= 0.25 (aget samps 2))) 51 | ) 52 | (let [afn (one-pole (pulse 0.0) (arg 0.5)) 53 | samps (get-samples afn 20)] 54 | ;(pprint samps) 55 | (is (float= 1.0 (aget samps 0))) 56 | (is (float= 0.5 (aget samps 1))) 57 | (is (float= 0.25 (aget samps 2))) 58 | )) 59 | -------------------------------------------------------------------------------- /src/demo/pink/demo/midi_keys.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.midi-keys 2 | (:require [pink.simple :refer :all] 3 | [pink.io.midi :as midi] 4 | [pink.config :refer :all] 5 | [pink.space :refer :all] 6 | [pink.oscillators :refer :all] 7 | [pink.envelopes :refer :all] 8 | [pink.filters :refer [port butterlp moogladder]] 9 | [pink.util :refer :all]) 10 | (:import [javax.sound.midi ShortMessage ] 11 | [clojure.lang IFn])) 12 | 13 | 14 | (def midim (midi/create-manager)) 15 | (def keyboard (add-virtual-device midim "keyboard 1")) 16 | 17 | (defn saw 18 | [freq amp] 19 | (let-s [amp-env (adsr 0.02 0.02 0.9 0.25) 20 | f (sum freq (mul freq 0.0025 (sine 4)))] 21 | (-> 22 | (sum (mul 0.25 (blit-saw (mul f 2.000))) 23 | (blit-saw f) 24 | (blit-saw (mul f 0.9995)) 25 | (sine2 (mul f 0.5))) 26 | (div 2.0) 27 | (butterlp 2000) 28 | (mul amp amp-env) 29 | (pan 0.0) 30 | ))) 31 | 32 | (comment 33 | ;(bind-device midim "nanoKEY KEYBOARD" "keyboard 1") 34 | (midi/bind-device midim "VMidi 1" "keyboard 1") 35 | 36 | (midi/bind-key-func 37 | keyboard 0 38 | 39 | (let [allocator (create-max-allocator 8) 40 | active ^"[[Z" (make-array Boolean/TYPE 128 1)] 41 | (fn [cmd note-num velocity] 42 | (condp = cmd 43 | ShortMessage/NOTE_ON 44 | (when (acquire-alloc! allocator) 45 | (let [done (boolean-array 1 false) 46 | afn (binding [*done* done] 47 | (with-allocator allocator 48 | (saw (midi->freq note-num) 49 | (/ (double velocity) 127.0))))] 50 | (aset active note-num done) 51 | (add-afunc afn) 52 | )) 53 | 54 | ShortMessage/NOTE_OFF 55 | (when-let [^booleans done (aget active note-num)] 56 | (aset done 0 true) 57 | (aset active note-num nil))))) 58 | 59 | ) 60 | 61 | 62 | (start-engine) 63 | 64 | ) 65 | 66 | -------------------------------------------------------------------------------- /src/main/pink/config.clj: -------------------------------------------------------------------------------- 1 | (ns 2 | ^{:doc "Dynamically-scoped variables used to represent the context of 3 | processing." 4 | :author "Steven Yi"} 5 | pink.config) 6 | 7 | (def 8 | ^{:dynamic true 9 | :doc "The current processing engine."} 10 | *engine* nil) 11 | 12 | (def 13 | ^{:dynamic true 14 | :doc "Sample-rate of processing context/engine." } 15 | *sr* 44100) 16 | 17 | (def 18 | ^{:dynamic true 19 | :doc "Size of buffer for engine (i.e., number of samples to 20 | generate/process per buffer)." } 21 | *buffer-size* 64) 22 | 23 | (def 24 | ^{:dynamic true 25 | :doc "Number of channels configured for processing context/engine." } 26 | *nchnls* 1) 27 | 28 | (def 29 | ^{:dynamic true 30 | :doc "The number of buffers that have processed since engine start. 31 | Multiply by *buffer-size* to get time in samples, then divide time in 32 | samples by *sr* to get time in seconds." } 33 | *current-buffer-num* 0) 34 | 35 | (def 36 | ^{:dynamic true 37 | :doc "Time in beats for duration. This context variable may not be set, and 38 | not all audio functions may use this value." } 39 | *duration* nil) 40 | 41 | (def 42 | ^{:dynamic true 43 | :doc "When used, *done* will hold a 1-element boolean array that holds a 44 | boolean to signal done-ness. Useful in contexts where a signal graph 45 | (i.e., instrument) will play until a signal is given, for example: 46 | 47 | 1. MIDI note on => start instrument 48 | 2. MIDI note off => mark flag done, instrument gracefully turns off 49 | 50 | Envelope generators will be the code most likely to be designed to 51 | look for and use *done*." } 52 | *done* nil) 53 | 54 | (def 55 | ^{:dynamic true 56 | :doc "Tempo of the current processing context. Useful to calculate things 57 | like delay times that are synced with the tempo." } 58 | *tempo* 60.0) 59 | 60 | (def 61 | ^{:dynamic true 62 | :doc "Current time in beats. A continuous value that may change at 63 | different rates depending upon tempo changes. Useful for scheduling 64 | events relative to beat time." } 65 | *beat* 0.0) 66 | 67 | -------------------------------------------------------------------------------- /doc/workflow.md: -------------------------------------------------------------------------------- 1 | # Workflow 2 | 3 | The workflow for using Pink will depend very much on what kind of musical projects you are trying to build. The following serves as a basic guide to try to explain what abstractions and parts of Pink you are likely to use depending on what you are trying to accomplish. In general, users will: 4 | 5 | * Write [Unit Generators](ugen.md) when they are writing low-level digital signal processing code. DSP-code may include things like oscillators, filters, and envelope generators. 6 | * Use Unit Generators to assemble signal processing graphs. In common practice, the total processing graph is built from sub-graphs, some of which are stable and always running (i.e. mixers with effects), while others are dynamically added and removed (i.e. processing per-note of an instrument). You can use the same Unit Generators to build either stable or dynamic sub-graphs. At a high-level, you can think of assembling Unit Generators as ways to build your own effects modules and instruments. 7 | * Use Control Functions to write non-signal-processing code that needs to run in sync with the engine. This is useful for things like clocks that will trigger other application code, or tying in your own event generation code (i.e. generative music) into the engine. This is also useful for automations. 8 | * Use Events for delayed actions. This is useful for organizing and composing notes that will proceed at a given time (i.e. pre-composed music), as well as in realtime applications for [temporal recursion](http://extempore.moso.com.au/temporal_recursion.html). 9 | 10 | 11 | ## Writing Unit Generators 12 | 13 | Writing unit generators is useful for expanding the available set of signal processing functions for your project. Currently, users must work with code and simply run tests to hear results. Future versions of Pink will include graphing functions to help visualize a generators behavior and results. 14 | 15 | For more information on Unit Generators, please see the [Unit Generators](ugen.md) section of this documentation. 16 | 17 | ## Creating Instruments and Effects 18 | 19 | Using Unit Generators, one can create higher-level constructs, such as instruments, mixer, and effects. 20 | 21 | ## Assembling Graphs 22 | 23 | ## Using Events 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Pink 2 | 3 | [![Build Status](https://travis-ci.org/kunstmusik/pink.svg?branch=develop)](https://travis-ci.org/kunstmusik/pink) 4 | 5 | [![Clojars Project](http://clojars.org/kunstmusik/pink/latest-version.svg)](http://clojars.org/kunstmusik/pink) 6 | 7 | A library for music systems development, written in Clojure. 8 | 9 | ## Introduction 10 | 11 | This library provides the basis for developing music systems. It is also designed so to scale to user needs, whether they are exploring and designing low-level signal processing algorithms, developing pre-written compositions, or creating interactive real-time systems. It offers a slim core engine designed to be highly customizable. 12 | 13 | Features include: 14 | 15 | * 64-bit signal processing chain 16 | * Functional Audio Signal Graph: Build up Audio Graphs using functional approach 17 | * Clear Synchronization of time-aware functions with Control Functions 18 | * Higher-order Events: Functions and events can be used as arguments to events 19 | * Use Clojure to extend the system: single language for all extension points to the system 20 | 21 | For more information, please see the [website](http://kunstmusik.github.io/pink). 22 | 23 | ## Installation 24 | 25 | At the moment, installation requires cloning this repostory and installing it using 'lein install'. (This instruction will be updated when a stable release is made available.) 26 | 27 | ## Mailing List 28 | 29 | For questions, please consider joining the Pink Users mailing list [here](https://groups.google.com/forum/?hl=en#!forum/pink-users). 30 | 31 | ## Examples 32 | 33 | Examples for using Pink are available in the [music-examples](http://github.com/kunstmusik/music-examples) project. 34 | 35 | ## YourKit 36 | 37 | 38 | 39 | Many thanks to YourKit for granting an Open Source license. Their software is exceptional for helping to diagnose memory and performance issues with Pink. 40 | 41 | YourKit supports open source projects with its full-featured Java Profiler.YourKit, LLC is the creator of YourKit Java Profiler and YourKit .NET Profiler, innovative and intelligent tools for profiling Java and .NET applications. 42 | 43 | 44 | ## License 45 | 46 | Copyright © 2014 Steven Yi 47 | 48 | Distributed under the Eclipse Public License, the same as Clojure. 49 | -------------------------------------------------------------------------------- /src/main/pink/node/MessageBuffer.java: -------------------------------------------------------------------------------- 1 | package pink.node; 2 | 3 | import java.util.concurrent.atomic.AtomicInteger; 4 | import clojure.lang.IFn; 5 | import clojure.lang.Keyword; 6 | 7 | /** Ring buffer with fixed size array of pre-allocated Messages. 8 | * Designed to be lock-free, wait-free, and used with multiple writers and 9 | * single reader. 10 | * 11 | * Does not currently handle back pressure and assumes user will allocate 12 | * a large enough size for capacity. 13 | * 14 | * @author Steven Yi 15 | */ 16 | public class MessageBuffer { 17 | 18 | private final int capacity; 19 | private final Message[] messages; 20 | private int readStartIndex = 0; 21 | private final AtomicInteger readEndIndex = new AtomicInteger(); 22 | private final AtomicInteger getIndex = new AtomicInteger(); 23 | private final AtomicInteger putIndex = new AtomicInteger(); 24 | 25 | public MessageBuffer() { 26 | this(512); 27 | } 28 | 29 | public MessageBuffer(int initialCapacity) { 30 | this.capacity = initialCapacity; 31 | messages = new Message[initialCapacity]; 32 | for(int i = 0; i < initialCapacity; i++) { 33 | messages[i] = new Message(); 34 | } 35 | } 36 | 37 | private static int getAndIncrementWithModulus(AtomicInteger aInt, int modulus) { 38 | int getVal; 39 | int newVal; 40 | 41 | do { 42 | getVal = aInt.get(); 43 | 44 | newVal = (getVal + 1); 45 | if(newVal == modulus) { 46 | newVal = 0; 47 | } 48 | } while(!aInt.compareAndSet(getVal, newVal)); 49 | 50 | return getVal; 51 | } 52 | 53 | public void postMessage(Keyword msgType, IFn msg) { 54 | Message m = messages[getAndIncrementWithModulus(getIndex, capacity)]; 55 | m.setMessage(msgType, msg); 56 | messages[getAndIncrementWithModulus(putIndex, capacity)] = m; 57 | getAndIncrementWithModulus(readEndIndex, capacity); 58 | } 59 | 60 | public boolean isEmpty() { 61 | return readStartIndex == readEndIndex.get(); 62 | } 63 | 64 | public int getReadStart() { 65 | return readStartIndex; 66 | } 67 | 68 | public void setReadStart(int start) { 69 | readStartIndex = start; 70 | } 71 | 72 | public int getReadEnd() { 73 | return readEndIndex.get(); 74 | } 75 | 76 | public Message getMessage(int index) { 77 | return messages[index]; 78 | } 79 | 80 | public int getCapacity() { 81 | return capacity; 82 | } 83 | 84 | } 85 | -------------------------------------------------------------------------------- /src/test/pink/processes_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.processes-test 2 | (:require [pink.processes :refer [process wait cue countdown-latch] :as p] 3 | [pink.config :refer :all] 4 | [clojure.test :refer :all])) 5 | 6 | (deftest test-process 7 | (let [counter (atom 0) 8 | p (process 9 | (reset! counter 1) 10 | (wait 1.0) 11 | (reset! counter 2)) 12 | num-wait (long (Math/round (+ 0.4999999 (/ *sr* *buffer-size*)))) 13 | ] 14 | (is (= @counter 0)) 15 | (p) 16 | (is (= @counter 1)) 17 | (loop [c 2] 18 | (if (p) 19 | (recur (inc c)) 20 | (is (= c num-wait)))) 21 | 22 | (is (= @counter 2)))) 23 | 24 | (deftest test-process-loop 25 | (let [counter (atom 0) 26 | p (process 27 | (loop [a 0] 28 | (wait 1.0) 29 | (reset! counter (inc a)) 30 | (recur (inc a)))) 31 | num-wait (Math/round (+ 0.4999999 (/ *sr* *buffer-size*))) 32 | num-wait2 (dec num-wait) 33 | ] 34 | (is (= @counter 0)) 35 | (loop [c 0] 36 | (if (= @counter 0) 37 | (do 38 | (p) 39 | (recur (inc c))) 40 | (do 41 | (is (= c num-wait)) 42 | (is (= @counter 1)) 43 | ))) 44 | ;; the last wait from previous loop starts the next wait, 45 | ;; so counting from 1 here 46 | (loop [c 1] 47 | (if (= @counter 1) 48 | (do 49 | (p) 50 | (recur (inc c))) 51 | (do 52 | ;; checking num-wait 2, which is one buffer less 53 | ;; than num-wait, due to leftover samples from 54 | ;; previous wait time 55 | (is (= c num-wait2)) 56 | (is (= @counter 2)) 57 | ))))) 58 | 59 | (deftest test-cue 60 | (let [c (cue)] 61 | (is (not (p/has-cued? c))) 62 | (is (not (p/signal-done? c))) 63 | (p/signal-cue c) 64 | (is (p/has-cued? c)) 65 | (is (p/signal-done? c)) 66 | 67 | )) 68 | 69 | (deftest test-countdown-latch 70 | (let [l (countdown-latch 5)] 71 | (is (not (p/signal-done? l))) 72 | (is (not (p/latch-done? l))) 73 | (p/count-down l) 74 | (is (not (p/latch-done? l))) 75 | (is (not (p/signal-done? l))) 76 | (p/count-down l) 77 | (p/count-down l) 78 | (p/count-down l) 79 | (p/count-down l) 80 | (is (p/latch-done? l)) 81 | (is (p/signal-done? l)) 82 | )) 83 | 84 | -------------------------------------------------------------------------------- /src/test/pink/delays_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.delays-test 2 | (:require [pink.delays :refer :all] 3 | [pink.oscillators :refer [pulse]] 4 | [pink.config :refer [*sr* *buffer-size*]] 5 | [clojure.test :refer :all] 6 | [clojure.pprint :refer [pprint]] 7 | )) 8 | 9 | (defn float= [^double x ^double y] 10 | (<= (Math/abs (- x y)) 0.00001)) 11 | 12 | (defn get-samples 13 | ^doubles [afn ^long num-samples] 14 | (let [out ^doubles (double-array num-samples)] 15 | (loop [^doubles vs (afn) index 0 buffer 0] 16 | (let [q (quot index (long *buffer-size*)) 17 | r (rem index (long *buffer-size*))] 18 | (if (< index num-samples) 19 | (if (> q buffer) 20 | (recur (afn) index q) 21 | (do 22 | ;(println q ":" r ": " (aget vs r)) 23 | (aset out index (aget vs r)) 24 | (recur vs (inc index) buffer))) 25 | out))))) 26 | 27 | (deftest test-samp-delay 28 | (let [afn (samp-delay (pulse 0.0) 1) 29 | samps (get-samples afn 200)] 30 | ;(pprint samps) 31 | (is (float= 0.0 (aget samps 0))) 32 | (is (float= 1.0 (aget samps 1))) 33 | ) 34 | (let [afn (samp-delay (pulse 0.0) 50) 35 | samps (get-samples afn 200)] 36 | ;(pprint samps) 37 | (is (float= 0.0 (aget samps 0))) 38 | (is (float= 1.0 (aget samps 50))) 39 | )) 40 | 41 | (deftest test-frac-delay 42 | (let [afn (frac-delay (pulse 0.0) 1.0) 43 | samps (get-samples afn 200)] 44 | ;(pprint samps) 45 | (is (float= 0.0 (aget samps 0))) 46 | (is (float= 1.0 (aget samps 1)))) 47 | (let [afn (frac-delay (pulse 0.0) 1.5) 48 | samps (get-samples afn 200)] 49 | ;(pprint samps) 50 | (is (float= 0.0 (aget samps 0))) 51 | (is (float= 0.5 (aget samps 1))) 52 | (is (float= 0.5 (aget samps 2))) 53 | (is (float= 0.0 (aget samps 3)))) 54 | (let [afn (frac-delay (pulse 0.0) 1.75) 55 | samps (get-samples afn 200)] 56 | ;(pprint samps) 57 | (is (float= 0.0 (aget samps 0))) 58 | (is (float= 0.25 (aget samps 1))) 59 | (is (float= 0.75 (aget samps 2))) 60 | (is (float= 0.0 (aget samps 3))) 61 | ) 62 | (let [afn (frac-delay (pulse 0.0) 5.85) 63 | samps (get-samples afn 300)] 64 | ;(pprint samps) 65 | (is (float= 0.0 (aget samps 0))) 66 | (is (float= 0.15 (aget samps 5))) 67 | (is (float= 0.85 (aget samps 6))) 68 | (is (float= 0.0 (aget samps 7))) 69 | ) 70 | ) 71 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo9.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo9 2 | (:require [pink.engine :refer :all] 3 | [pink.event :refer :all] 4 | [pink.instruments.horn :refer :all] 5 | [pink.util :refer [mul]] 6 | [pink.oscillators :refer [oscil3 sine-table]] 7 | [pink.envelopes :refer [env]] 8 | [pink.config :refer :all] 9 | )) 10 | 11 | 12 | (defn table-synth-cubic [freq] 13 | (println "Cubic...") 14 | (mul 15 | (oscil3 0.05 freq sine-table) 16 | (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0]))) 17 | 18 | 19 | (comment 20 | 21 | (def e (engine-create :nchnls 2)) 22 | (engine-start e) 23 | 24 | (def num-notes 5) 25 | (let [eng-events 26 | (audio-events e 27 | (map #(event horn (* % 0.5) 28 | (/ 0.75 (+ 1 %)) 29 | (* 220 (+ 1 %)) 30 | (- (* 2 (/ % (- num-notes 1))) 1)) 31 | (range num-notes)))] 32 | (engine-add-events e eng-events)) 33 | 34 | (let [eng-events 35 | (audio-events e 36 | (map #(event horn-stopped (* % 0.5) 37 | ;(/ 0.5 (+ 1 %)) 38 | 0.5 39 | (* 220 (+ 1 %)) 40 | (- (* 2 (/ % (- num-notes 1))) 1)) 41 | (range num-notes)))] 42 | (engine-add-post-cfunc e 43 | (event-list-processor (event-list eng-events *buffer-size* *sr*)))) 44 | 45 | (let [eng-events 46 | (audio-events e 47 | (map #(event horn-muted (* % 0.5) 48 | ;(/ 0.5 (+ 1 %)) 49 | 0.5 50 | (* 220 (+ 1 %)) 51 | (- (* 2 (/ % (- num-notes 1))) 1)) 52 | (range num-notes)))] 53 | (engine-add-post-cfunc e 54 | (event-list-processor (event-list eng-events *buffer-size* *sr*)))) 55 | 56 | 57 | (let [eng-events (audio-events e 58 | (map #(event table-synth-cubic (* % 0.5) (* 220 (+ 1%))) (range num-notes)))] 59 | (engine-add-post-cfunc e 60 | (event-list-processor (event-list eng-events *buffer-size* *sr*))) 61 | 62 | ) 63 | (engine-stop e) 64 | (engine-clear e) 65 | (engine-kill-all) 66 | 67 | 68 | ) 69 | 70 | -------------------------------------------------------------------------------- /src/main/pink/noise.clj: -------------------------------------------------------------------------------- 1 | (ns pink.noise 2 | "Noise audio-functions." 3 | (:require 4 | [pink.config :refer [*sr*]] 5 | [pink.util :refer [create-buffer generator 6 | gen-recur not== arg]])) 7 | 8 | ;; Ensure unchecked math used for this namespace 9 | (set! *unchecked-math* :warn-on-boxed) 10 | 11 | (defn white-noise 12 | "Create white-noise generator." 13 | [] 14 | (let [out ^doubles (create-buffer)] 15 | (generator 16 | [] [] 17 | (let [v (- (* 2 (Math/random)) 1)] 18 | (aset out int-indx v) 19 | (gen-recur)) 20 | (yield out)))) 21 | 22 | 23 | (defn dust 24 | "Generate random impulses from 0 to +1. 25 | 26 | density - average number of impulses per second 27 | mul - amplitude multiplier 28 | 29 | Based on Dust Ugen from SuperCollider 3." 30 | ([density] (dust density 1.0)) 31 | ([density mul] 32 | (let [out (create-buffer) 33 | dfn (arg density) 34 | mfn (arg mul) 35 | sr (double *sr*) 36 | onedsr (/ 1.0 sr)] 37 | (generator 38 | [last-thresh 0 last-d 0] 39 | [d dfn, m mfn] 40 | (let [thresh 41 | (if (not== d last-d) 42 | (* d onedsr) 43 | last-thresh) 44 | scale (if (> thresh 0.0) (/ 1.0 thresh) 0.0) 45 | z (Math/random) 46 | v (if (< z thresh) 47 | (* m (* z scale)) 48 | 0.0)] 49 | (aset out int-indx v) 50 | (gen-recur thresh d)) 51 | (yield out))))) 52 | 53 | (defn dust2 54 | "Generate random impulses from -1 to +1. 55 | 56 | density - average number of impulses per second 57 | mul - amplitude multiplier 58 | 59 | Based on Dust2 Ugen from SuperCollider 3." 60 | 61 | ([density] (dust2 density 1.0)) 62 | ([density mul] 63 | (let [out (create-buffer) 64 | dfn (arg density) 65 | mfn (arg mul) 66 | sr (double *sr*) 67 | onedsr (/ 1.0 sr)] 68 | (generator 69 | [last-thresh 0 last-d 0] 70 | [d dfn, m mfn] 71 | (let [thresh 72 | (if (not== d last-d) 73 | (* d onedsr) 74 | last-thresh) 75 | scale (if (> thresh 0.0) (/ 2.0 thresh) 0.0) 76 | z (Math/random) 77 | v (if (< z thresh) 78 | (* m (- (* z scale) 1.0)) 79 | 0.0)] 80 | (aset out int-indx v) 81 | (gen-recur thresh d)) 82 | (yield out))))) 83 | -------------------------------------------------------------------------------- /src/main/pink/control.clj: -------------------------------------------------------------------------------- 1 | (ns pink.control 2 | ^{:doc "Library for control functions." 3 | :author "Steven Yi"} 4 | (:require [pink.config :refer :all]) 5 | ) 6 | 7 | ;; Ensure unchecked math used for this namespace 8 | (set! *unchecked-math* :warn-on-boxed) 9 | 10 | ;; Chain 11 | 12 | (defn chain 13 | "Creates a control function that chains together other control functions. 14 | Executes first control-fn until completion, then the second, and so on." 15 | [& control-fns] 16 | (let [fns (atom control-fns)] 17 | (fn [] 18 | (loop [cur-fn (first @fns)] 19 | (if cur-fn 20 | (if (cur-fn) 21 | true 22 | (recur (first (swap! fns rest)))) 23 | (do 24 | (reset! fns nil) 25 | false)))))) 26 | 27 | ;; Control Functions 28 | (defn create-clock 29 | "Creates a sample-accurate clock control function that triggers a trigger-fn 30 | according to the tempo held within the tempo-atom atom. When the time has been 31 | met, it will call the given trigger-fn and truncate the running sample-count. 32 | 33 | User can supply an optional state-atom for signaling to the clock for 34 | different running states. Acceptable states are :running, :paused, and :done. 35 | Any other state will result in :done. 36 | 37 | User may also supply an optional done-fn. done-fn will be called when this 38 | clock goes into the :done state. done-fn must be a 0-arity function." 39 | ([tempo-atom trigger-fn] 40 | (create-clock tempo-atom trigger-fn (atom :running))) 41 | ([tempo-atom trigger-fn state-atom] 42 | (create-clock tempo-atom trigger-fn state-atom nil)) 43 | ([tempo-atom trigger-fn state-atom done-fn] 44 | (let [sr (double *sr*) 45 | buffer-size (long *buffer-size*) 46 | init-val (long (* sr (/ 60.0 (double @tempo-atom)))) 47 | ^longs sample-count (long-array 1 init-val)] 48 | (fn [] 49 | (condp = @state-atom 50 | :running 51 | (let [num-samples-to-wait (long (* sr (/ 60.0 (double @tempo-atom)))) 52 | cur-samp (aget sample-count 0)] 53 | (if (>= cur-samp num-samples-to-wait) 54 | (do 55 | (aset sample-count 0 (rem cur-samp num-samples-to-wait)) 56 | (trigger-fn)) 57 | (aset sample-count 0 (+ cur-samp buffer-size))) 58 | true) 59 | :paused 60 | true ;; don't advance clock in any way, just return true 61 | (do 62 | (when done-fn (done-fn)) 63 | false) 64 | ))))) 65 | 66 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo8.clj: -------------------------------------------------------------------------------- 1 | ;; Test of Events 2 | 3 | (ns pink.demo.demo8 4 | (:require [pink.engine :refer :all] 5 | [pink.envelopes :refer [env exp-env adsr xar]] 6 | [pink.oscillators :refer [sine oscil oscili oscil3]] 7 | [pink.gen :refer [gen-sine gen10]] 8 | [pink.util :refer :all] 9 | [pink.config :refer :all] 10 | [pink.event :refer :all] )) 11 | 12 | (def sine256 (gen-sine 128)) 13 | 14 | (def table0 (gen10 65536 1 0.5 0.25 0.125 0.06125 )) 15 | ;(def table0 (gen10 65536 1 1)) 16 | 17 | (defn table-synth [freq] 18 | (println "Truncating...") 19 | (mul 20 | (oscil 0.05 freq sine256) 21 | (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0]))) 22 | 23 | (defn table-synth-interp [freq] 24 | (println "Interpolating...") 25 | (mul 26 | ;(oscili 0.05 freq sine256) 27 | (oscili 0.05 freq table0) 28 | ;(sine 0.05 freq) 29 | (env [0.0 0.0 0.05 1 0.02 0.8 5.2 0.8 0.2 0]))) 30 | 31 | (defn table-synth-cubic [freq] 32 | (println "Cubic...") 33 | (mul 34 | (oscil3 0.05 freq sine256) 35 | (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0]))) 36 | 37 | ;(time-gen (table-synth-interp 440.0)) 38 | 39 | (comment 40 | 41 | (def e (engine-create)) 42 | (engine-start e) 43 | 44 | (let [eng-events (audio-events e 45 | (map #(event table-synth-interp 0.25 (* 110 %)) (range 1 10)))] 46 | 47 | (engine-add-post-cfunc e (event-list-processor 48 | (event-list eng-events *buffer-size* *sr*))) 49 | 50 | ) 51 | 52 | (engine-stop e) 53 | (engine-clear e) 54 | (engine-kill-all) 55 | 56 | (let [e (engine-create) 57 | eng-events 58 | (audio-events e 59 | (event table-synth 0.0 440.0) 60 | (event table-synth 0.0 550.0) 61 | ;(map #(event table-synth-interp 0.25 (* 110 %)) (range 1 36)) 62 | 63 | (event table-synth-interp 1.0 440.0) 64 | (event table-synth-interp 1.0 550.0) 65 | 66 | (event table-synth-cubic 2.0 440.0) 67 | (event table-synth-cubic 2.0 550.0) 68 | 69 | ;(event table-synth-interp 1.0 440.0) 70 | ;(event table-synth-interp 1.0 550.0) 71 | ) 72 | ] 73 | 74 | (engine-start e) 75 | (engine-add-events e eng-events) 76 | 77 | (Thread/sleep 3000) 78 | (engine-stop e) 79 | (engine-clear e)) 80 | 81 | 82 | ) 83 | 84 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject kunstmusik/pink "0.5.0-SNAPSHOT" 2 | :jvm-opts ;["-server" "-Xmx2g" "-XX:-UseParallelGC"] 3 | ^:replace 4 | ["-server" 5 | "-Xmx512m" ; Minimum and maximum sizes of the heap 6 | "-XX:+UseG1GC" 7 | "-XX:MaxGCPauseMillis=1" ; Specify a target of 20ms for max gc pauses 8 | ;"-XX:MaxNewSize=257m" ; Specify the max and min size of the new 9 | ;"-XX:NewSize=256m" ; generation to be small 10 | "-XX:+UseTLAB" ; Uses thread-local object allocation blocks. This 11 | ; improves concurrency by reducing contention on 12 | ; the shared heap lock. 13 | ;"-XX:MaxTenuringThreshold=0" ; Makes the full NewSize available to every NewGC 14 | 15 | ; for GC diagnostics 16 | ;"-XX:+PrintGCDetails" 17 | ;"-XX:+PrintGCTimeStamps" 18 | ;"-XX:+PrintGCApplicationStoppedTime" 19 | ;"-verbose:gc" 20 | ] 21 | :description "A library for music research, composition, and performance." 22 | 23 | :url "http://github.com/kunstmusik/pink" 24 | 25 | :license {:name "Eclipse Public License" 26 | :url "http://www.eclipse.org/legal/epl-v10.html"} 27 | 28 | :dependencies [[org.clojure/clojure "1.8.0"] 29 | [org.clojure/core.async "0.4.474"] 30 | [kunstmusik/diff-eq "0.1.2"]] 31 | 32 | :global-vars {*warn-on-reflection* true} 33 | 34 | :profiles { 35 | :dev { 36 | :dependencies [[criterium "0.4.4"]] 37 | :plugins [[lein-codox "0.10.3"]] 38 | :source-paths ["src/demo"] 39 | } 40 | 41 | :profiling { 42 | :plugins [[lein-nodisassemble "0.1.3"]] } 43 | 44 | :benchmarking { 45 | :source-paths ["src/benchmarks"] 46 | } 47 | 48 | :plotting { 49 | :dependencies [[incanter "1.9.1"] 50 | ;[kunstmusik/pink-viz "0.1.0-SNAPSHOT"] 51 | ] 52 | :source-paths ["src/plotting"] 53 | } 54 | :1.9 { 55 | :dependencies [[org.clojure/clojure "1.9.0"]] 56 | } 57 | } 58 | 59 | 60 | :source-paths ["src/main"] 61 | :test-paths ["src/test"] 62 | :java-source-paths ["src/main"] 63 | :javac-options ["-target" "1.7" "-source" "1.7"] 64 | :scm {:name "git" 65 | :url "https://github.com/kunstmusik/pink.git" } 66 | :codox {:source-paths ["src/main"] } 67 | ;:main 68 | ) 69 | -------------------------------------------------------------------------------- /src/demo/pink/demo/processes.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.processes 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.instruments.piano :refer :all] 5 | [pink.instruments.horn :refer :all] 6 | [pink.util :refer [mul try-func hold-until]] 7 | [pink.filters :refer :all] 8 | [pink.node :refer :all] 9 | [pink.space :refer :all] 10 | [pink.config :refer :all] 11 | [pink.envelopes :refer [env]] 12 | [pink.processes :refer [process wait cue countdown-latch] :as p] 13 | )) 14 | 15 | (defn instr 16 | [amp key-num] 17 | (-> 18 | (piano :duration *duration* :keynum key-num :amp amp) 19 | ;(mul (hold-until 0.5 1.0 (env [0.0 1.0 0.1 0.0]))) 20 | (pan 0.0) 21 | )) 22 | 23 | (defn perf-piano 24 | [start dur amp midi-key] 25 | (add-audio-events 26 | (i instr start dur amp midi-key))) 27 | 28 | (comment 29 | 30 | (start-engine) 31 | 32 | 33 | (add-pre-cfunc 34 | (process 35 | (loop [a 0] 36 | (when (< a 32) 37 | (perf-piano 0 1 0.15 (+ 60 (* 12 (Math/random)))) 38 | (wait 0.25) 39 | (recur (inc a)) 40 | )))) 41 | 42 | (add-pre-cfunc 43 | (process 44 | (loop [a 0] 45 | (when (< a 32) 46 | (let [pitch (+ 60 (* 12 (Math/random)))] 47 | (perf-piano 0 1 0.15 pitch) 48 | (perf-piano 0 1 0.15 (+ 7 pitch))) 49 | (wait 0.25) 50 | (recur (inc a)) 51 | )))) 52 | 53 | (add-pre-cfunc 54 | (process 55 | (loop [a 0] 56 | (when (< a 32) 57 | (let [pitch (+ 48 (* 12 (Math/random)))] 58 | (perf-piano 0 3 0.25 pitch) 59 | ) 60 | (wait 3) 61 | (recur (inc a)) 62 | )))) 63 | 64 | (add-pre-cfunc 65 | (process 66 | (loop [a 0 brownian (Math/random)] 67 | (when (< a 16) 68 | (let [pitch (+ 48 (* 12 (Math/random))) 69 | dur (+ 4 brownian)] 70 | (perf-piano 0 dur 0.25 pitch) 71 | (wait dur)) 72 | (recur (inc a) (mod (+ (Math/random) brownian ) 1.0)) 73 | )))) 74 | 75 | (add-pre-cfunc 76 | (process 77 | (loop [a 0 brownian (Math/random)] 78 | (when (< a 32) 79 | (let [pitch (+ 75 (* 12 (Math/random))) 80 | dur (+ 0.2 brownian)] 81 | (perf-piano 0 dur 0.25 pitch) 82 | (wait dur)) 83 | (recur (inc a) (mod (+ (Math/random) brownian ) 1.0)) 84 | )))) 85 | 86 | (add-audio-events 87 | (i instr 0.0 4.0 0.25 60)) 88 | 89 | (add-audio-events 90 | (i instr 0.0 4.0 0.25 48)) 91 | 92 | (add-audio-events 93 | (i instr 0.0 8.0 0.3 36)) 94 | 95 | ) 96 | 97 | -------------------------------------------------------------------------------- /doc/terminology.md: -------------------------------------------------------------------------------- 1 | # Terminology 2 | 3 | ## Audio Engine 4 | 5 | * Buffer - array of doubles, equal to one \*buffer-size\* in length. The audio engine processes one \*buffer-size\* at a time. A buffer is data for a single channel of audio. 6 | 7 | * Frame - interleaved data for all channels for one sample's length. 8 | 9 | * audio-function - Zero-arg function that returns one-to-many buffers of audio data (depending on channels), or returns nil if the generation and processing of audio is complete for the function. These functions are called once per advancement of engine's time, equal to the \*buffer-size\* / \*sr\*. 10 | 11 | * control-function - Zero-arg function that returns true or false to signal whether the function is done processing or not. These functions are used for side-effects and are to model concurrent processes that are synchronized with the engine's time. Side-effects should be limited to adding and removing new audio or control functions, or adding new events to the engine. Control Functions are called continuously until they return false. 12 | 13 | * event - Events are messages sent to a node or engine. They are conceived strictly as a delayed function application, without any knowledge of what they will do. They contain a start time, a function to call, and args to use with the function. Events are used for side effects. Side-effects should be limited to adding and removing new audio or control functions, or adding new events to the engine. The event results in a one-time function call. 14 | 15 | * node - Nodes in pink are points in a graph that allow for dynamically adding and removing sub-graphs of functions. When used in the audio graph, they run current audio functions and sum output from child audio-functions, as well as discard any audio-function that returns a nil. When used as part of a control graph, they run any current function it contains and removes any that signal false. Nodes have their own message queue for scheduling and processing pending adds and removes. 16 | 17 | * Unit Generator - Composable units of signal processing. These are used to create directed acyclic graphs of signal processing, for example, to build up instruments effects. See [ugen](ugen.md) for more information. 18 | 19 | * Engine Time - The current value of time by the engine, measured as the number of blocks or number of samples since the engine's start, depending on the processing model of the engine. Pink uses a block-based model, so time is measured in number of blocks; sample time can be derived from block time (block number * block size) for sample-accurate operations. For musical operations to be in sync with generated sound, they must be done in sync with engine time. If an operation is done in accordance with another clock (i.e. using a separate timer in another thread), it can not be in sync with the engine time. 20 | -------------------------------------------------------------------------------- /src/main/pink/dynamics.clj: -------------------------------------------------------------------------------- 1 | (ns pink.dynamics 2 | "Functions for dealing with dynamics/amplitude of audio" 3 | (:require [pink.util :refer [create-buffer getd generator gen-recur]] 4 | [pink.config :refer [*buffer-size* *sr*]])) 5 | 6 | ;; Ensure unchecked math used for this namespace 7 | (set! *unchecked-math* :warn-on-boxed) 8 | 9 | (def ^:const ^:private ^{:tag 'double} 10 | LOG10D20 (/ (Math/log 10) 20)) 11 | 12 | (defn db->amp 13 | "Convert decibel to power ratio" 14 | ^double [^double d] 15 | (Math/exp (* d LOG10D20))) 16 | 17 | (defn balance 18 | "Adjust one audio signal according to the values of another. 19 | Based on Csound's balance opcode." 20 | ([asig acomp] (balance asig acomp 10)) 21 | ([asig acomp ^double hp] 22 | {:pre [(number? hp)]} 23 | (let [TPIDSR (/ (* 2 Math/PI) (double *sr*)) 24 | b (- 2.0 (Math/cos (* hp TPIDSR))) 25 | c2 (- b (Math/sqrt (- (* b b) 1.0))) 26 | c1 (- 1.0 c2) 27 | prvq (double-array 1 0.0) 28 | prvr (double-array 1 0.0) 29 | prva (double-array 1 0.0) 30 | out ^doubles (create-buffer)] 31 | 32 | ; this one needs some thought... 33 | ;(generator 34 | ; [prvq 0.0 35 | ; prvr 0.0 36 | ; prva 0.0] 37 | ; [ain asig 38 | ; cin acomp] 39 | 40 | 41 | ; (yield out) 42 | ; ) 43 | 44 | 45 | (fn [] 46 | (let [abuf ^doubles (asig) 47 | cbuf ^doubles (acomp) 48 | buf-size (long *buffer-size*)] 49 | (when (and abuf cbuf) 50 | (loop [i (int 0) 51 | q (getd prvq) 52 | r (getd prvr)] 53 | (if (< i buf-size) 54 | (let [av (aget abuf i) 55 | cv (aget cbuf i)] 56 | (recur 57 | (unchecked-inc i) 58 | (+ (* c1 av av) (* c2 q)) 59 | (+ (* c1 cv cv) (* c2 r)))) 60 | (do 61 | (aset prvq 0 q) 62 | (aset prvr 0 r)))) 63 | (let [q (getd prvq) 64 | r (getd prvr) 65 | a (if (zero? q) 66 | (Math/sqrt r) 67 | (Math/sqrt (/ r q))) 68 | pa (getd prva) 69 | diff (- a pa) 70 | ] 71 | (if (zero? diff) 72 | (loop [i 0] 73 | (when (< i buf-size) 74 | (aset out i (* a (aget abuf i))) 75 | (recur (unchecked-inc i)))) 76 | (let [incr (/ diff buf-size)] 77 | (loop [i 0 m pa] 78 | (if (< i buf-size) 79 | (do 80 | (aset out i (* m (aget abuf i))) 81 | (recur (unchecked-inc i) (+ m incr))) 82 | (aset prva 0 a)) 83 | ))) 84 | 85 | out))))))) 86 | 87 | -------------------------------------------------------------------------------- /src/main/pink/Operator.java: -------------------------------------------------------------------------------- 1 | package pink; 2 | 3 | import clojure.lang.IFn; 4 | 5 | public final class Operator { 6 | 7 | public static void sum(double[] out, double[] a) { 8 | int length = out.length; 9 | for(int i = 0; i < length; i++) { 10 | out[i] += a[i]; 11 | } 12 | } 13 | 14 | public static double[] sum(double[] out, IFn[] fns) { 15 | double[] result = (double[])fns[0].invoke(); 16 | int length = out.length; 17 | int fun_length = fns.length; 18 | if (result == null) { 19 | return null; 20 | } 21 | System.arraycopy(result, 0, out, 0, length); 22 | 23 | for (int i = 1; i < fun_length; i++) { 24 | result = (double[])fns[i].invoke(); 25 | 26 | if (result == null) { 27 | return null; 28 | } 29 | for (int j = 0; j < length; j++) { 30 | out[j] = out[j] + result[j]; 31 | } 32 | } 33 | return out; 34 | } 35 | 36 | public static double[] sub(double[] out, IFn[] fns) { 37 | double[] result = (double[])fns[0].invoke(); 38 | int length = out.length; 39 | int fun_length = fns.length; 40 | if (result == null) { 41 | return null; 42 | } 43 | System.arraycopy(result, 0, out, 0, length); 44 | 45 | for (int i = 1; i < fun_length; i++) { 46 | result = (double[])fns[i].invoke(); 47 | 48 | if (result == null) { 49 | return null; 50 | } 51 | for (int j = 0; j < length; j++) { 52 | out[j] = out[j] - result[j]; 53 | } 54 | } 55 | return out; 56 | } 57 | 58 | 59 | public static double[] mul(double[] out, IFn[] fns) { 60 | double[] result = (double[])fns[0].invoke(); 61 | int length = out.length; 62 | int fun_length = fns.length; 63 | if (result == null) { 64 | return null; 65 | } 66 | System.arraycopy(result, 0, out, 0, length); 67 | 68 | for (int i = 1; i < fun_length; i++) { 69 | result = (double[])fns[i].invoke(); 70 | 71 | if (result == null) { 72 | return null; 73 | } 74 | for (int j = 0; j < length; j++) { 75 | out[j] = out[j] * result[j]; 76 | } 77 | } 78 | return out; 79 | } 80 | 81 | 82 | public static double[] div(double[] out, IFn[] fns) { 83 | double[] result = (double[])fns[0].invoke(); 84 | int length = out.length; 85 | int fun_length = fns.length; 86 | if (result == null) { 87 | return null; 88 | } 89 | System.arraycopy(result, 0, out, 0, length); 90 | 91 | for (int i = 1; i < fun_length; i++) { 92 | result = (double[])fns[i].invoke(); 93 | 94 | if (result == null) { 95 | return null; 96 | } 97 | for (int j = 0; j < length; j++) { 98 | out[j] = out[j] / result[j]; 99 | } 100 | } 101 | return out; 102 | } 103 | 104 | } 105 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_feedback.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-feedback 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.node :refer :all] 5 | [pink.space :refer [pan]] 6 | [pink.oscillators :refer [blit-saw blit-square]] 7 | [pink.envelopes :refer :all] 8 | [pink.util :refer :all] 9 | [pink.noise :refer :all] 10 | [pink.filters :refer :all] 11 | [pink.delays :refer :all] 12 | [pink.config :refer :all] 13 | )) 14 | 15 | 16 | (defn ping-pong-delay 17 | "Creates a stereo ping-pong delay given a mono audio function." 18 | [afn left-delay-time left-amp-mod 19 | right-delay-time right-amp-mod] 20 | (let [^"[[D" out (create-buffers 2) 21 | ain (shared afn) 22 | lfeedback (create-buffer 0.0) 23 | rfeedback (create-buffer 0.0) 24 | ldelay (feedback-write 25 | (fdelay (sum ain 26 | (mul left-amp-mod (feedback-read rfeedback))) 27 | left-delay-time) 28 | lfeedback) 29 | rdelay (feedback-write 30 | (fdelay (sum ain 31 | (mul right-amp-mod (feedback-read lfeedback))) 32 | right-delay-time) 33 | rfeedback )] 34 | (fn [] 35 | (let [aleft (ldelay) 36 | aright (rdelay)] 37 | (when (and aleft aright) 38 | (aset out 0 aleft) 39 | (aset out 1 aright) 40 | out))))) 41 | 42 | (defn instr-saw 43 | [amp freq] 44 | (let-s [e (adsr 0.5 0.0 1.0 4.0)] 45 | (-> (blit-saw freq) 46 | (moogladder (sum 800 (mul e 4000)) 0.5) 47 | (mul e amp)) 48 | )) 49 | 50 | (comment 51 | (defn get-samples 52 | ^doubles [afn ^long num-samples] 53 | (let [out ^doubles (double-array num-samples)] 54 | (loop [^doubles vs (afn) index 0 buffer 0] 55 | (let [q (quot index (long *buffer-size*)) 56 | r (rem index (long *buffer-size*))] 57 | (if (< index num-samples) 58 | (if (> q buffer) 59 | (recur (afn) index q) 60 | (do 61 | (aset out index (* 16384 (aget vs r))) 62 | (recur vs (inc index) buffer))) 63 | out))))) 64 | 65 | (def samps (get-samples (with-duration 10.0 (instr-saw 0.5 440)) 40000)) 66 | 67 | (spectrogram samps)) 68 | 69 | (comment 70 | 71 | (def saw-node (audio-node)) 72 | (def saw-processor (shared saw-node)) 73 | 74 | (add-afunc (pan saw-processor 0.0)) 75 | (add-afunc (ping-pong-delay saw-processor 76 | 0.57 0.9 0.43 0.8)) 77 | 78 | (start-engine) 79 | 80 | (node-add-func saw-node (with-duration 5.0 (instr-saw 0.25 (env [0.0 40 5.0 1000])))) 81 | (node-add-func saw-node (with-duration 5.0 (instr-saw 0.25 (env [0.0 80 5.0 2000])))) 82 | (node-add-func saw-node (with-duration 5.0 (instr-saw 0.25 (env [0.0 120 5.0 3000])))) 83 | 84 | (clear-engine) 85 | (stop-engine) 86 | 87 | ) 88 | -------------------------------------------------------------------------------- /src/main/pink/effects/ringmod.clj: -------------------------------------------------------------------------------- 1 | (ns pink.effects.ringmod 2 | (:require [pink.util :refer [generator gen-recur create-buffer]])) 3 | 4 | ;; Ensure unchecked math used for this namespace 5 | (set! *unchecked-math* :warn-on-boxed) 6 | 7 | (defn- create-ringmod-table 8 | ([] (create-ringmod-table 1.0)) 9 | ([^double distortion] 10 | (let [table-len (long (Math/pow 2 16)) 11 | half (double (/ (long table-len) 2)) 12 | table (double-array table-len) 13 | vb 0.2 14 | vl 0.4 15 | h distortion 16 | vl_vb2 (Math/pow (- vl vb) 2) 17 | vl_vb_denom (- (* 2 vl) (* 2 vb)) 18 | vl_add (* h (/ vl_vb2 vl_vb_denom)) 19 | h_vl (* h vl)] 20 | (loop [i 0] 21 | (when (< i table-len) 22 | (let [v (Math/abs (/ (- i half) half))] 23 | (cond 24 | (<= v vb) 25 | (aset table i 0.0) 26 | (<= v vl) 27 | (aset table i 28 | (* h (/ (Math/pow (- v vb) 2) 29 | vl_vb_denom))) 30 | :else 31 | (aset table i 32 | (+ (* h v) (- h_vl) vl_add))) 33 | (recur (unchecked-inc i))))) 34 | table))) 35 | 36 | ;; this needs to be moved to another place, renamed 37 | ;; so that a tablei ugen can be made 38 | (defn tablei 39 | ^double [^doubles table ^double indx] 40 | (let [table-len (long (alength table)) 41 | max-indx (double (- table-len 1)) 42 | indxt (Math/min max-indx 43 | (* (Math/max (Math/min indx 1.0) 0.0) table-len)) 44 | indx0 (long indxt) 45 | indx1 (unchecked-inc indx0) 46 | frac1 (- indxt indx0) 47 | frac0 (- 1.0 frac1) 48 | v0 (aget table indx0) 49 | v1 (aget table (if (>= indx1 table-len) (- table-len 1) indx1))] 50 | (+ (* frac0 v0) (* frac1 v1)))) 51 | 52 | (defn ringmod 53 | "Implementation of Julian Parker's digital model of a 54 | diode-based ring modulator. 55 | 56 | Experimental. Implementation does not currently do oversampling. 57 | 58 | For more information: 59 | 60 | http://www.acoustics.hut.fi/publications/papers/dafx11-ringmod/ 61 | http://recherche.ircam.fr/pub/dafx11/Papers/66_e.pdf 62 | http://webaudio.prototyping.bbc.co.uk/ring-modulator/" 63 | ([in-afn carrier-afn] (ringmod in-afn carrier-afn 1.0)) 64 | ([in-afn carrier-afn distortion] 65 | (let [out (create-buffer) 66 | ringmod-table (create-ringmod-table distortion)] 67 | (generator 68 | [] 69 | [sig in-afn, carrier carrier-afn] 70 | (let [in (* sig 0.5) 71 | car (+ carrier in) 72 | in2 (- carrier in) 73 | sig1 (tablei ringmod-table (+ 0.5 car)) 74 | sig2 (tablei ringmod-table (+ 0.5 (* -1.0 car))) 75 | sig3 (tablei ringmod-table (+ 0.5 in2)) 76 | sig4 (tablei ringmod-table (+ 0.5 (* -1.0 in2))) 77 | siginv (* -1 (+ sig3 sig4)) 78 | v (+ sig1 sig2 siginv)] 79 | (aset out int-indx v) 80 | (gen-recur)) 81 | (yield out))))) 82 | 83 | -------------------------------------------------------------------------------- /src/main/pink/instruments/drums.clj: -------------------------------------------------------------------------------- 1 | (ns pink.instruments.drums 2 | "Drum instruments." 3 | 4 | (:require [pink.filters :refer :all] 5 | [pink.util :refer :all] 6 | [pink.oscillators :refer :all] 7 | [pink.noise :refer :all])) 8 | 9 | ;; Ensure unchecked math used for this namespace 10 | (set! *unchecked-math* :warn-on-boxed) 11 | 12 | (defn exp-decay [^double decay ^double length] 13 | (let [out (create-buffer)] 14 | (generator 15 | [phs (long 0)] 16 | [] 17 | (do 18 | (if (>= phs length) 19 | (aset out int-indx 0.0) 20 | 21 | (aset out int-indx (Math/pow decay (/ phs length)))) 22 | (gen-recur (inc phs))) 23 | (yield out)))) 24 | 25 | (defn g-noise [^double rng] 26 | (let [out (create-buffer) 27 | drng (* 2.0 rng)] 28 | (generator 29 | [][] 30 | (let [v (- (* (Math/random) drng) rng)] 31 | (aset out int-indx (if (> v 0.0) v 0.0)) 32 | (gen-recur)) 33 | (yield out)))) 34 | 35 | (defn end-when-silent 36 | "FIXME: This will not work when buffer-size = 1..." 37 | [afn] 38 | (fn [] 39 | (when-let [^doubles sig (afn)] 40 | (if (and (zero? (aget sig 0)) 41 | (zero? (aget sig (dec (alength sig))))) 42 | nil 43 | sig)))) 44 | 45 | (defn kick 46 | "Kick Drum. 47 | 48 | Ported from Charlie Roberts' Gibberish" 49 | ([] (kick 2.0)) 50 | ([amp] (kick amp 50.0 20.0 1000.0)) 51 | ([amp freq decay tone] 52 | (end-when-silent 53 | (-> 54 | (pulse 0.0 60.0) 55 | (zdf-2pole freq 20.0 2) ;; band-pass signal 56 | (zdf-2pole tone 0.5 0) ;; low-pass signal 57 | (mul amp))))) 58 | 59 | (defn conga 60 | "Conga. 61 | 62 | Ported from Charlie Roberts' Gibberish" 63 | ([] (conga 2)) 64 | ([amp] (conga amp 190)) 65 | ([amp freq] 66 | (end-when-silent 67 | (-> 68 | (pulse 0.0 60.0) 69 | (zdf-2pole freq 50.0 2) ;; band-pass 70 | (mul amp))))) 71 | 72 | (defn clave 73 | "Clave. 74 | 75 | Ported from Charlie Roberts' Gibberish" 76 | ([] (clave 1.0)) 77 | ([amp] (clave amp 2500)) 78 | ([amp freq] 79 | (end-when-silent 80 | (-> 81 | (pulse 0.0 2.0) 82 | (zdf-2pole freq 5.0 2) ;; band-pass 83 | (mul amp))))) 84 | 85 | 86 | (defn tom 87 | "Tom. 88 | 89 | Ported from Charlie Roberts' Gibberish" 90 | ([] (tom 0.5)) 91 | ([amp] (tom amp 80)) 92 | ([amp freq] 93 | (end-when-silent 94 | (-> 95 | (sum 96 | (-> 97 | (pulse 0.0 60.0) 98 | (zdf-2pole freq 30.0 2)) ;; band-pass 99 | (-> 100 | (g-noise 8) 101 | (mul (exp-decay 0.05 11025)) 102 | (zdf-2pole 120.0 0.5 0))) 103 | (mul amp) 104 | )))) 105 | 106 | (defn clap 107 | ([] (clap 0.5)) 108 | ([amp] 109 | #_(end-when-silent 110 | (-> 111 | 112 | ) 113 | ) 114 | ) 115 | ) 116 | 117 | (defn cowbell 118 | [] 119 | ) 120 | 121 | (defn snare [tune cutoff snappy amp]) 122 | 123 | (defn hat 124 | [] 125 | ) 126 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_disk.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-disk 2 | (:require [pink.engine :refer :all] 3 | [pink.event :refer :all] 4 | [pink.instruments.horn :refer :all] 5 | [pink.util :refer [mul]] 6 | [pink.oscillators :refer [oscil3 sine-table]] 7 | [pink.envelopes :refer [env]] 8 | ) 9 | (:import [java.io File])) 10 | 11 | 12 | (defn table-synth-cubic [freq] 13 | (println "Cubic...") 14 | (mul 15 | (oscil3 0.05 freq sine-table) 16 | (env [0.0 0.0 0.05 2 0.02 1.5 0.2 1.5 0.2 0]))) 17 | 18 | (defn test-to-disk [] 19 | 20 | (let [e (engine-create :nchnls 2) 21 | schedule 22 | (fn [events] 23 | (engine-add-events e (audio-events e events))) 24 | num-notes 5] 25 | 26 | (schedule (map #(event horn (* % 0.5) 27 | (/ 0.75 (+ 1 %)) 28 | (* 220 (+ 1 %)) 29 | (- (* 2 (/ % (- num-notes 1))) 1)) 30 | (range num-notes))) 31 | 32 | (schedule 33 | (map #(event horn-stopped (+ 5 (* % 0.5)) 34 | 0.5 35 | (* 220 (+ 1 %)) 36 | (- (* 2 (/ % (- num-notes 1))) 1)) 37 | (range num-notes))) 38 | 39 | (schedule (map #(event horn-muted (+ 10 (* % 0.5)) 40 | ;(/ 0.5 (+ 1 %)) 41 | 0.5 42 | (* 220 (+ 1 %)) 43 | (- (* 2 (/ % (- num-notes 1))) 1)) 44 | (range num-notes))) 45 | 46 | (schedule (map #(event table-synth-cubic (+ 15 (* % 0.5)) 47 | (* 220 (+ 1%))) (range num-notes))) 48 | 49 | (engine->disk e (str (System/getProperty "user.home") 50 | File/separator "test.wav")) 51 | 52 | (engine-clear e) 53 | (engine-kill-all) 54 | 55 | ) 56 | 57 | 58 | ) 59 | 60 | 61 | (comment 62 | 63 | (def e (engine-create :nchnls 2)) 64 | 65 | (def num-notes 5) 66 | (defn schedule 67 | [events] 68 | (engine-add-events e (audio-events e events))) 69 | 70 | (schedule (map #(event horn (* % 0.5) 71 | (/ 0.75 (+ 1 %)) 72 | (* 220 (+ 1 %)) 73 | (- (* 2 (/ % (- num-notes 1))) 1)) 74 | (range num-notes))) 75 | 76 | (schedule 77 | (map #(event horn-stopped (+ 5 (* % 0.5)) 78 | 0.5 79 | (* 220 (+ 1 %)) 80 | (- (* 2 (/ % (- num-notes 1))) 1)) 81 | (range num-notes))) 82 | 83 | (schedule (map #(event horn-muted (+ 10 (* % 0.5)) 84 | ;(/ 0.5 (+ 1 %)) 85 | 0.5 86 | (* 220 (+ 1 %)) 87 | (- (* 2 (/ % (- num-notes 1))) 1)) 88 | (range num-notes))) 89 | 90 | (schedule (map #(event table-synth-cubic (+ 15 (* % 0.5)) 91 | (* 220 (+ 1%))) (range num-notes))) 92 | 93 | (engine->disk e (str (System/getProperty "user.home") 94 | File/separator "test.wav")) 95 | 96 | (engine-clear e) 97 | (engine-kill-all) 98 | 99 | 100 | ) 101 | 102 | -------------------------------------------------------------------------------- /src/main/pink/effects/distortion.clj: -------------------------------------------------------------------------------- 1 | (ns pink.effects.distortion 2 | "Distortion effects." 3 | (:require [pink.config :refer [*sr*]] 4 | [pink.util :refer :all]) 5 | (:import [clojure.lang IFn$DD])) 6 | 7 | ;; Ensure unchecked math used for this namespace 8 | (set! *unchecked-math* :warn-on-boxed) 9 | 10 | (defn distort 11 | "Hyperbolic tangent distortion. Provides normalized (i.e. in range (-1,+1)) 12 | or non-normalized processing (i.e. (-0.7616, 0.7616) for input (-1,+1)). 13 | Normalized processing is the default but is more expensive to use. 14 | Saturation defaults to 1.0; larger values will increase the distortion 15 | quality." 16 | 17 | ([afn] (distort afn 1.0)) 18 | ([afn saturation] (distort afn saturation true)) 19 | ([afn saturation normalized] 20 | (let [out (create-buffer) 21 | sfn (arg saturation)] 22 | (if normalized 23 | ;; normalized version 24 | (generator 25 | [] [sig afn, sat sfn] 26 | (do 27 | (aset out int-indx 28 | (* (/ 1.0 (Math/tanh sat)) 29 | (Math/tanh (* sat sig)))) 30 | (gen-recur)) 31 | (yield out)) 32 | 33 | ;; non-normalized version 34 | (generator 35 | [] [sig afn, sat sfn] 36 | (do 37 | (aset out int-indx (Math/tanh (* sat sig))) 38 | (gen-recur)) 39 | (yield out)) 40 | )))) 41 | 42 | (defn distort1 43 | "Modified hyperbolic tangent distortion. Provides separate shaping of 44 | positive and negative parts of signal (i.e., asymetric waveshaping). 45 | distort1 using the following formula: 46 | 47 | exp(asig * (shape1 + pregain)) - exp(asig * (shape2 - pregain)) 48 | aout = --------------------------------------------------------------- 49 | exp(asig * pregain) + exp(-asig * pregain) 50 | 51 | ARGS 52 | 53 | pre-gain - determines the amount of gain applied to the signal before 54 | waveshaping. A value of 1 gives slight distortion. 55 | 56 | post-gain - determines the amount of gain applied to the signal after 57 | waveshaping. 58 | 59 | shape1 - determines the shape of the positive part of the curve. A value of 0 60 | gives a flat clip, small positive values give sloped shaping. 61 | 62 | shape2 - determines the shape of the negative part of the curve. 63 | 64 | (The above quoted from the Csound manual entry for distort1; see link below.) 65 | 66 | Based on Csound's distort1 opcode by Hans Mikelson. For further information, 67 | see: 68 | 69 | http://csound.github.io/docs/manual/distort1.html 70 | http://www.csoundjournal.com/ezine/winter1999/processing/ 71 | http://folk.ntnu.no/oyvinbra/gdsp/Lesson4Modtanh.html 72 | " 73 | 74 | [afn pre-gain post-gain shape1 shape2] 75 | (let [out (create-buffer) 76 | prefn (arg pre-gain) 77 | postfn (arg post-gain) 78 | shape1fn (arg shape1) 79 | shape2fn (arg shape2)] 80 | (generator 81 | [] [sig afn, pre prefn, post postfn, shp1 shape1fn, shp2 shape2fn] 82 | (let [v (/ (- (Math/exp (* sig (+ shp1 pre))) 83 | (Math/exp (* sig (- shp2 pre)))) 84 | (+ (Math/exp (* sig pre)) 85 | (Math/exp (* (- sig) pre))))] 86 | (aset out int-indx (* v post)) 87 | (gen-recur)) 88 | (yield out)))) 89 | 90 | -------------------------------------------------------------------------------- /src/plotting/pink/plotting.clj: -------------------------------------------------------------------------------- 1 | (ns pink.plotting 2 | (:require [pink.util :refer [shared arg mul with-duration create-buffer generator]] 3 | [pink.envelopes :refer [env]] 4 | [pink.config :refer [*buffer-size* *current-buffer-num* *sr*]] 5 | [clojure.pprint :refer [pprint]]) 6 | (:use [incanter core charts])) 7 | 8 | (defn- not-nil? [a] (not (nil? a))) 9 | 10 | (defn- get-buffers [afns i] 11 | (binding [*current-buffer-num* i] 12 | (let [bufs (map (fn [a] (a)) afns)] 13 | (if (every? not-nil? bufs) 14 | bufs 15 | nil)))) 16 | 17 | (defn- data-for-afns 18 | "Generates audio signals from afns. Uses doall to force updating of vector data 19 | as audio functions reuse buffers and data is only valid for current *current-buffer-num*." 20 | [afns] 21 | (loop [i 0 22 | ys (map (fn [a] []) (range (count afns)))] 23 | (let [bufs (get-buffers afns i)] 24 | (if (and bufs (< i 20000)) 25 | (recur (unchecked-inc-int i) 26 | (doall (map #(into %1 %2) ys bufs ))) 27 | (do 28 | (map #(vector (range (* i *buffer-size*)) %) ys)))))) 29 | 30 | (defn visualize 31 | [& afns] 32 | (let [data (data-for-afns afns)] 33 | (loop [[afn-data & rst] data 34 | plt nil] 35 | (if afn-data 36 | (let [[x y] afn-data] 37 | (if plt 38 | (do 39 | (add-lines plt x y 40 | :x-label "Samples" 41 | :y-label "Signal" 42 | ) 43 | (recur rst plt)) 44 | (recur rst (xy-plot x y 45 | :x-label "Samples" 46 | :y-label "Signal")))) 47 | (view plt))))) 48 | 49 | (defn visualize-with-duration 50 | [dur & afns] 51 | (let [args (map #(mul (env [0.0 1.0 dur 1.0]) %) afns)] 52 | (apply visualize args))) 53 | 54 | ;(visualize (with-duration 2.0 (adsr 0.02 0.05 0.9 0.5))) 55 | 56 | ;(visualize (with-duration 2.0 (adsr 0.5 0.5 0.8 0.5))) 57 | 58 | ;(visualize (mul (env [0.0 1.0 0.05 1.0]) 59 | ; (blit-pulse (env [0.0 220 1.0 220]) 0.5))) 60 | 61 | ;(visualize (mul (env [0.0 1.0 0.05 1.0]) 62 | ; (blit-pulse 220 0.5))) 63 | 64 | 65 | ;(visualize (mul (env [0.0 1.0 0.3 1.0]) 66 | ; (blit-triangle 440)) 67 | ; (mul (env [0.0 1.0 0.3 1.0]) 68 | ; (blit-square 440)) 69 | ; ) 70 | 71 | 72 | ;(visualize (mul (env [0.0 1.0 0.3 1.0]) 73 | ; (blit-square-static-1 440 0)) 74 | ; (mul (env [0.0 1.0 0.3 1.0]) 75 | ; (blit-square-static-2 440 0)) 76 | ; ) 77 | 78 | ;(let [amp 0.5 79 | ; freq 220 80 | ; env0 (shared 81 | 82 | ;(let [amp 0.5 83 | ; freq 220 84 | ; env0 (shared 85 | ; (if (number? amp) 86 | ; (env [0 0 0.02 amp 0.03 (* 0.9 amp) 0.5 (* 0.9 amp) 0.2 0.0] ) 87 | ; (arg amp))) 88 | ; env1 (shared (mul env0 env0)) 89 | ; env2 (shared (mul env1 env0)) 90 | ; env3 (shared (mul env2 env0)) 91 | ; envs [env0 env1 env2 env3] 92 | ; freqf (shared (arg freq)) 93 | ; phase 0.5 94 | ; [adjust & tbls] (horn-lookup freq horn-stopped-wave-tables) 95 | ; tbl-fns (map oscil3 envs (repeat freqf) tbls (repeat phase)) 96 | ; ] 97 | ; (visualize env0 env1) 98 | ; ) 99 | 100 | ;(visualize (horn-stopped 0.5 220)) 101 | -------------------------------------------------------------------------------- /src/main/pink/instruments/pluck.clj: -------------------------------------------------------------------------------- 1 | (ns pink.instruments.pluck 2 | "Implementations of Karplus-Strong algorithm for plucked strings." 3 | 4 | (:require [pink.util :refer :all] 5 | [pink.config :refer [*buffer-size* *current-buffer-num* *sr*]] 6 | [pink.envelopes :refer :all] 7 | [pink.gen :refer [gen9 gen17]] 8 | [pink.oscillators :refer :all] 9 | [pink.filters :refer [tone atone]] 10 | [pink.delays :refer :all] 11 | [diff-eq.core :refer [dfn]]) 12 | (:import [clojure.lang IFn$LD IFn$DD])) 13 | 14 | ;; Ensure unchecked math used for this namespace 15 | (set! *unchecked-math* :warn-on-boxed) 16 | 17 | (defn ss-one-pole 18 | [^double pole ^double gain] 19 | (let [b0 (if (> pole 0.0) (- 1.0 pole) (+ 1.0 pole)) 20 | a1 (- pole)] 21 | (dfn [samp] 22 | y (- (* b0 (* samp gain)) 23 | (* a1 [y -1]))))) 24 | 25 | (defn- ss-one-zero 26 | [^double zero] 27 | (let [b0 (if (> zero 0.0) 28 | (/ 1.0 (+ 1.0 zero)) 29 | (/ 1.0 (- 1.0 zero))) 30 | b1 (* (- zero) b0)] 31 | (dfn [samp] 32 | y (+ (* b1 [samp -1]) 33 | (* b0 samp))))) 34 | 35 | (defn phase-delay-one-zero 36 | ^double [^double freq ^double zero] 37 | (let [b0 (if (> zero 0.0) 38 | (/ 1.0 (+ 1.0 zero)) 39 | (/ 1.0 (- 1.0 zero))) 40 | b1 (* (- zero) b0) 41 | omegaT (/ (* 2.0 Math/PI freq) (double *sr*)) 42 | real (+ (* b0 (Math/cos 0.0)) 43 | (* b1 (Math/cos omegaT))) 44 | imag (- 0.0 45 | (* b0 (Math/sin 0.0)) 46 | (* b1 (Math/sin omegaT))) 47 | phase (rem (Math/atan2 real imag) (* 2.0 Math/PI))] 48 | (/ phase omegaT))) 49 | 50 | (defn- create-noise-buffer 51 | ^doubles [^double amp ^long len] 52 | (let [^doubles b (double-array len) 53 | pick-filter (ss-one-pole 54 | (- 0.999 (* amp 0.15)) 55 | (* 0.5 amp))] 56 | (loop [indx 0] 57 | (when (< indx len) 58 | (aset b indx ^double (pick-filter (Math/random))) 59 | (recur (inc indx)))) 60 | b)) 61 | 62 | 63 | ;; TODO - factor in done-gain 64 | 65 | (defn pluck 66 | "Basic Karplus-Strong implementation based on Plucked 67 | class from STK. 68 | 69 | amp - overall amplitude of pluck 70 | freq - frequency in hertz 71 | " 72 | [^double amp ^double freq] 73 | (let [out (create-buffer) 74 | delay-time (- (/ (double *sr*) freq) 75 | (phase-delay-one-zero freq -1.0)) 76 | ^doubles delay-buffer 77 | (create-noise-buffer amp 78 | (int (+ 0.5 delay-time))) 79 | delay-length (long (alength delay-buffer)) 80 | rw-ptr (int-array 1 0) 81 | ^IFn$LD del-read (delay-readi delay-buffer 82 | delay-time) 83 | init-loop-gain (Math/min 84 | 0.99999 85 | (+ 0.995 (* freq 0.000005))) 86 | done-gain (- 1.0 amp) 87 | ^IFn$DD loop-filter (ss-one-zero -1.0)] 88 | (generator 89 | [rw-ptr (long 0) 90 | counter (long 0) 91 | loop-gain init-loop-gain] 92 | [] 93 | (let [new-v (.invokePrim del-read rw-ptr) 94 | v (.invokePrim loop-filter (* new-v loop-gain))] 95 | (aset delay-buffer rw-ptr v) 96 | (aset out int-indx (* 3.0 v)) 97 | (gen-recur 98 | (rem (unchecked-inc rw-ptr) delay-length) 99 | (unchecked-inc counter) 100 | loop-gain)) 101 | (yield out)))) 102 | 103 | 104 | -------------------------------------------------------------------------------- /doc/processes.md: -------------------------------------------------------------------------------- 1 | # Processes 2 | 3 | ## Introduction 4 | 5 | Processes are a way to create Pink control functions using code that "feels" like writing multi-threaded code. The process macro from pink.processes is used to create the process and is most often used in conjunction with the wait function. The wait function pauses the operation of the process for the given time in seconds, until a signal is received, or until a predicate indicates that the wait condition is no longer valid. 6 | 7 | Processes, like Chuck's Shreds, are run synchronously with the engine. However, unlike Chuck, Pink's processes are run at block rate rather than sample rate, due to the differences in engine designs. (Pink users may set \*buffer-size\* to 1 to operate at sample rate.) The calculations for Pink's wait times are, however, sample accurate, with deterministic jitter to the size of the buffer. 8 | 9 | Processes, like any control function, may be added directly to a Pink engine or scheduled via event to process sometime within the future. Since processes are synchronously processed, users may create control code that works both in realtime as well as ahead-of-time (i.e., when rendering to disk). 10 | 11 | ## Example 12 | 13 | The following code creates a process that loops 32 times. Each iteration will create a random pitch, call perf-piano twice using that pitch at a major 5th apart, then wait 0.25 seconds until the next iteration of the loop. 14 | 15 | ```clojure 16 | (add-pre-cfunc 17 | (process 18 | (loop [a 0] 19 | (when (< a 32) 20 | (let [pitch (+ 60 (* 12 (Math/random)))] 21 | (perf-piano 0 1 0.15 pitch) 22 | (perf-piano 0 1 0.15 (+ 7 pitch))) 23 | (wait 0.25) 24 | (recur (inc a)) 25 | )))) 26 | ``` 27 | 28 | The example shows the add-pre-cfunc function used to add the process as a control function to the global pink.simple engine. (The code is taken from src/demo/pink/demo/processes.clj). 29 | 30 | ## Wait Types 31 | 32 | The wait function is designed to operate using one of three argument types. The first is a numeric value in seconds and is calculated according the sample rate of the engine. Users wanting to use other time values, such as beats, should convert their values accordingly. 33 | 34 | The second argument type is a PinkSignal. The pink.processes namespace provides two options that satisfy the PinkSignal protocol: cues, used for one-time signaling from one source to many processes, and latches, used for a single listener awaiting upon signals from multiple processes. These two signal types all for interprocess notification and can be used to implement aleatoric processes (i.e., Lutoslawski 'ad libitum' writing). An example of this is found in the source code for music-examples.processes, found within the music-examples project, where a conductor and multiple performance processes cue and signal each other to determine when new material should be performed. 35 | 36 | The third argument type is a predicate. Users may supply an arbitrary predicate function. The process will wait as long as the predicate returns truthy values (i.e., true) and the wait will complete when the predicate returns a falsey value (i.e., false, nil). 37 | 38 | 39 | ## Implementation Notes 40 | 41 | The pink process macro utilizes the ioc\_macros from [core.async](https://github.com/clojure/core.async/) to transform user code into a state machine. The state machine and its execution is wrapped into a function that operates according to the Pink control function convention of returning true if the process is still running, and false if it is complete. 42 | 43 | Many thanks to Timothy Baldridge and the rest of the core.async contributors for creating a wonderfully extensible library that could be reused for the purposes of programs like Pink. 44 | -------------------------------------------------------------------------------- /src/main/pink/effects/chorus.clj: -------------------------------------------------------------------------------- 1 | (ns 2 | ^{:doc "Chorus Effects" 3 | :author "Steven Yi"} 4 | pink.effects.chorus 5 | (:require [pink.config :refer :all] 6 | [pink.oscillators :refer :all] 7 | [pink.delays :refer :all] 8 | [pink.util :refer :all])) 9 | 10 | ;; Ensure unchecked math used for this namespace 11 | (set! *unchecked-math* :warn-on-boxed) 12 | 13 | (def ^:private ^:const ^{:tag 'double} LEVEL 0.3) 14 | (def ^:private ^:const ^{:tag 'double} DELAY-MS 0.01) 15 | (def ^:private ^:const ^{:tag 'double} DEPTH-MS 0.002) 16 | (def ^:private ^:const ^{:tag 'double} LFO-MIN 0.5) 17 | (def ^:private ^:const ^{:tag 'double} LFO-MAX 0.25) 18 | (def ^:private SINE-TABLE (pink.gen/gen-sine)) 19 | 20 | (def ^:private PHASES 21 | [0.00 0.08 0.17 0.25 0.33 0.42 22 | 0.50 0.58 0.67 0.75 0.83 0.92]) 23 | 24 | (defn- chorus-line 25 | [^double phs] 26 | (oscil DEPTH-MS (+ (double (rand LFO-MAX)) LFO-MIN) SINE-TABLE phs)) 27 | 28 | (defn chorus 29 | "Adds stereo chorus to a stereo-signal audio-function. 30 | 31 | Based on a Csound-coded design by Atte Andre Jenson" 32 | [afn ^double wet-dry] 33 | (let [out ^"[[D" (create-buffers 2) 34 | left ^doubles (aget out 0) 35 | right ^doubles (aget out 1) 36 | ^doubles delay-buffer (create-delay (+ DELAY-MS DEPTH-MS 0.1)) 37 | buffer-len (alength delay-buffer) 38 | ;lfos (into-array (map chorus-line PHASES)) 39 | line0 (chorus-line 0.00) 40 | line1 (chorus-line 0.00) 41 | line2 (chorus-line 0.17) 42 | line3 (chorus-line 0.25) 43 | line4 (chorus-line 0.33) 44 | line5 (chorus-line 0.42) 45 | line6 (chorus-line 0.50) 46 | line7 (chorus-line 0.58) 47 | line8 (chorus-line 0.67) 48 | line9 (chorus-line 0.75) 49 | line10 (chorus-line 0.83) 50 | line11 (chorus-line 0.92) 51 | dry (- 1.0 wet-dry)] 52 | (with-signals [[inL inR] afn] 53 | (generator 54 | [write-ptr (long 0)] 55 | [l inL 56 | r inR 57 | lfo0 line0 58 | lfo1 line1 59 | lfo2 line2 60 | lfo3 line3 61 | lfo4 line4 62 | lfo5 line5 63 | lfo6 line6 64 | lfo7 line7 65 | lfo8 line8 66 | lfo9 line9 67 | lfo10 line10 68 | lfo11 line11] 69 | (let [sig (* LEVEL (+ (double l) (double r))) 70 | d0 (delay-read-samp-i delay-buffer write-ptr (+ lfo0 DELAY-MS)) 71 | d1 (delay-read-samp-i delay-buffer write-ptr (+ lfo1 DELAY-MS)) 72 | d2 (delay-read-samp-i delay-buffer write-ptr (+ lfo2 DELAY-MS)) 73 | d3 (delay-read-samp-i delay-buffer write-ptr (+ lfo3 DELAY-MS)) 74 | d4 (delay-read-samp-i delay-buffer write-ptr (+ lfo4 DELAY-MS)) 75 | d5 (delay-read-samp-i delay-buffer write-ptr (+ lfo5 DELAY-MS)) 76 | d6 (delay-read-samp-i delay-buffer write-ptr (+ lfo6 DELAY-MS)) 77 | d7 (delay-read-samp-i delay-buffer write-ptr (+ lfo7 DELAY-MS)) 78 | d8 (delay-read-samp-i delay-buffer write-ptr (+ lfo8 DELAY-MS)) 79 | d9 (delay-read-samp-i delay-buffer write-ptr (+ lfo9 DELAY-MS)) 80 | d10 (delay-read-samp-i delay-buffer write-ptr (+ lfo10 DELAY-MS)) 81 | d11 (delay-read-samp-i delay-buffer write-ptr (+ lfo11 DELAY-MS)) 82 | chorusL (+ d0 d1 d2 d3 d4 d5) 83 | chorusR (+ d6 d7 d8 d9 d10 d11) 84 | outL (+ (* (double l) dry) (* chorusL wet-dry)) 85 | outR (+ (* (double r) dry) (* chorusR wet-dry)) 86 | new-write-ptr (inc write-ptr)] 87 | (aset left int-indx outL) 88 | (aset right int-indx outR) 89 | (aset delay-buffer write-ptr sig) 90 | (gen-recur (if (>= new-write-ptr buffer-len) 0 new-write-ptr))) 91 | (yield out))) 92 | )) 93 | 94 | ;; TODO: Implement time-varying cubic delays... 95 | ;(defn solina-chorus 96 | ; "Mono chorus modeled after Solina String Ensemble chorus module. Takes in 97 | ; audio function source, then pair of LFO frequency and amplitudes." 98 | ; [afn lfo-freq1 lfo-amp1 lfo-freq2 lfo-amp2] 99 | ; (let [lfreq1 (arg lfo-freq1) 100 | ; lamp1 (arg lfo-amp1) 101 | ; lfreq2 (arg lfo-freq2) 102 | ; lamp2 (arg lfo-amp2)] 103 | 104 | ; ) 105 | ; ) 106 | -------------------------------------------------------------------------------- /src/demo/pink/demo/processes_signals.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.processes-signals 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.instruments.piano :refer :all] 5 | [pink.instruments.horn :refer :all] 6 | [pink.util :refer [mul try-func hold-until]] 7 | [pink.filters :refer :all] 8 | [pink.node :refer :all] 9 | [pink.space :refer :all] 10 | [pink.config :refer :all] 11 | [pink.envelopes :refer [env]] 12 | [pink.processes :refer [process wait cue countdown-latch] :as p] 13 | [pink.control :refer [chain]] 14 | )) 15 | 16 | ;; Study in Lutoslawski-style aleatory (i.e., ad libitum). Cues used by 17 | ;; conductor process to signal performer processes. Latch used by conductor to 18 | ;; wait for each of the initial processes to complete at least one iteration 19 | ;; before waiting to give initial cue. 20 | 21 | (defn instr 22 | [amp key-num] 23 | (-> 24 | (piano :duration *duration* :keynum key-num :amp amp) 25 | ;(mul (hold-until 0.5 1.0 (env [0.0 1.0 0.1 0.0]))) 26 | (pan 0.0) 27 | )) 28 | 29 | (defn perf-piano 30 | [start dur amp midi-key] 31 | (add-audio-events 32 | (i instr start dur amp midi-key))) 33 | 34 | (defn perf-until-cued 35 | [pitches durs cue] 36 | (process 37 | (loop [] 38 | (when (not (p/has-cued? cue)) 39 | (let [time-adj (+ 1 (* 0.2 (Math/random)))] 40 | (loop [[p & p-r] pitches [d & d-r] durs] 41 | (when (and p d) 42 | (let [dur (* d time-adj)] 43 | (when (not= p :rest) 44 | (perf-piano 0 dur 0.15 (+ 72 p))) 45 | (wait dur) 46 | (recur p-r d-r))))) 47 | (recur) 48 | )))) 49 | 50 | (defn perf-until-cued-signal-latch 51 | [pitches durs cue latch] 52 | (process 53 | (loop [cued-latch false] 54 | (when (not (p/has-cued? cue)) 55 | (let [time-adj (+ 1 (* 0.2 (Math/random)))] 56 | (loop [[p & p-r] pitches [d & d-r] durs] 57 | (when (and p d) 58 | (let [dur (* d time-adj)] 59 | (when (not= p :rest) 60 | (perf-piano 0 dur 0.15 (+ 72 p))) 61 | (wait dur)) 62 | (recur p-r d-r)))) 63 | (when (not cued-latch) 64 | (p/count-down latch)) 65 | (recur true) 66 | )))) 67 | 68 | (defn transpose 69 | [v tr] 70 | (map #(if (number? %) (+ % tr) %) v)) 71 | 72 | ;; SETUP PERFORMER PROCESSES 73 | 74 | (def cue0 (cue)) 75 | (def cue1 (cue)) 76 | (def latch0 (countdown-latch 3)) 77 | 78 | (def p1-proc0 79 | (perf-until-cued-signal-latch 80 | [0 2 3 0 2 3 :rest 6] 81 | [0.1 0.1 0.1 0.1 0.1 0.1 0.8 2.0] 82 | cue0 latch0)) 83 | 84 | (def p1-proc1 85 | (perf-until-cued 86 | [0 2 3 0 2 3 5 3 2 :rest -1] 87 | [0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.8 2.0] 88 | cue1)) 89 | 90 | 91 | (def p2-proc0 92 | (perf-until-cued-signal-latch 93 | (transpose [8 9 11 :rest 8 11 9 :rest] -24) 94 | [0.1 0.1 0.2 0.2 0.1 0.1 0.2 1.5 ] 95 | cue0 latch0)) 96 | 97 | 98 | (def p2-proc1 99 | (perf-until-cued 100 | (transpose [8 9 11 8 9 11 :rest 8 11 9 :rest] -24) 101 | [0.1 0.1 0.1 0.1 0.1 0.2 0.2 0.1 0.1 0.2 1.5 ] 102 | cue1)) 103 | 104 | 105 | (def p3-proc0 106 | (perf-until-cued-signal-latch 107 | (transpose [5 5 5 :rest 5 :rest 5 5 :rest] -12) 108 | [0.1 0.1 0.1 0.1 0.2 0.1 0.2 0.1 0.1 0.2] 109 | cue0 latch0)) 110 | 111 | 112 | (def p3-proc1 113 | (perf-until-cued 114 | (transpose [5 5 5 :rest 5 :rest 5 5 :rest] -12) 115 | [0.1 0.1 0.1 0.2 0.1 0.2 0.1 0.1 0.2] 116 | cue1)) 117 | 118 | 119 | (def p1 (chain p1-proc0 p1-proc1)) 120 | (def p2 (chain p2-proc0 p2-proc1)) 121 | (def p3 (chain p3-proc0 p3-proc1)) 122 | 123 | (def conductor 124 | (process 125 | (add-pre-cfunc p1) 126 | (wait (+ 1 (Math/random))) 127 | (add-pre-cfunc p2) 128 | (wait (+ 1 (Math/random))) 129 | (add-pre-cfunc p3) 130 | (wait latch0) 131 | (wait 12.0) 132 | (p/signal-cue cue0) 133 | (wait 15.0) 134 | (p/signal-cue cue1) 135 | )) 136 | 137 | (comment 138 | 139 | (start-engine) 140 | 141 | ;; Testing of PinkSignals 142 | (add-pre-cfunc conductor) 143 | 144 | ) 145 | -------------------------------------------------------------------------------- /src/test/pink/event_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.event-test 2 | (:require [pink.event :refer :all] 3 | [clojure.test :refer :all] 4 | [pink.config :refer :all]) 5 | (:import [java.util PriorityQueue] 6 | [pink.event Event EventList]) 7 | ) 8 | 9 | (defmacro with-private-fns [[ns fns] & tests] 10 | "Refers private fns from ns and runs tests in context." 11 | `(let ~(reduce #(conj %1 %2 `(ns-resolve '~ns '~%2)) [] fns) 12 | ~@tests)) 13 | 14 | (defn test-audio-func []) 15 | 16 | (deftest event-test 17 | (let [evt ^Event (event test-audio-func 0.5 1.0 4.0 :test)] 18 | (is (= 0.5 (.start evt))) 19 | (is (= [1.0 4.0 :test] (.event-args evt))) 20 | (is (= test-audio-func (.event-func evt))) ) 21 | ;test no-arg event 22 | (let [evt ^Event (event test-audio-func 0.5)] 23 | (is (= 0.5 (.start evt))) 24 | (is (= [] (.event-args evt))) 25 | (is (= test-audio-func (.event-func evt))) 26 | )) 27 | 28 | (deftest event-list-test 29 | (let [test-note (event test-audio-func 0.0 1.0 440.0) 30 | evtlst ^EventList (event-list [test-note] *buffer-size* *sr*) 31 | events ^PriorityQueue (.events evtlst)] 32 | (is (= 1 (.size events))) 33 | (is (= test-note (.peek events))) 34 | 35 | )) 36 | 37 | (deftest alter-event-time-test 38 | (let [evt ^Event (event test-audio-func 0.5) 39 | evt2 ^Event (alter-event-time 0.0 evt) 40 | ] 41 | (is (= 0.0 (.start evt2))) 42 | (is (= [] (.event-args evt2))) 43 | (is (= test-audio-func (.event-func evt2))) 44 | 45 | (is (= (.event-args evt) (.event-args evt2))) 46 | (is (= (.event-func evt) (.event-func evt2))) 47 | )) 48 | 49 | (defn event-equals 50 | [^Event e1 ^Event e2] 51 | (and (= (.event-func e1) (.event-func e2)) 52 | (= (.start e1) (.start e2)) 53 | (= (.event-args e1) (.event-args e2)))) 54 | 55 | (deftest event-list-add-test 56 | (with-private-fns [pink.event [merge-pending!]] 57 | (let [test-note (event test-audio-func 0.0 1.0 440.0) 58 | test-note-dupe (event test-audio-func 0.0 1.0 440.0) 59 | test-note2 (event test-audio-func 0.1 1.1 880.0) 60 | test-note3 (event test-audio-func 0.2 1.0 220.0) 61 | evtlst (event-list [test-note2] *buffer-size* *sr*) 62 | events ^PriorityQueue (.events evtlst)] 63 | 64 | (event-list-add evtlst test-note3) 65 | (event-list-add evtlst test-note) 66 | (event-list-add evtlst test-note-dupe) 67 | 68 | (merge-pending! evtlst) 69 | 70 | (is (= 4 (.size events))) 71 | (is (event-equals test-note (.poll events))) 72 | (is (event-equals test-note-dupe (.poll events))) 73 | (is (event-equals test-note2 (.poll events))) 74 | (is (event-equals test-note3 (.poll events))) 75 | 76 | ;;;Test that adding same note is skipped 77 | ;(event-list-add evtlst test-note) 78 | ;(is (= 2 (count (:events evtlst)))) 79 | 80 | 81 | ))) 82 | 83 | 84 | (deftest event-list-absolute-time-test 85 | (with-private-fns [pink.event [merge-pending!]] 86 | (let [test-note (event test-audio-func 0.0 1.0 440.0) 87 | test-note-dupe (event test-audio-func 0.0 1.0 440.0) 88 | test-note2 (event test-audio-func 0.1 1.1 880.0) 89 | test-note3 (event test-audio-func 0.2 1.0 220.0) 90 | evtlst (event-list [test-note2] *buffer-size* *sr*) 91 | events ^PriorityQueue (.events evtlst)] 92 | (event-list-tick! evtlst) 93 | (event-list-tick! evtlst) 94 | (event-list-tick! evtlst) 95 | 96 | (use-absolute-time! evtlst) 97 | 98 | (event-list-add evtlst test-note3) 99 | (event-list-add evtlst test-note) 100 | (event-list-add evtlst test-note-dupe) 101 | 102 | (merge-pending! evtlst) 103 | 104 | (is (= 4 (.size events))) 105 | (is (event-equals test-note (.poll events))) 106 | (is (event-equals test-note-dupe (.poll events))) 107 | (is (event-equals test-note2 (.poll events))) 108 | (is (event-equals test-note3 (.poll events))) 109 | 110 | ;;;Test that adding same note is skipped 111 | ;(event-list-add evtlst test-note) 112 | ;(is (= 2 (count (:events evtlst)))) 113 | 114 | 115 | ))) 116 | 117 | ;(deftest event-list-remove-test 118 | ; (let [test-note (event test-audio-func 0.0 1.0 440.0) 119 | ; test-note2 (event test-audio-func 0.0 1.0 880.0) 120 | ; evtlst (event-list [test-note]) ] 121 | ; (event-list-add evtlst test-note2) 122 | ;; (print "\n OMG " @(:events evtlst) "\n") 123 | ; (event-list-remove evtlst test-note) 124 | ; (is (= [test-note2] @(:events evtlst))) 125 | ; )) 126 | 127 | -------------------------------------------------------------------------------- /src/main/pink/gen.clj: -------------------------------------------------------------------------------- 1 | (ns pink.gen 2 | "Table generator Functions" 3 | (:import [java.util Arrays])) 4 | 5 | ;; Ensure unchecked math used for this namespace 6 | (set! *unchecked-math* :warn-on-boxed) 7 | 8 | (def ^:const ^:private ^{:tag 'double} TWO_PI (* 2.0 Math/PI)) 9 | 10 | (defn get-sine-value 11 | [^double phase] 12 | (Math/sin (* ^double TWO_PI phase))) 13 | 14 | (defn gen-sine 15 | "Generates a sine wave with n size table (default to 2^16 (65536))" 16 | ([] (gen-sine 65536)) 17 | ([^long n] 18 | (let [^doubles buffer (double-array n)] 19 | (loop [indx (int 0)] 20 | (when (< indx n) 21 | (let [^double v (get-sine-value (/ indx (double n)))] 22 | (aset buffer indx v)) 23 | (recur (inc indx)))) 24 | buffer))) 25 | 26 | 27 | (defn min-max 28 | "Returns the min and max values of the given table." 29 | [^doubles tbl] 30 | (let [len (alength tbl)] 31 | (loop [i 0 32 | mn Double/MAX_VALUE 33 | mx Double/MIN_VALUE] 34 | (if (< i len) 35 | (let [v (aget tbl i) 36 | new-mn (if (< v mn) v mn) 37 | new-mx (if (> v mx) v mx)] 38 | (recur (unchecked-inc i) new-mn new-mx)) 39 | [mn mx])))) 40 | 41 | (defn table-max 42 | "Finds max absolute value within a table" 43 | ^double [^doubles tbl] 44 | (areduce tbl indx ret 0.0 45 | (Math/max ret (Math/abs (aget tbl indx))))) 46 | 47 | (defn rescale! 48 | "Rescales values in table to -1.0,1.0. Not: this is a destructive change." 49 | [^doubles tbl] 50 | (let [len (alength tbl) 51 | rescale-val (table-max tbl)] 52 | (loop [indx 0] 53 | (when (< indx len) 54 | (aset tbl indx (/ (aget tbl indx) rescale-val)) 55 | (recur (unchecked-inc indx)))) 56 | tbl)) 57 | 58 | ; GEN routines 59 | 60 | (defn gen9 61 | "Generates a set of sine waves, given a list of lists of values 62 | in the form of [partial strength & phase]. The partial must be a positive 63 | number, but may be fractional. However, fractional partial values will 64 | generate truncated, non-full cycle waveforms. Strengths are in the range of 65 | 0.0 to 1.0. Phases are optional and are expressed in 0-360 degrees, defaulting 66 | to 0." 67 | [tbl-size & pts] 68 | {:pre [(every? #(pos? ^double (first %)) pts)]} 69 | (let [size (long tbl-size) 70 | dbl-size (double size) 71 | out (double-array size)] 72 | (loop [[[^double harmonic ^double strength & [^double phs]] & xs] pts] 73 | (when (and harmonic strength) 74 | (let [phs-adj (if (nil? phs) 75 | 0.0 76 | (rem (/ phs 360.0) 1.0))] 77 | (loop [indx 0] 78 | (when (< indx size) 79 | (let [cur-val (aget out indx) 80 | ^double sine-val 81 | (get-sine-value (rem (+ phs-adj 82 | (* harmonic (/ indx dbl-size))) 1)) 83 | new-val (+ cur-val (* strength sine-val))] 84 | (aset out indx new-val) 85 | (recur (unchecked-inc indx))))) 86 | (recur xs)))) 87 | (rescale! out))) 88 | 89 | (defn gen10 90 | "Generates a set of sine waves, given a list of amplitude values for each 91 | harmonic" 92 | [tbl-size & pts] 93 | (let [size ^long tbl-size 94 | out (double-array size)] 95 | (loop [harmonic 1 [^double strength & xs] pts] 96 | (when (some? strength) 97 | (if (<= strength 0) 98 | (recur (unchecked-inc harmonic) xs) 99 | (do 100 | (loop [indx (int 0)] 101 | (when (< indx size) 102 | (let [last-val (aget out indx) 103 | ^double sine-val 104 | (get-sine-value 105 | (* strength 106 | (rem (* harmonic (/ indx (double size))) 1)))] 107 | (aset out indx (+ last-val sine-val)) 108 | (recur (unchecked-inc indx))))) 109 | (recur (unchecked-inc harmonic) xs))))) 110 | (rescale! out))) 111 | 112 | (defn gen17 113 | "Generates a step-wise function from x/y pairs" 114 | [tbl-size & pts] 115 | (let [pairs (partition 2 pts) 116 | out (double-array tbl-size)] 117 | (loop [[[^int x1 ^double y1] & xs] pairs] 118 | 119 | (let [[^int x2 ^double y2] (first xs)] 120 | (if (and x2 y2) 121 | (do 122 | (Arrays/fill out x1 x2 y1) 123 | (recur xs)) 124 | (Arrays/fill out x1 (int tbl-size) y1)))) 125 | out)) 126 | -------------------------------------------------------------------------------- /src/main/pink/simple.clj: -------------------------------------------------------------------------------- 1 | (ns 2 | ^{:doc "Simple interface for single-engine projects" 3 | :author "Steven Yi"} 4 | pink.simple 5 | (:require [pink.engine :refer :all] 6 | [pink.util :refer [with-duration apply!*!]] 7 | [pink.event :refer [event use-absolute-time!]]) 8 | (:import [pink.engine Engine] 9 | [pink.event EventList])) 10 | 11 | ;; Ensure unchecked math used for this namespace 12 | (set! *unchecked-math* :warn-on-boxed) 13 | 14 | (def engine (engine-create :nchnls 2)) 15 | 16 | (defn start-engine 17 | "Starts the global pink.simple engine." 18 | [] 19 | (engine-start engine)) 20 | 21 | (defn stop-engine 22 | "Stops the global pink.simple engine." 23 | [] 24 | (engine-stop engine)) 25 | 26 | (defn clear-engine 27 | "Clears the global pink.simple engine. Will clear out active and pending 28 | functions and evnts from the root audio node, control functions, events." 29 | [] 30 | (engine-clear engine)) 31 | 32 | (defn add-afunc 33 | "Add an audio function to the root node of the pink.simple engine." 34 | [afn] 35 | (engine-add-afunc engine afn)) 36 | 37 | (defn remove-afunc 38 | "Removes an audio function from the root node of the pink.simple engine." 39 | [afn] 40 | (engine-remove-afunc engine afn)) 41 | 42 | (defn add-pre-cfunc 43 | "Add a control function to the pre-audio node for the pink.simple engine." 44 | [cfn] 45 | (engine-add-pre-cfunc engine cfn)) 46 | 47 | (defn remove-pre-cfunc 48 | "Remove a control function from the pre-audio node for the pink.simple engine." 49 | [cfn] 50 | (engine-remove-pre-cfunc engine cfn)) 51 | 52 | (defn add-post-cfunc 53 | "Add a control function to the post-audio node for the pink.simple engine." 54 | [cfn] 55 | (engine-add-post-cfunc engine cfn)) 56 | 57 | (defn remove-post-cfunc 58 | "Remove a control function from the post-audio node for the pink.simple engine." 59 | [cfn] 60 | (engine-remove-post-cfunc engine cfn)) 61 | 62 | (defn get-tempo 63 | "Get the current tempo from the engine's built-in event-list." 64 | ^double [] 65 | (engine-get-tempo engine)) 66 | 67 | (defn set-tempo 68 | "Set the current tempo on the engine's built-in event-list." 69 | [^double tempo] 70 | (engine-set-tempo engine tempo)) 71 | 72 | (defn add-events 73 | "Takes in list of events and adds to engine's event list." 74 | ([evts] 75 | (engine-add-events engine evts)) 76 | ([evt & evts] 77 | (add-events (list* evt evts)))) 78 | 79 | (defn clear-events 80 | "Clears all pending events in engine's event list" 81 | [] 82 | (engine-clear-events engine)) 83 | 84 | (defn add-audio-events 85 | "Takes in list of events, wraps in audio events, and adds to engine's event list." 86 | ([evts] 87 | (engine-add-events engine (audio-events engine evts))) 88 | ([evt & evts] 89 | (add-audio-events (list* evt evts)))) 90 | 91 | (defn use-absolute-time-events! 92 | "Set the Pink simple engine's event list to process events without modifying event 93 | start times. By default, Pink will process new events' start time as relative to 94 | the cur-beat time. When absolute time is set, events will be merged as-is." 95 | [] 96 | (use-absolute-time! (.event-list ^Engine engine)) ) 97 | 98 | (defn now 99 | "Returns the current *beat* time of the engine." 100 | ^double [] 101 | (.getCurBeat ^EventList (.event-list ^Engine engine))) 102 | 103 | (defn tempo 104 | "Returns the current *tempo* of the engine." 105 | ^double [] 106 | (engine-get-tempo ^Engine engine)) 107 | 108 | ;; higher level 109 | 110 | (defn apply-afunc-with-dur 111 | "Applies an afunc to args, wrapping results with (with-duration dur)." 112 | [afunc dur & args] 113 | (with-duration (double dur) 114 | (apply!*! afunc args))) 115 | 116 | (defn i 117 | "Csound style note events: audio-func, start, dur, & args. 118 | Wraps into an event that will call audio-func with args, and wrap 119 | with with-duration call with dur. Most likely used in conjunction 120 | with add-audio-events so that generated afuncs will be added to 121 | to an engine." 122 | [afunc start dur & args] 123 | (apply event apply-afunc-with-dur start afunc dur args)) 124 | 125 | (defn with-afunc 126 | "Wraps note lists with calls to i with audio-func to use." 127 | ([afunc notelist] 128 | (map #(apply i afunc %) notelist)) 129 | ([afunc note & notes] 130 | (with-afunc afunc (list* note notes)))) 131 | 132 | (defn sco->events 133 | "Convert SCO formatted note lists into events by applying i to all notes. 134 | SCO format follows Csound style note events: audio-func, start, dur, & args." 135 | [notes] 136 | (map #(apply i %) notes)) 137 | 138 | 139 | -------------------------------------------------------------------------------- /src/main/pink/delays.clj: -------------------------------------------------------------------------------- 1 | (ns pink.delays 2 | (:require [pink.config :refer :all] 3 | [pink.util :refer [create-buffer mix-buffers generator gen-recur]]) 4 | (:import [clojure.lang IFn$LD]) 5 | ) 6 | 7 | ;; Ensure unchecked math used for this namespace 8 | (set! *unchecked-math* :warn-on-boxed) 9 | 10 | ;; feedback functions 11 | 12 | (defn feedback-read 13 | "Takes in a buffer and returns an audio function that will return that buffer. 14 | Pair with feedback-write to do feedback in signal graph. " 15 | [buffer] 16 | (fn [] 17 | buffer)) 18 | 19 | (defn feedback-write 20 | "Writes afn result into a buffer as side-effect, returns afn result. Pair with 21 | feedback-read to do feedback in signal graph. " 22 | [afn buffer] 23 | (let [buffer-size (long *buffer-size*)] 24 | (fn [] 25 | (when-let [b (afn)] 26 | (System/arraycopy b 0 buffer 0 buffer-size) 27 | b)))) 28 | 29 | ;; sample read function 30 | 31 | (defn delay-read-samp-i 32 | ^double [^doubles delay-buffer ^long write-ptr ^double delay-time] 33 | (let [delay-int (long delay-time) 34 | delay-frac1 (- delay-time delay-int) 35 | delay-frac0 (- 1.0 delay-frac1) 36 | delay-length (long (alength delay-buffer))] 37 | (let [indx0 (let [temp-indx (- write-ptr delay-int)] 38 | (if (< temp-indx 0) (+ temp-indx delay-length) temp-indx)) 39 | v0 (aget delay-buffer indx0) 40 | indx1 (let [temp-indx (- indx0 1)] 41 | (if (< temp-indx 0) (+ temp-indx delay-length) temp-indx)) 42 | v1 (aget delay-buffer indx1) 43 | v (+ (* delay-frac0 v0) (* delay-frac1 v1))] 44 | v))) 45 | 46 | ;; Delay utility functions 47 | 48 | (defn create-delay 49 | ^doubles [^double delay-time-max] 50 | (double-array (int (+ 0.5 (* delay-time-max (double *sr*)))))) 51 | 52 | (defn delay-read 53 | ^clojure.lang.IFn$LD [^doubles delay-buffer ^long delay-time] 54 | (let [delay-length (long (alength delay-buffer))] 55 | (fn ^double [^long write-ptr] 56 | (let [indx (let [temp-indx (- write-ptr delay-time)] 57 | (if (< temp-indx 0) (+ temp-indx delay-length) temp-indx))] 58 | (aget delay-buffer indx))))) 59 | 60 | (defn delay-readi 61 | ^clojure.lang.IFn$LD [^doubles delay-buffer ^double delay-time] 62 | (let [delay-int (long delay-time) 63 | delay-frac1 (- delay-time delay-int) 64 | delay-frac0 (- 1.0 delay-frac1) 65 | delay-length (long (alength delay-buffer))] 66 | (fn ^double [^long write-ptr] 67 | (let [indx0 (let [temp-indx (- write-ptr delay-int)] 68 | (if (< temp-indx 0) (+ temp-indx delay-length) temp-indx)) 69 | v0 (aget delay-buffer indx0) 70 | indx1 (let [temp-indx (- indx0 1)] 71 | (if (< temp-indx 0) (+ temp-indx delay-length) temp-indx)) 72 | v1 (aget delay-buffer indx1) 73 | v (+ (* delay-frac0 v0) (* delay-frac1 v1))] 74 | v)))) 75 | 76 | ;; simple adelay 77 | 78 | (defn samp-delay 79 | "Non-interpolating delay-line with fixed-delay-time. delay-time given in 80 | samples." 81 | [afn ^long delay-time] 82 | (let [out (create-buffer) 83 | ^doubles delay-buffer (double-array delay-time) 84 | rw-ptr (int-array 1 0)] 85 | (generator 86 | [rw-ptr (long 0)] 87 | [sig afn] 88 | (let [v (aget delay-buffer rw-ptr)] 89 | (aset delay-buffer rw-ptr sig) 90 | (aset out int-indx v) 91 | (gen-recur (rem (unchecked-inc rw-ptr) delay-time))) 92 | (yield out)))) 93 | 94 | (defn frac-delay 95 | "Linear interpolating (fractional) delay-line. delay-time given in samples." 96 | [afn ^double delay-time] 97 | (let [out (create-buffer) 98 | delay-length (+ (long delay-time) 1) 99 | ^doubles delay-buffer (double-array delay-length) 100 | rw-ptr (int-array 1 0) 101 | ^IFn$LD del-read (delay-readi delay-buffer delay-time)] 102 | (generator 103 | [rw-ptr (long 0)] 104 | [sig afn] 105 | (let [v (.invokePrim del-read rw-ptr)] 106 | (aset delay-buffer rw-ptr sig) 107 | (aset out int-indx v) 108 | (gen-recur (rem (unchecked-inc rw-ptr) delay-length))) 109 | (yield out)))) 110 | 111 | (defn adelay 112 | "Non-interpolating delay-line with fixed delay-time. delay-time given in 113 | seconds." 114 | [afn ^double delay-time] 115 | (samp-delay afn (int (+ 0.5 (* delay-time (double *sr*)))))) 116 | 117 | 118 | (defn fdelay 119 | "Interpolating (fractional) delay-line with fixed delay-time. delay-time 120 | given in seconds." 121 | [afn ^double delay-time] 122 | (frac-delay afn (* delay-time (double *sr*)))) 123 | 124 | 125 | ;;(defn delay-write 126 | ; [delay-buffer afn] 127 | 128 | ; ) 129 | 130 | 131 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_band_limited.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-band-limited 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.space :refer [pan]] 5 | [pink.oscillators :refer :all] 6 | [pink.envelopes :refer [env xar adsr]] 7 | [pink.util :refer [mul sum let-s with-duration]] 8 | [pink.node :refer :all] 9 | [pink.filters :refer :all] 10 | [pink.delays :refer [adelay]] 11 | )) 12 | 13 | (defn instr-saw 14 | [amp freq loc] 15 | (let-s [e (xar 0.01 1.0)] 16 | (pan 17 | (mul e 18 | (lpf18 (sum 19 | (blit-saw freq) 20 | (blit-saw (sum 0.873 freq)) 21 | (blit-saw (sum -0.95117 freq))) 22 | (sum 4000 (mul e 2000)) 23 | 0.6 0.1) 24 | ;(butterlp (blit-saw freq) 25 | ; (sum 100 (mul e 400))) 26 | 27 | ) 28 | loc))) 29 | 30 | (defn instr-square 31 | [amp freq loc] 32 | (let-s [e (xar 0.01 1.0)] 33 | (pan 34 | (mul e amp 35 | (butterlp (blit-square freq) 36 | (sum 100 (mul e 400)))) 37 | loc))) 38 | 39 | (defn instr-triangle 40 | [amp freq loc] 41 | (let-s [e (if (fn? amp) 42 | amp 43 | (mul amp (env [0.0 0.0 0.1 1.0 3.0 1.0 0.1 0.0])))] 44 | (-> 45 | (blit-triangle freq) 46 | ;(butterlp (sum 100 (mul e 400))) 47 | (mul e) 48 | (pan loc)))) 49 | 50 | (defn vox-humana 51 | [amp ^double freq ^double loc] 52 | (let [pulse-freq (mul freq (sum 1.0004 (lfo 0.013 3.5 :triangle))) 53 | pulse-width (sum 0.625 (lfo 0.125 5.72 :triangle)) 54 | saw-freq (mul freq (sum 1 (lfo 0.021 5.04 :triangle))) 55 | key-follow (+ 1 (Math/exp (/ (- freq 50.0) 10000.0))) ] 56 | (let-s [e (if (fn? amp) 57 | amp 58 | (mul amp (env [0.0 0.0 0.1 1.0 3.0 1.0 0.1 0.0])))] 59 | (-> 60 | (sum (blit-saw saw-freq) 61 | (blit-pulse pulse-freq pulse-width)) 62 | 63 | (butterlp (* key-follow 1986)) 64 | (mul e 0.5) 65 | (pan loc))))) 66 | 67 | 68 | ;(def a (instr-saw 0.1 440 0.0)) 69 | ;(def b (blit-saw 440)) 70 | ;(require '[no.disassemble :refer :all]) 71 | ;(println (disassemble b)) 72 | ;(require '[clojure.pprint :refer [pprint]]) 73 | ;(pprint (a)) 74 | 75 | (comment 76 | 77 | (start-engine) 78 | 79 | (def root-node (audio-node :channels 2)) 80 | (add-afunc root-node) 81 | 82 | ;(def root-node (create-node :channels 1)) 83 | ;(def delayed-audio-node 84 | ; (let-s [afn (node-processor root-node)] 85 | ; (sum afn (adelay afn 0.25)))) 86 | 87 | ;(engine-add-afunc e delayed-audio-node) 88 | 89 | (def my-score 90 | (let [num-notes 10] 91 | (node-events root-node 92 | (map #(event instr-saw (* % 0.25) 93 | (/ 0.75 (+ 1 %)) 94 | (* 220 (+ 1 %)) 95 | (- (* 2 (/ % (- num-notes 1))) 1)) 96 | (range num-notes))))) 97 | 98 | (add-events my-score) 99 | 100 | (node-add-func 101 | root-node 102 | (instr-saw 0.25 (env [0.0 220 0.1 200 0.0001 220 0.1 500]) 0.0)) 103 | 104 | 105 | (def my-score2 106 | (let [num-notes 10] 107 | (node-events root-node 108 | (map #(event instr-square (* % 0.5) 109 | (/ 0.75 (+ 1 %)) 110 | (* 65 (+ 1 %)) 111 | (- (* 2 (/ % (- num-notes 1))) 1)) 112 | (range num-notes))))) 113 | 114 | (add-events my-score2) 115 | 116 | (node-add-func 117 | root-node 118 | (instr-square 0.5 (env [0.0 200 0.05 40 0.4 40]) 0.0)) 119 | 120 | 121 | (node-add-func 122 | root-node 123 | (instr-square 0.5 440 0.0)) 124 | 125 | (node-add-func 126 | root-node 127 | (instr-triangle 0.5 1100 0.0)) 128 | 129 | 130 | (add-afunc 131 | (with-duration 1.0 132 | (mul (adsr 0.01 0.0 1.0 2.0) 0.5 133 | (blit-triangle (env [0.0 200 4.0 800]) )))) 134 | 135 | (node-add-func 136 | root-node 137 | (instr-triangle 0.5 138 | (env [0.0 200 4.0 800]) 0.0)) 139 | 140 | (node-add-func 141 | root-node 142 | (instr-triangle (mul 0.5 (xar 0.01 1.0)) (env [0.0 200 0.05 40 0.4 40]) 0.0)) 143 | 144 | (add-afunc 145 | (with-duration 8.0 146 | (vox-humana (mul 0.5 (adsr 0.453 0.0 1.0 2.242)) 440 0.0))) 147 | 148 | (add-afunc 149 | (with-duration 8.0 150 | (vox-humana (mul 0.5 (adsr 0.453 0.0 1.0 2.242)) 880 0.0))) 151 | 152 | (def my-score3 153 | (let [num-notes 10] 154 | (node-events root-node 155 | (map #(event instr-triangle (* % 0.5) 156 | (/ 0.75 (+ 1 %)) 157 | (* 65 (+ 1 %)) 158 | (- (* 2 (/ % (- num-notes 1))) 1)) 159 | (range num-notes))))) 160 | 161 | 162 | 163 | (add-events my-score3) 164 | 165 | (stop-engine) 166 | 167 | 168 | ) 169 | 170 | -------------------------------------------------------------------------------- /src/main/pink/effects/reverb.clj: -------------------------------------------------------------------------------- 1 | (ns pink.effects.reverb 2 | (:require [pink.config :refer [*sr*]] 3 | [pink.util :refer :all]) 4 | (:import [clojure.lang IFn$DD])) 5 | 6 | ;; Ensure unchecked math used for this namespace 7 | (set! *unchecked-math* :warn-on-boxed) 8 | 9 | (def ^:private ^{:tag 'double} ORIG-SR 44100.0) 10 | (def ^:private ^{:tag 'double} ALLPASS-FEEDBACK 0.5) 11 | (def ^:private ^{:tag 'long} DEFAULT-STEREO-SPREAD 23) 12 | (def ^:private ^{:tag 'double} FIXED-GAIN 0.015) 13 | (def ^:private COMB-TUNING 14 | [1116, 1188, 1277, 1356, 1422, 1491, 1557, 1617]) 15 | (def ^:private ALLPASS-TUNING 16 | [556, 441, 341, 225]) 17 | 18 | (defn- adjust-tuning 19 | "Returns adjusted tuning values as originals were 20 | defined in terms of sr=44100." 21 | ^long [^long tuning] 22 | (long (/ (* tuning (double *sr*)) ORIG-SR ))) 23 | 24 | (defn- frvb-comb 25 | ^IFn$DD [^long del-time ^double feedback ^double damp] 26 | (let [^doubles buffer (double-array del-time) 27 | ^doubles last-filt (double-array 1) 28 | ^longs indx (long-array 1 0) 29 | damp2 (- 1.0 damp)] 30 | (fn ^double [^double input] 31 | (let [i (aget indx 0) 32 | output (aget buffer i) 33 | new-i (rem (inc i) del-time) 34 | filt-store (+ (* output damp2) (* (aget last-filt 0) damp))] 35 | (aset buffer i (+ input (* filt-store feedback))) 36 | (aset last-filt 0 filt-store) 37 | (aset indx 0 new-i) 38 | output)))) 39 | 40 | (defn- frvb-allpass 41 | ^IFn$DD [^long del-time ^double feedback] 42 | (let [^doubles buffer (double-array del-time) 43 | ^longs indx (long-array 1 0)] 44 | (fn ^double [^double input] 45 | (let [i (aget indx 0) 46 | bufout (aget buffer i) 47 | new-i (rem (inc i) del-time) 48 | output (- bufout input)] 49 | (aset buffer i (+ input (* bufout feedback))) 50 | (aset indx 0 new-i) 51 | output)))) 52 | 53 | (defn- par 54 | ^double [^"[Lclojure.lang.IFn$DD;" ifns ^long fns-len ^double input] 55 | (loop [i 0 v 0.0] 56 | (if (< i fns-len) 57 | (recur (unchecked-inc i) 58 | (+ v (.invokePrim ^IFn$DD (aget ifns i) input))) 59 | v))) 60 | 61 | (defn- ser 62 | ^double [^"[Lclojure.lang.IFn$DD;" ifns ^long fns-len ^double input] 63 | (loop [i 0 v input] 64 | (if (< i fns-len) 65 | (recur (unchecked-inc i) 66 | (.invokePrim ^IFn$DD (aget ifns i) v)) 67 | v))) 68 | 69 | (defn freeverbm "Freeverb (mono) for single channel audio function." 70 | [afn ^double room ^double damp ^long spread] 71 | (let [^doubles out (create-buffer) 72 | ^"[Lclojure.lang.IFn$DD;" 73 | combs (into-array 74 | IFn$DD 75 | (map (fn [^long tuning] 76 | (frvb-comb (adjust-tuning (+ spread tuning)) 77 | room damp)) 78 | COMB-TUNING)) 79 | ^"[Lclojure.lang.IFn$DD;" 80 | allpasses (into-array 81 | IFn$DD 82 | (map (fn [^long tuning] 83 | (frvb-allpass (adjust-tuning (+ spread tuning)) 84 | ALLPASS-FEEDBACK)) 85 | ALLPASS-TUNING)) 86 | combs-len (alength combs) 87 | allpasses-len (alength allpasses)] 88 | (generator 89 | [] [input afn] 90 | (let [comb-val (par combs combs-len input) 91 | out-val (ser allpasses allpasses-len comb-val)] 92 | (aset out int-indx out-val) 93 | (gen-recur)) 94 | (yield out)))) 95 | 96 | ;; todo - add wet/dry balance (maybe? not sure if it's better to just let 97 | ;; user adjust with mul before passing into freeverb. that would allow different 98 | ;; balances per input. if wet/dry added later, can add another arity to function 99 | ;; with last arg defaulting to 1.0 for wet signal 100 | (defn freeverb 101 | "Freeverb (stereo) for two-channel audio function. Based on Faust implementation. 102 | 103 | afn - input stereo audio function 104 | room-size - size of room [0,1.0] 105 | hf-damping - high-frequency damping according to frequency [0,1.0] 106 | stereo-spread - adjusts differences of lengths of delay lines [0,1.0] 107 | 108 | For more information, see: 109 | 110 | https://ccrma.stanford.edu/~jos/pasp/Freeverb.html" 111 | ([afn ^double room-size ^double hf-damping] 112 | (freeverb afn room-size hf-damping 0.5)) 113 | ([afn ^double room-size ^double hf-damping 114 | ^double stereo-spread] 115 | (with-signals [[left right] afn] 116 | (let [out ^"[[D" (create-buffers 2) 117 | combined (shared (mul FIXED-GAIN (sum left right))) 118 | scaledamp 0.4 119 | scaleroom 0.28 120 | offsetroom 0.7 121 | sr-mult (/ ORIG-SR (double *sr*)) 122 | damp (* hf-damping scaledamp) 123 | room (+ (* room-size scaleroom) offsetroom) 124 | freeverbL (freeverbm combined room damp 0) 125 | freeverbR (freeverbm combined room damp 126 | (* 46.0 stereo-spread 127 | sr-mult))] 128 | (fn [] 129 | (let [a (freeverbL) 130 | b (freeverbR)] 131 | (when (and a b) 132 | (aset out 0 a) 133 | (aset out 1 b)) 134 | out)))))) 135 | 136 | -------------------------------------------------------------------------------- /src/test/pink/util_test.clj: -------------------------------------------------------------------------------- 1 | (ns pink.util-test 2 | (:require [pink.util :refer :all] 3 | [pink.config :refer :all]) 4 | (:require [clojure.test :refer :all])) 5 | 6 | 7 | (deftest set-get-d 8 | (let [a (create-buffer 22.0)] 9 | (is (= (aget ^doubles a 0) 22.0)) 10 | (is (= (getd a) 22.0)))) 11 | 12 | (deftest test-shared 13 | (let [a (atom 0) 14 | tfn (shared (fn [] (swap! a inc)))] 15 | (binding [*current-buffer-num* 0] 16 | (is (= 1 (tfn))) 17 | (is (= 1 (tfn))) 18 | (is (= 1 (tfn)))) 19 | (binding [*current-buffer-num* 1] 20 | (is (= 2 (tfn))) 21 | (is (= 2 (tfn))) 22 | (is (= 2 (tfn)))) 23 | )) 24 | 25 | 26 | (deftest test-reader 27 | (let [a (atom 1) 28 | rdr (reader a)] 29 | (is (= 1.0 (aget ^doubles (rdr) 0))) 30 | (reset! a 3.25) 31 | (is (= 3.25 (aget ^doubles (rdr) 0))) 32 | )) 33 | 34 | (deftest test-with-buffer-size 35 | (testing "with-buffer-size runs sub-code 4 times" 36 | (let [counter (atom 0) 37 | afn (with-buffer-size 16 38 | (fn [] 39 | (swap! counter inc) 40 | (double-array *buffer-size*)))] 41 | (afn) 42 | (is (= 4 @counter)))) 43 | 44 | 45 | (testing "with-buffer-size runs sub-code 8 times with shared afn" 46 | (let [counter (atom 0) 47 | afn (with-buffer-size 16 48 | (shared 49 | (fn [] 50 | (swap! counter inc) 51 | (double-array *buffer-size*))))] 52 | (afn) 53 | (afn) 54 | (is (= 8 @counter)))) 55 | 56 | (testing "with-buffer-size returns nil if afn returns nil in first buffer" 57 | (let [counter (atom 0) 58 | afn (with-buffer-size 16 59 | (fn [] 60 | (swap! counter inc) 61 | nil)) 62 | out (afn)] 63 | 64 | (is (= 1 @counter)) 65 | (is (nil? out)) 66 | )) 67 | 68 | (testing "with-buffer-size returns partial buffer when nil is not first buffer, 69 | then returns nil" 70 | (let [counter (atom 0) 71 | afn (with-buffer-size 16 72 | (fn [] 73 | (swap! counter inc) 74 | (if (>= @counter 3) 75 | nil 76 | (double-array *buffer-size* 80)))) 77 | out ^doubles (afn) 78 | out2 (afn)] 79 | 80 | (is (= 3 @counter)) ;; tests short circuits after first nil found 81 | (is (= 64 (alength out))) 82 | (is (= 80.0 (aget out 31))) 83 | (is (= 0.0 (aget out 32))) 84 | (is (nil? out2)) 85 | )) 86 | 87 | (testing "with-buffer-size throws exception with invalid buffer-size" 88 | (let [counter (atom 0)] 89 | (is (thrown-with-msg? Exception #"Invalid buffer-size: 33" 90 | (with-buffer-size 33 91 | (fn [] 92 | (swap! counter inc) 93 | (if (>= @counter 3) 94 | nil 95 | (double-array *buffer-size* 80)))))) 96 | ))) 97 | 98 | (defn done-reader 99 | [] 100 | (let [^booleans done-val *done*] 101 | (fn [] 102 | (aget done-val 0)))) 103 | 104 | (deftest test-with-duration 105 | (let [a (with-duration 1.0 106 | (done-reader))] 107 | (is (= false (a))) 108 | (doseq [x (range (long (/ *sr* *buffer-size*)))] 109 | (a)) 110 | 111 | (is (= true (a))) 112 | )) 113 | 114 | 115 | (deftest test-max-allocator 116 | (let [a (create-max-allocator 3)] 117 | (is (= 0 (num-allocs a))) 118 | (doseq [_ (range 3)] 119 | (is (= true (acquire-alloc! a)))) 120 | (is (= false (acquire-alloc! a))) 121 | (is (= 3 (num-allocs a)))) 122 | (let [a (create-max-allocator 3)] 123 | (doseq [_ (range 3)] 124 | (is (= true (acquire-alloc! a))) 125 | (let [temp-afn (with-allocator a (fn [] nil))] 126 | (is (= 1 (num-allocs a))) 127 | (temp-afn) 128 | (is (= 0 (num-allocs a))))) 129 | (let [v (acquire-alloc! a) 130 | temp-afn (with-allocator a (fn [] (double-array 64)))] 131 | (is (= true v)) 132 | 133 | (is (= 1 (num-allocs a))) 134 | (temp-afn) 135 | (is (= 1 (num-allocs a))) 136 | ))) 137 | 138 | (deftest test-limit1 139 | (is (= 0.0 (limit1 -1.0 0.0 1.0))) 140 | (is (= 1.0 (limit1 2.0 0.0 1.0))) 141 | (is (= 0.5 (limit1 0.5 0.0 1.0)))) 142 | 143 | (deftest test-limit 144 | (let [afn #(into-array Double/TYPE 145 | (take *buffer-size* (cycle [-1.0 0.0 0.25 0.75 1.0 2.0]))) 146 | lmt (limit afn 0.0 1.0) 147 | ^doubles sig (lmt)] 148 | (is (= 0.0 (aget sig 0))) 149 | (is (= 0.0 (aget sig 1))) 150 | (is (= 0.25 (aget sig 2))) 151 | (is (= 0.75 (aget sig 3))) 152 | (is (= 1.0 (aget sig 4))) 153 | (is (= 1.0 (aget sig 5))) 154 | ) 155 | ) 156 | 157 | 158 | (deftest sum-test 159 | (let [test-fn (fn [] 4)] 160 | (is (zero? (sum))) 161 | (is (zero? (sum 0))) 162 | (is (zero? (sum 0 1 -1))) 163 | (is (= test-fn (sum 0 test-fn))) 164 | (is (= test-fn (sum 1 -1 test-fn))) 165 | (is (= test-fn (sum 2.0 -2 test-fn))) 166 | (is (= 4.0 (sum 1.0 3))) 167 | )) 168 | 169 | (deftest mul-test 170 | (let [test-fn (fn [] 4)] 171 | (is (zero? (mul))) 172 | (is (zero? (mul 0))) 173 | (is (zero? (mul 0 test-fn))) 174 | (is (= test-fn (mul 1 test-fn))) 175 | (is (= test-fn (mul 1.0 1 test-fn))) 176 | (is (= 3.0 (mul 1.0 3.0))) 177 | )) 178 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_effects.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-effects 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.space :refer [pan]] 5 | [pink.oscillators :refer :all] 6 | [pink.effects.chorus :refer [chorus]] 7 | [pink.effects.ringmod :refer [ringmod]] 8 | [pink.effects.reverb :refer [freeverb]] 9 | [pink.envelopes :refer [env xar adsr]] 10 | [pink.util :refer [mul sum let-s with-duration]] 11 | [pink.node :refer :all] 12 | [pink.filters :refer :all] 13 | [pink.delays :refer [adelay]] 14 | )) 15 | 16 | (defn instr-saw 17 | [amp freq loc] 18 | (let-s [e (xar 0.01 1.0)] 19 | (pan 20 | (mul e 21 | (lpf18 (sum 22 | (blit-saw freq) 23 | (blit-saw (sum 0.873 freq)) 24 | (blit-saw (sum -0.95117 freq))) 25 | (sum 4000 (mul e 2000)) 26 | 0.6 0.1) 27 | ;(butterlp (blit-saw freq) 28 | ; (sum 100 (mul e 400))) 29 | 30 | ) 31 | loc))) 32 | 33 | (defn instr-square 34 | [amp freq loc] 35 | (let-s [e (xar 0.01 1.0)] 36 | (pan 37 | (mul e amp 38 | (butterlp (blit-square freq) 39 | (sum 100 (mul e 400)))) 40 | loc))) 41 | 42 | (defn instr-triangle 43 | [amp freq loc] 44 | (let-s [e (if (fn? amp) 45 | amp 46 | (mul amp (env [0.0 0.0 0.1 1.0 3.0 1.0 0.1 0.0])))] 47 | (-> 48 | (blit-triangle freq) 49 | ;(butterlp (sum 100 (mul e 400))) 50 | (mul e) 51 | (pan loc)))) 52 | 53 | (defn vox-humana 54 | [amp ^double freq ^double loc] 55 | (let [pulse-freq (mul freq (sum 1.0004 (lfo 0.013 3.5 :triangle))) 56 | pulse-width (sum 0.625 (lfo 0.125 5.72 :triangle)) 57 | saw-freq (mul freq (sum 1 (lfo 0.021 5.04 :triangle))) 58 | key-follow (+ 1 (Math/exp (/ (- freq 50.0) 10000.0))) ] 59 | (let-s [e (if (fn? amp) 60 | amp 61 | (mul amp (env [0.0 0.0 0.1 1.0 3.0 1.0 0.1 0.0])))] 62 | (-> 63 | (sum (blit-saw saw-freq) 64 | (blit-pulse pulse-freq pulse-width)) 65 | 66 | (butterlp (* key-follow 1986)) 67 | (mul e 0.5) 68 | (pan loc))))) 69 | 70 | 71 | (defn sawz 72 | [^double dur freq freq2 amp] 73 | (with-duration dur 74 | (-> 75 | (sum (blit-saw freq) 76 | (blit-saw freq2)) 77 | (moogladder 2000 0.3) 78 | (mul (adsr 0.01 0.01 0.9 0.3) amp) 79 | (pan 0.0) 80 | ))) 81 | 82 | ;(def a (instr-saw 0.1 440 0.0)) 83 | ;(def b (blit-saw 440)) 84 | ;(require '[no.disassemble :refer :all]) 85 | ;(println (disassemble b)) 86 | ;(require '[clojure.pprint :refer [pprint]]) 87 | ;(pprint (a)) 88 | 89 | (comment 90 | 91 | (start-engine) 92 | 93 | (def root-node (audio-node :channels 2)) 94 | (add-afunc (chorus root-node 0.8)) 95 | 96 | (def reverb-node (audio-node :channels 2)) 97 | (add-afunc (freeverb reverb-node 0.50 0.1 0.1)) 98 | 99 | ;; chorus 100 | (node-add-func 101 | root-node 102 | (with-duration 4.0 103 | (-> 104 | (sum (blit-saw 200) 105 | (blit-saw 300)) 106 | (moogladder 600 0.2) 107 | (mul (adsr 0.4 0.1 0.9 2.0) 0.5) 108 | (pan 0.05) 109 | ))) 110 | 111 | ;; circuit modeled ringmod 112 | (add-afunc 113 | (with-duration 4.0 114 | (-> 115 | (sum (blit-saw 200) 116 | (blit-saw 300)) 117 | (ringmod (sine 400) 1.1) 118 | (moogladder 1200 0.2) 119 | (mul (adsr 0.4 0.1 0.9 2.0) 0.5) 120 | (pan 0.05) 121 | ))) 122 | 123 | ;; digital ringmod using mul 124 | (add-afunc 125 | (with-duration 4.0 126 | (-> 127 | (sum (blit-saw 200) 128 | (blit-saw 300)) 129 | (mul (sine 400)) 130 | (moogladder 1200 0.2) 131 | (mul (adsr 0.4 0.1 0.9 2.0) 0.5) 132 | (pan 0.05) 133 | ))) 134 | 135 | ;; freeverb 136 | 137 | (node-add-func 138 | reverb-node 139 | (instr-saw 1.0 600 0.2)) 140 | 141 | (node-add-func 142 | reverb-node 143 | (sawz 2.0 700 1200 0.2)) 144 | 145 | (node-add-func 146 | reverb-node 147 | (sawz 2.0 100 150 0.2)) 148 | 149 | (node-add-func 150 | reverb-node 151 | (sawz 1.0 60 90 0.251)) 152 | 153 | (add-afunc 154 | (sawz 2.0 100 150 0.2)) 155 | 156 | ;; 157 | (add-afunc 158 | (with-duration 8.0 159 | (vox-humana (mul 0.5 (adsr 0.453 0.0 1.0 2.242)) 440 0.0))) 160 | 161 | (node-add-func 162 | root-node 163 | (with-duration 8.0 164 | (vox-humana (mul 0.5 (adsr 0.453 0.0 1.0 2.242)) 440 0.0))) 165 | 166 | (add-afunc 167 | (with-duration 8.0 168 | (vox-humana (mul 0.5 (adsr 0.453 0.0 1.0 2.242)) 880 0.0))) 169 | 170 | (node-add-func 171 | root-node 172 | (with-duration 8.0 173 | (vox-humana (mul 0.5 (adsr 0.453 0.0 1.0 2.242)) 880 0.0))) 174 | 175 | (node-add-func 176 | root-node 177 | (with-duration 8.0 178 | (vox-humana (mul 0.5 (adsr 0.453 0.0 1.0 2.242)) 1320 0.0))) 179 | 180 | (def my-score3 181 | (let [num-notes 10] 182 | (node-events root-node 183 | (map #(event instr-triangle (* % 0.5) 184 | (/ 0.75 (+ 1 %)) 185 | (* 65 (+ 1 %)) 186 | (- (* 2 (/ % (- num-notes 1))) 1)) 187 | (range num-notes))))) 188 | 189 | 190 | 191 | (add-events my-score3) 192 | 193 | (stop-engine) 194 | 195 | 196 | ) 197 | 198 | -------------------------------------------------------------------------------- /doc/architecture.md: -------------------------------------------------------------------------------- 1 | # Architecture 2 | 3 | The design of Pink is motivated by the concept of being a Minimal Engine. It is the goal in Pink's design to have a limited set of primitive abstractions that allow for supporting the widest variety of musical use cases. 4 | 5 | ## Processing Model 6 | 7 | Pink uses a block-based processing model (rather than a single-sample model). It will process x number of samples at a time, where x is configured by the user using the :buffer-size option when creating an engine. The default setting for engines is a buffer-size of 64 samples and 44100 sampling rate. 8 | 9 | Single-sample processing models allow for the highest temporal resolution for processing of events and control functions. However, they also have a higher processing cost. Using block-based processing allows for amortizing costs for each signal-processing unit generator, as they will generate x number of samples in a loop, using local variables for the duration of that loop, and do a store/restore of state only once per block. However, events will only be processed after every block, so timing may skew, and since some signal processing graphs require single-sample delays, special handling is required. 10 | 11 | Pink follows similar tradeoffs as found in Csound. The user can work with one block size while rendering in realtime, but choose to use a smaller block-size (i.e. block-size = 1) for better event resolution when rendering to disk. Also, like Csound, parts of a signal processing graph can be set to process with smaller block-sizes. For example, a portion of a graph can be run at block-size = 1, while the rest of the engine may run at block-size = 64. 12 | 13 | ### Time 14 | 15 | Pink's time counter begins at 0 and is incremented once per processing of its signal-processing graph. Time then is counted in number of blocks run since start. As the user has access to the current block-size and sample-rate, the user can make calculations to figure out how much time has passed in clock time (i.e. number of seconds = (/ (\* time-counter block-size) sample-rate) ). Pink also has a system for tempo, allowing the user to set event start and duration times in numbers of beats, rather than in seconds. By default, the tempo for the engine is set to 60 beats per minute, such that time values for events is processed as seconds. 16 | 17 | ### Synchronization 18 | 19 | For music systems, synchronization with an engine is an important concern. This allows for events to be timed together with the sound that is being produced, as well as allow control functions to operate together with the time of the engine. To achieve this, event and control processing must be done in the thread of the engine. Pink offers three main constructs (audio functions, control functions, and events) that are all run within the main engine thread. 20 | 21 | Pink allows for two constructs for synchronization: events and control-functions. Events are one time operations that are scheduled with the engine and will be fired when their start times are met. Control-functions are continuous operations that will run until they return a false value. Event processing and control-function calling is done once per rendering of the audio graph. Events and control-functions have access to the engine's current time counter and are processed in sync with the audio-graph. 22 | 23 | ## Main Thread 24 | 25 | 26 | 27 | Pink uses a single-threaded design. The main thread in Pink is responsible for running the engine. Each time through the loop, the engine has three main tasks: running any events that are scheduled to run at the current engine time, processing the control function graphs, and processing the audio function graph. When processing the audio graph, the engine is responsible for taking the returned audio samples and writing that to the soundcard or to disk. 28 | 29 | Additionally, the engine may respond to two messages, one for clearing the engine and one for stopping the engine. 30 | 31 | ## High-Level Abstractions 32 | 33 | ### Audio Functions 34 | 35 | Audio functions are functions that are called once per engine cycle and either generate audio buffers or, if complete, return nil. These are the primary functions used to generate audio, and are generally assembled into sub-graphs that are attached to the overall audio processing graph for the engine. Users will use audio functions to create things like instruments, mixers, and effects. Some audio functions will be infinite in duration while others are finite. Audio functions often depend on other audio functions; if a dependent audio function is done (returns nil), then the current audio function must also return nil. 36 | 37 | ### Control Functions 38 | 39 | Control functions are functions that are called once per engine cycle and either return true or false, depending on if they are still running or are done. Control functions are generally used for side-effects. Some example uses include sample-accurate clocks for manually triggering events, modeling performers, and as a callback mechanism for application code. 40 | 41 | The pink.processes namespace includes a special process macro for writing processes that are compiled into Pink control functions. Pink processes allow for writing code that uses waits to pause time and follows a simliar model to Common Music's [processes](http://commonmusic.sourceforge.net/cm/res/doc/cm.html#processes) and Chuck's [Shreds](http://chuck.cs.princeton.edu/doc/language/spork.html). (Using Pink's facilities for adding control functions to the engine is functionally equivalent's to CM's sprout and Chuck's spork operations.) More information on processes is available [here](processes.md). 42 | 43 | ### Events 44 | 45 | Events are timed function calls. Events are most often used to represent notes (i.e. play this instrument at time x), but events are generic in Pink. Any function can be called by a Pink event. For example, an event can be used to turn off the engine at a given time. Events can schedule new events, as is commonly done in temporal recursion. Pink events are higher-order, meaning arguments to the event may in themselves be functions. 46 | 47 | -------------------------------------------------------------------------------- /src/main/pink/processes.clj: -------------------------------------------------------------------------------- 1 | (ns pink.processes 2 | "Write process code that works as control functions." 3 | (:require 4 | [clojure.core.async.impl.ioc-macros :as ioc] 5 | [pink.config :refer :all] 6 | )) 7 | 8 | ;; Ensure unchecked math used for this namespace 9 | (set! *unchecked-math* :warn-on-boxed) 10 | 11 | ;; EXPERIMENTAL CODE 12 | 13 | ;; (defonce PinkProcessList) 14 | ;; (defn list-pink-processes []) 15 | ;; (kill-all-pink-processes []) 16 | 17 | (defprotocol IPinkProcess 18 | (paused? [this]) 19 | (active? [this]) 20 | (toggle-pause [this]) 21 | (kill [this])) 22 | 23 | (deftype PinkProcess [^:volatile-mutable paused 24 | ^:volatile-mutable active 25 | proc-fn] 26 | IPinkProcess 27 | (paused? [this] paused) 28 | (active? [this] active) 29 | (toggle-pause [this ] (set! paused (not paused))) 30 | (kill [this] 31 | (set! active false) :dead) 32 | clojure.lang.IFn ;; used to conform to Pink's Control Function convention 33 | (invoke [this] 34 | (cond 35 | (not active) false 36 | paused true 37 | :default (proc-fn) 38 | ))) 39 | 40 | (defn create-pink-process 41 | [proc-fn] 42 | (PinkProcess. false true proc-fn)) 43 | 44 | ;; SIGNALS 45 | 46 | (defprotocol PinkSignal 47 | (signal-done? [this])) 48 | 49 | (defprotocol ICue 50 | (has-cued? [this]) 51 | (signal-cue [this])) 52 | 53 | (deftype Cue [^:volatile-mutable sig] 54 | ICue 55 | (has-cued? [this] sig) 56 | (signal-cue [this] (set! sig true)) 57 | PinkSignal 58 | (signal-done? [this] (has-cued? this))) 59 | 60 | (defn cue 61 | "Create a cue signal that satisfies ICue and PinkSignal protocols. 62 | Useful for one-to-many signalling." 63 | [] 64 | (Cue. false)) 65 | 66 | (defprotocol ICountdownLatch 67 | (count-down [this]) 68 | (latch-done? [this])) 69 | 70 | (deftype CountdownLatch [^:volatile-mutable ^long num-wait] 71 | ICountdownLatch 72 | (count-down [this] (set! num-wait (dec num-wait))) 73 | (latch-done? [this] (= 0 num-wait)) 74 | PinkSignal 75 | (signal-done? [this] (latch-done? this))) 76 | 77 | (defn countdown-latch 78 | "Create a countdown-latch that satisfies ICountdownLatch and 79 | PinkSignal protcols. Useful for coordinating and waiting for 80 | multiple processes to signal." 81 | [^long num-wait] 82 | (CountdownLatch. num-wait) ) 83 | 84 | ;; PROCESS MACHINERY 85 | 86 | (def ^:const WAIT-IDX 6) 87 | 88 | (defn pink-wait [c] c) 89 | 90 | ;; Surrounding my-wait with a loop will induce core.async's 91 | ;; state-machine macros to add a new block for just the call 92 | ;; to my-wait. When the state-machine returns, it will 93 | ;; operate just the wait code, rather than all of the code 94 | ;; prior to the wait terminator. 95 | (defmacro wait 96 | "Wait upon a given time, PinkSignal, or predicate. Must be used 97 | within a Pink process." 98 | [c] 99 | `(loop [] 100 | (pink.processes/pink-wait ~c))) 101 | 102 | (defn process-wait [state blk wait-val] 103 | (cond 104 | (number? wait-val) 105 | (let [cur-wait (long (ioc/aget-object state WAIT-IDX)) 106 | ksmps (long *buffer-size*) 107 | next-buf (+ cur-wait ksmps) 108 | wait-time (long 109 | (Math/round 110 | (+ 0.499999 (* (double *sr*) (double wait-val)))))] 111 | ;(println next-buf " : " wait-time) 112 | (if (> next-buf wait-time) 113 | (do 114 | (ioc/aset-all! state 115 | WAIT-IDX (rem next-buf wait-time) 116 | ioc/STATE-IDX blk) 117 | :recur) 118 | (do 119 | (ioc/aset-all! state WAIT-IDX next-buf) 120 | true))) 121 | (satisfies? PinkSignal wait-val) 122 | (if (signal-done? wait-val) 123 | (do 124 | (ioc/aset-all! state WAIT-IDX 0 125 | ioc/STATE-IDX blk) 126 | :recur) 127 | true) ;; pass through 128 | (fn? wait-val) 129 | (let [v (wait-val)] 130 | (if v ;; function signals ready to move on 131 | (do 132 | (ioc/aset-all! state WAIT-IDX 0 133 | ioc/STATE-IDX blk) 134 | :recur) 135 | true ;; pass through 136 | )) 137 | :default 138 | (throw (Exception. (str "Illegal argument: " wait-val))))) 139 | 140 | (defn process-done [state wait-val] 141 | false) 142 | 143 | (defmacro process 144 | "Create a state-machine-based Pink control function." 145 | [& body] 146 | (let [crossing-env (zipmap (keys &env) (repeatedly gensym)) 147 | terminators {`pink-wait `process-wait 148 | `counter `process-counter 149 | :Return `process-done}] 150 | `(let [captured-bindings# (clojure.lang.Var/getThreadBindingFrame) 151 | 152 | ~@(mapcat (fn [[l sym]] [sym `(^:once fn* [] ~(vary-meta l dissoc :tag))]) crossing-env) 153 | state# (~(ioc/state-machine `(do ~@body) 1 154 | [crossing-env &env] 155 | terminators))] 156 | ;; TODO - consider replacing WAIT-IDX to use a long-array to save on object allocations 157 | (ioc/aset-all! state# 158 | WAIT-IDX 0 159 | ;~ioc/BINDINGS-IDX (clojure.lang.Var/getThreadBindingFrame) 160 | ) 161 | (fn [] 162 | (ioc/aset-all! state# ~ioc/BINDINGS-IDX 163 | captured-bindings#) 164 | (ioc/run-state-machine state#))))) 165 | 166 | 167 | 168 | (comment 169 | 170 | (def p 171 | (process 172 | (loop [a 0] 173 | (when (< a 5) 174 | (wait 0.1) 175 | (println "test!") 176 | (recur (inc a)))))) 177 | 178 | (require '[clojure.pprint :refer [pprint]]) 179 | (pprint (macroexpand 180 | '(process 181 | (loop [a 0] 182 | (when (< a 5) 183 | (wait 3) 184 | (println "test!") 185 | (recur (inc a))))) 186 | 187 | )) 188 | 189 | (loop [c 0] 190 | (let [v (p)] 191 | (println c " : " v) 192 | (when v 193 | (recur (inc c))))) 194 | ) 195 | -------------------------------------------------------------------------------- /doc/events.md: -------------------------------------------------------------------------------- 1 | # Events 2 | 3 | ## Introduction 4 | 5 | In Pink, events are considered timed applications of functions. An event is fired by calling a given function at a given time with given arguments. The event function in pink.events has the following arguments: 6 | 7 | ```clojure 8 | f start & args 9 | ``` 10 | 11 | For example, the following: 12 | 13 | ```clojure 14 | (event horn 0.0 0.4 440.0) 15 | ``` 16 | 17 | would create an event that calls horn at time 0.0 with arguments 0.4 and 440.0. However, the event processor in Pink is designed only to apply the function, and has no knowledge of what the function does, and does not in and of itself do anything with the results of applying the function. (This may change to check for return values as success/failure; this part of the design is not yet resolved.) 18 | 19 | ## Event Processing 20 | 21 | Because the event processor does not concern itself with what the function does, the general responsibility of the action's meaning is inverted from other systems. For example, in a MIDI processor, the processor would look at incoming data and decide based on the initial byte whether to start a new note, or modify some internal state. As a result, there is a fixed set of possible event actions. To expand the kinds of events, one has to modify what kinds of messages the MIDI processor is able to understand, as well as change what information is in the event message. 22 | 23 | Instead, Pink events rely on the message creator to determine what the action will be. The event processor is only concerned with applying a function at a given time and nothing more. For example, given a MIDI note on message with note number 64 and velocity 127, the MIDI processor might read the message, determine that the channel maps to synthesizer-a, create a new instance of synthesizer-a, then add it to the engine's list of active audio-functions. 24 | 25 | In Pink, the responsibility is reversed. Instead of creating a message that maps to an action, the user embeds the action into the event itself. To achieve the previous example, a Pink event would have an f arg of engine-add-afunc. The args to the event would be what would be necessary to create an instance of synthesizer-a. When the event is processed, the processor would fire the engine-add-afunc function, using the synthesizer-a instance that is created from the arguments given. 26 | 27 | Because the user engine user is in control of what happens at the given time, the core engine code can remain very small and simple, while at the same time being extremely expressive. Pink provides the very basic mechanisms of events as well as convenience functions for commonly used actions. However, the user is not limited to any pre-determined notion of what can be done by an event, and is free to customize their events as they wish. 28 | 29 | ## Higher Order Events 30 | 31 | Events in Pink are higher order events, meaning that event arguments may themselves be functions. This capability at the event-level provides the same benefits as passing functions to functions does in higher-order functions. On a musical level, this allows for more flexible designs of audio-functions as well as greater reuse. 32 | 33 | For example, a violin is a string instrument. It is often used by bowing it with a violin bow. Performers can vary the speed and pressure of a bow while performing. Performers may also use other techniques, such as plucking the string, hitting the string with the back of the bow, and so on. In all of these cases, the instrument itself has not changed, but rather the input into the instrument. 34 | 35 | In Pink, because an event is able to take in other functions, one can design an audio-function to take in arguments and pull values during the processing of the audio-function. For example, rather than pass in a value for pitch, such as a frequency of 440 hz, one can pass in an audio function that will give time-varying values. This allows for an audio-function acting as an instrument to be re-used to perform any variety of ways the user likes. It also allows for the user to build up a library of audio-functions specifically for control and reuse them between instruments. 36 | 37 | ### Special Event Notation 38 | 39 | One problem that occurs with higher-order events is if a set of events was fixed and a user wanted to replay that set of events, the function instances that were used as arguments in the event may have already been used. For example: 40 | 41 | ```clojure 42 | (event horn 0.0 0.5 (env [0.0 440 0.5 880])) 43 | ``` 44 | 45 | In this event, and env unit-generator is used to vary the pitch from 440Hz to 880hz over a 0.5 second period. On the first time an event was called, that env instance would be already created when horn was called. Everything would render fine that first time, but if the event was reused, the env instance would have been in a state where it had already rendered for 0.5 seconds. 46 | 47 | To mitigate this scenario, Pink uses a special apply!\*! operator. If any IDeref values are given as arguments, Pink will first deref the value before applying the function. For example, if pitch was an atom that held the value 440, the following: 48 | 49 | ```clojure 50 | (event horn 0.0 0.5 @pitch) 51 | ``` 52 | 53 | Would always render a horn with pitch 440, even if the user reset! pitch to another value. With Pink's events, if you pass in just the IDeref: 54 | 55 | ```clojure 56 | (event horn 0.0 0.5 pitch) 57 | ``` 58 | 59 | The value of pitch will be derefed before applying horn each time that event is run. To solve the problem about the horn above, you can use the !\*! function which will wrap the given code in an IDeref. So the following: 60 | 61 | ```clojure 62 | (event horn 0.0 0.5 (!\*! env [0.0 440 0.5 880])) 63 | ``` 64 | 65 | Will always call (env [0.0 440 0.5 880]) and call the horn function with that each time that event is fired. 66 | 67 | 68 | As a consequence of using apply!\*!, if you want to pass in an atom and want that atom itself to be passed in to the event function, you can use the !r! operator to wrap your atom. (!r! reads as a "reference argument".) For example: 69 | 70 | ```clojure 71 | (def tempo (atom 60.0) 72 | (event perf-func 0.0 0.5 (!r! tempo) 73 | ``` 74 | 75 | In general, if one is using higher-order events, it is likely one will want to use the !\*! function. The use of !r! will most likely come into play when doing temporal recursion with events (where an event performs some action, then schedules another event calling the same function). In that scenario, it is useful to pass in some kind of reference like a tempo atom or done atom, such that while performing one can affect the recursive event stream. 76 | -------------------------------------------------------------------------------- /src/main/pink/instruments/horn.clj: -------------------------------------------------------------------------------- 1 | (ns pink.instruments.horn 2 | "Implementation of Andrew Horner and Lydia Ayer's French Horn models using 3 | banded wavetable synthesis. Based on the Csound code implementaiton." 4 | 5 | (:require [pink.util :refer :all] 6 | [pink.config :refer [*buffer-size* *current-buffer-num* *sr*]] 7 | [pink.envelopes :refer :all] 8 | [pink.gen :refer [gen9 gen17]] 9 | [pink.oscillators :refer :all] 10 | [pink.filters :refer [tone atone]] 11 | [pink.space :refer [pan]] 12 | [pink.dynamics :refer [balance]] 13 | )) 14 | 15 | ;; Ensure unchecked math used for this namespace 16 | (set! *unchecked-math* :warn-on-boxed) 17 | 18 | (def ^:const ^:private ^{:tag 'long} 19 | hwt-size 4096) 20 | (def ^:const ^:private ^{:tag 'long} 21 | horn-cutoff 2560) 22 | 23 | ;; TABLES 24 | 25 | 26 | ;(def horn-cutoff [40 40 80 160 320 640 1280 2560 5120 10240 10240]) 27 | 28 | ;;format: note-freq-max adjustment table0 [table1 table2] 29 | (def horn-wave-tables 30 | [ 31 | [85 32 | 52.476 33 | sine-table 34 | (gen9 hwt-size [2 6.236] [3 12.827]) 35 | (gen9 hwt-size [4 21.591] [5 11.401] [6 3.570] [7 2.833]) 36 | (gen9 hwt-size [8 3.070] [9 1.053] [10 0.773] [11 1.349] [12 0.819] 37 | [13 0.369] [14 0.362] [15 0.165] [16 0.124] [18 0.026] [19 0.042])] 38 | 39 | [114 40 | 18.006 41 | sine-table 42 | (gen9 hwt-size [2 3.236] [3 6.827]) 43 | (gen9 hwt-size [4 5.591] [5 2.401] [6 1.870] [7 0.733]) 44 | (gen9 hwt-size [8 0.970] [9 0.553] [10 0.373] [11 0.549] [12 0.319] 45 | [13 0.119] [14 0.092] [15 0.045] [16 0.034])] 46 | 47 | [153 48 | 11.274 49 | sine-table 50 | (gen9 hwt-size [2 5.019] [3 4.281]) 51 | (gen9 hwt-size [4 2.091] [5 1.001] [6 0.670] [7 0.233]) 52 | (gen9 hwt-size [8 0.200] [9 0.103] [10 0.073] [11 0.089] [12 0.059] 53 | [13 0.029])] 54 | 55 | [204 56 | 6.955 57 | sine-table 58 | (gen9 hwt-size [2 4.712] [3 1.847]) 59 | (gen9 hwt-size [4 0.591] [5 0.401] [6 0.270] [7 0.113]) 60 | (gen9 hwt-size [8 0.060] [9 0.053] [10 0.023])] 61 | 62 | [272 63 | 2.260 64 | sine-table 65 | (gen9 hwt-size [2 1.512] [3 0.247]) 66 | (gen9 hwt-size [4 0.121] [5 0.101] [6 0.030] [7 0.053]) 67 | (gen9 hwt-size [8 0.030])] 68 | 69 | [364 70 | 1.171 71 | sine-table 72 | (gen9 hwt-size [2 0.412] [3 0.087]) 73 | (gen9 hwt-size [4 0.071] [5 0.021])] 74 | 75 | [486 76 | 1.106 77 | sine-table 78 | (gen9 hwt-size [2 0.309] [3 0.067]) 79 | (gen9 hwt-size [4 0.031])] 80 | 81 | [Integer/MAX_VALUE 82 | 1.019 83 | sine-table 84 | (gen9 hwt-size [2 0.161] [3 0.047])] 85 | 86 | ]) 87 | 88 | 89 | ;(def horn-stopped-cutoff [40 40 80 160 320 640 1280 2560 5120 10240 10240]) 90 | 91 | 92 | (def horn-stopped-wave-tables 93 | [ 94 | [272 95 | 3.172 96 | sine-table 97 | (gen9 hwt-size [2 0.961] [3 0.052]) 98 | (gen9 hwt-size [4 0.079] [5 0.137] [6 0.185] [7 0.109]) 99 | (gen9 hwt-size [8 0.226] [9 0.107] [10 0.155] [11 0.140] [12 0.428] 100 | [13 0.180] [15 0.070] [16 0.335] [17 0.183] [18 0.073] [19 0.172] 101 | [20 0.117] [21 0.089] [22 0.193] [23 0.119] [24 0.080] [25 0.36] 102 | [26 0.143] [27 0.036] [28 0.044] [29 0.040] [30 0.052] [31 0.086] 103 | [32 0.067] [33 0.097] [34 0.046] [36 0.030] [37 0.025] [38 0.048] 104 | [39 0.021] [40 0.025])] 105 | 106 | [363 107 | 1.947 108 | sine-table 109 | (gen9 hwt-size [2 0.162] [3 0.068]) 110 | (gen9 hwt-size [4 0.116] [5 0.13] [6 0.050] [7 0.089]) 111 | (gen9 hwt-size [8 0.156] [9 0.381] [10 0.191] [11 0.126] [12 0.162] 112 | [13 0.073] [15 0.157] [16 0.074] [17 0.087] [18 0.151] [19 0.093] 113 | [20 0.031] [21 0.030] [22 0.051] [23 0.058] [24 0.051] [25 0.077] 114 | [26 0.033] [27 0.021] [28 0.039])] 115 | 116 | [484 117 | 2.221 118 | sine-table 119 | (gen9 hwt-size [2 0.164] [3 0.164]) 120 | (gen9 hwt-size [4 0.401] [5 0.141] [6 0.293] [7 0.203]) 121 | (gen9 hwt-size [8 0.170] [9 0.306] [10 0.170] [11 0.103] 122 | [12 0.131] [13 0.134] [14 0.047] [15 0.182] [16 0.049] [17 0.088] 123 | [18 0.088] [19 0.064] [20 0.024] [21 0.064] [22 0.022])] 124 | 125 | [Integer/MAX_VALUE 126 | 2.811 127 | sine-table 128 | (gen9 hwt-size [2 0.193] [3 0.542]) 129 | (gen9 hwt-size [4 0.125] [5 0.958] [6 0.154] [7 0.364]) 130 | (gen9 hwt-size [8 0.444] [9 0.170] [10 0.090] [11 0.077] [12 0.026] 131 | [13 0.073])] 132 | 133 | ]) 134 | 135 | 136 | (defn horn-lookup 137 | "Returns the wavetable set for a given frequency and bank of wavetable sets" 138 | [^double freq tbls] 139 | (loop [[x & xs] tbls] 140 | (if (nil? xs) 141 | (rest x) 142 | (if (< freq ^double (first x)) 143 | (rest x) 144 | (recur xs))))) 145 | 146 | ; audio generator functions 147 | 148 | (defn horn-play 149 | [amp freq wave-tables] 150 | (let [env0 (shared 151 | (if (number? amp) 152 | (let [a (double amp)] 153 | (env [0 0 0.02 a 0.03 (* 0.9 a) 0.5 (* 0.9 a) 0.2 0.0] )) 154 | (arg amp))) 155 | env1 (shared (mul env0 env0)) 156 | env2 (shared (mul env1 env0)) 157 | env3 (shared (mul env2 env0)) 158 | envs [env0 env1 env2 env3] 159 | freqf (shared (arg freq)) 160 | phase 0.5 161 | [adjust & tbls] (horn-lookup freq wave-tables) 162 | tbl-fns (map oscil3 envs (repeat freqf) tbls (repeat phase)) 163 | portamento (sum 1.0 (oscil3 0.02 0.5 sine-table))] 164 | (let-s [asig (div (apply sum tbl-fns) (arg adjust))] 165 | (mul portamento 166 | (balance (tone asig horn-cutoff) asig))) 167 | )) 168 | 169 | (defn horn 170 | "Creates mono horn unless panning given" 171 | ([amp freq] (horn amp freq nil)) 172 | ([amp freq loc] 173 | (if (nil? loc) 174 | (horn-play amp freq horn-wave-tables) 175 | (pan (horn-play amp freq horn-wave-tables) loc)))) 176 | 177 | (defn horn-stopped 178 | "Creates mono stopped horn unless panning given" 179 | ([amp freq] (horn-stopped amp freq nil)) 180 | ([amp freq loc] 181 | (if (nil? loc) 182 | (horn-play amp freq horn-stopped-wave-tables) 183 | (pan (horn-play amp freq horn-stopped-wave-tables) loc)))) 184 | 185 | (defn- horn-straight-mute 186 | [asig] 187 | (let-s [sig asig] 188 | (balance (atone sig 1200) sig)) ) 189 | 190 | (defn horn-muted 191 | "Creates mono muted horn unless panning given" 192 | ([amp freq] (horn-muted amp freq nil)) 193 | ([amp freq loc] 194 | (if (nil? loc) 195 | (horn-straight-mute 196 | (horn-play amp freq horn-wave-tables)) 197 | (pan 198 | (horn-straight-mute 199 | (horn-play amp freq horn-wave-tables)) loc)))) 200 | -------------------------------------------------------------------------------- /src/demo/pink/demo/live_code_study.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.live-code-study 2 | (:require [pink.simple :refer :all] 3 | [pink.live-code :refer :all] 4 | [pink.config :refer :all] 5 | [pink.filters :refer :all] 6 | [pink.envelopes :refer :all] 7 | [pink.util :refer :all] 8 | [pink.node :refer :all] 9 | [pink.oscillators :refer :all] 10 | [pink.space :refer :all] 11 | [pink.event :refer :all] 12 | [pink.noise :refer :all] 13 | [pink.effects.ringmod :refer :all] 14 | [pink.effects.reverb :refer :all] 15 | [pink.io.sound-file :refer :all] 16 | [clojure.string :refer [join]] 17 | )) 18 | 19 | ;; instr 20 | 21 | ;; Download Salamander from https://archive.org/details/SalamanderDrumkit and 22 | ;; place within PINK_RESOURCE_ROOT/samples 23 | (def samples-root 24 | (str (System/getenv "PINK_RESOURCE_ROOT") 25 | "/samples/salamanderDrumkit/OH/")) 26 | 27 | (defn table 28 | [filename] 29 | (load-table (str samples-root filename))) 30 | 31 | (def samples 32 | { 48 (table "kick_OH_F_1.wav") 33 | 49 (table "snare_OH_F_1.wav") 34 | 50 (table "ride2_OH_FF_1.wav") 35 | 51 (table "hihatClosed_OH_F_1.wav") 36 | 37 | 44 (table "hihatClosed_OH_F_1.wav") 38 | 45 (table "hihatClosed_OH_F_1.wav") 39 | 46 (table "hihatClosed_OH_F_1.wav") 40 | 47 (table "cowbell_FF_1.wav") 41 | }) 42 | 43 | 44 | (def bd 48) 45 | (def snare 49) 46 | (def ride 50) 47 | 48 | (defn play-sample-one-shot 49 | ([^long keynum] 50 | (play-sample-one-shot keynum 1.0)) 51 | ([^long keynum ^double amp-adj] 52 | (when-let [sample (samples keynum)] 53 | (let [dur (sample-duration sample)] 54 | (add-afunc 55 | (-> 56 | (sample-one-shot sample) 57 | (mul amp-adj) 58 | (pan 0.0)) 59 | ))))) 60 | 61 | ;; control 62 | 63 | (defn play-samp [samp-num pattern indx amp] 64 | (when (pattern indx) 65 | (play-sample-one-shot samp-num amp))) 66 | 67 | (defn drums [] 68 | (let [n (beat-mod (sub-beat 4) 16) 69 | bd-pat #{0 4 8 12 14} 70 | snare-pat #{2 4 12 15}] 71 | (play-samp bd bd-pat n 2.0) 72 | (play-samp snare snare-pat n 1.0) 73 | ;(play-samp ride (into #{} (range 0 16 2)) n 0.35) 74 | ) 75 | (cause drums (next-beat 1/4))) 76 | 77 | 78 | (def reverb (audio-node :channels 2) ) 79 | (def reverb-fn 80 | (freeverb reverb 0.8 0.25)) 81 | 82 | (add-afunc reverb-fn) 83 | 84 | 85 | (defn synth1 86 | [dur freq] 87 | (with-duration (beats dur) 88 | (let [e (shared (adsr 0.01 0.05 0.25 0.25))] 89 | (-> 90 | (sum (blit-saw freq) 91 | (blit-square (* freq 2)) ) 92 | (zdf-ladder (sum 500 (mul 2000 e)) 20) 93 | (mul e 0.5) 94 | (pan 0.0))))) 95 | 96 | (defn synth2 97 | [dur freq] 98 | (with-duration (beats dur) 99 | (let [e (shared (adsr 0.01 (beats 0.5) 0.001 (beats 0.5)))] 100 | (-> 101 | (sum (blit-saw freq) 102 | (blit-saw (* freq 1.0013)) ) 103 | (zdf-ladder (sum 500 (mul 104 | ;(of-range (/ (beat-mod 16) 16.0) 1000 8000) 105 | 3000 106 | e)) 107 | 4) 108 | (mul e 0.75) 109 | (pan 0.0))))) 110 | 111 | (comment 112 | (add-wet-dry 113 | 0.2 114 | (-> (sum (blit-saw 400) 115 | (mul 0.5 (blit-saw 800) 116 | (blit-saw 800.2317))) 117 | (zdf-ladder (sum 100 (mul 10000 (adsr 0.0 4.0 0 4.0))) 0.8) 118 | (mul 0.8) 119 | (pan 0.0) 120 | )) 121 | ) 122 | 123 | 124 | (defn add-wet-dry 125 | [wet-dry afn] 126 | (let [s (shared afn)] 127 | (add-afunc 128 | (apply-stereo mul s (- 1.0 wet-dry))) 129 | (node-add-func 130 | reverb 131 | (apply-stereo mul s wet-dry)))) 132 | 133 | (defn m1 134 | [indx] 135 | (let [dur (rand-nth [1/4 1/2 1 1]) 136 | freq (* 100 (inc indx)) 137 | wet-dry 0.5] 138 | (add-wet-dry wet-dry (synth1 dur freq)) 139 | (cause m1 (next-beat dur) 140 | (mod (inc indx) 8) 141 | ))) 142 | 143 | (defn m2 [pchs durs] 144 | (let [p (next-in-atom pchs) 145 | d (next-in-atom durs) 146 | wet-dry 0.1] 147 | (add-wet-dry wet-dry (synth2 d p)) 148 | (cause m2 (next-beat d) (!r! pchs) (!r! durs)))) 149 | 150 | (defn of-range [^double n ^double min-val ^double max-val] 151 | (+ min-val (* n (- max-val min-val)))) 152 | 153 | (defn m3 [] 154 | (let [n (beat-mod (sub-beat 4) 16) 155 | pat #{0 2 6} 156 | wet-dry 0.2] 157 | (when (pat n) 158 | (add-wet-dry wet-dry (synth1 1/4 (of-range (/ (inc n) 16.0) 600 700))))) 159 | (cause m3 (next-beat 1/4))) 160 | 161 | (defn m4 [] 162 | (let [n (beat-mod (sub-beat 4) 16) 163 | pat #{0 1 2 3 4 5 6 7} 164 | wet-dry 0.3] 165 | (when (pat n) 166 | (add-wet-dry wet-dry (synth2 1/2 80)))) 167 | (cause m4 (next-beat 1/4))) 168 | 169 | 170 | (defn m5-freq [] 80) 171 | (defn m5 [] 172 | (let [n (beat-mod (sub-beat 4) 16) 173 | pat #{0 1 2 3 4 5 6 7} 174 | wet-dry 0.1] 175 | (when (pat n) 176 | (add-wet-dry wet-dry (synth2 1/2 (m5-freq))))) 177 | (cause m5 (next-beat 1/4))) 178 | 179 | (def m6-pchs 180 | (atom 181 | (cycle (concat 182 | (repeat 16 160) 183 | (repeat 16 200) 184 | (repeat 16 300) 185 | (repeat 16 400) 186 | )))) 187 | 188 | (defn m6-freq [] 189 | (next-in-atom m6-pchs)) 190 | 191 | (defn m6 [] 192 | (let [n (beat-mod (sub-beat 4) 16)] 193 | (add-wet-dry 0.05 (synth1 (beats 1/4) (m6-freq)))) 194 | (cause m6 (next-beat 1/4))) 195 | 196 | (comment 197 | 198 | (start-engine) 199 | 200 | (set-tempo 106) 201 | 202 | ;; eval to get drums going 203 | (cause drums (next-beat 4)) 204 | 205 | ;; eval to get melodic line going 206 | ;; eval multiple times to get parallel melodic lines 207 | (cause m1 (next-beat 4) 0) 208 | 209 | ;; can mutate the pattern sequences while m2 is running in its event stream 210 | (def m2-pchs (atom nil)) 211 | (reset!! m2-pchs (cycle [60 120 60])) 212 | 213 | (def m2-durs (atom nil)) 214 | (reset!! m2-durs (repeatedly #(rand-nth [1/2 1 1/2]))) 215 | 216 | (cause m2 (next-beat 4) (!r! m2-pchs) (!r! m2-durs)) 217 | 218 | ;; sequence ahead 64-beats of changes 219 | (let [t (next-beat 16)] 220 | (cause (fn [] (reset!! m2-durs (repeatedly #(rand-nth [1/2 1])))) 221 | t) 222 | (cause (fn [] (reset!! m2-durs (repeatedly #(rand-nth [1/2 1/4])))) 223 | (+ t 16)) 224 | (cause (fn [] (reset!! m2-durs (repeatedly #(rand-nth [1/2 1])))) 225 | (+ t 32)) 226 | (cause (fn [] (reset!! m2-durs (repeatedly #(rand-nth [1/2 1/4])))) 227 | (+ t 48)) 228 | (cause (fn [] (end-recur! m2)) 229 | (+ t 64))) 230 | 231 | (cause m3 (next-beat 4)) 232 | (cause m4 (next-beat 4)) 233 | 234 | (cause m5 (next-beat 4)) 235 | (redef! m5-freq 236 | (fn [] 237 | (if (> (Math/random) 0.85) 238 | (* 80 4) 80))) 239 | 240 | ;; modify m5-freq to yield different values 241 | (redef! m5-freq 242 | (let [pat (atom (cycle [80 90 100 200]))] 243 | (fn [] 244 | (next-in-atom pat)))) 245 | 246 | ;; schedule the function change for m5-freq 247 | (cause (next-beat 4) 248 | (redef! m5-freq 249 | (let [pat (atom (cycle [80 90 100 200]))] 250 | (fn [] 251 | (next-in-atom pat))))) 252 | 253 | ;; eval to show beat/bar structure in REPL 254 | (cause beat-printer (next-beat 4) 4 16) 255 | 256 | (end-recur! drums) 257 | (end-recur! m2) 258 | 259 | (cause m6 (next-beat 4)) 260 | 261 | (add-afunc 262 | (with-duration (beats 16) 263 | (let-s [e (adsr (beats 8) (beats 8) 0.0 0.0)] 264 | (-> 265 | (sum (blit-triangle 300) (blit-triangle 600)) 266 | (zdf-ladder (sum 300 (mul e 4000)) 6) 267 | (mul 0.5 e ) 268 | (pan 0.1) 269 | )))) 270 | 271 | 272 | 273 | (stop-engine) 274 | 275 | ) 276 | 277 | -------------------------------------------------------------------------------- /src/main/pink/event.clj: -------------------------------------------------------------------------------- 1 | (ns pink.event 2 | (:require [pink.util :refer [create-buffer drain-atom! apply!*!]] 3 | [pink.config :refer [*tempo* *beat*]] ) 4 | (:import [java.util Collection PriorityQueue] 5 | [java.util.concurrent ArrayBlockingQueue] 6 | )) 7 | 8 | ;; Ensure unchecked math used for this namespace 9 | (set! *unchecked-math* :warn-on-boxed) 10 | 11 | (deftype Event [event-func ^double start event-args ] 12 | Object 13 | (toString [_] (format "\t%s\t%s\t%s\n" event-func start event-args )) 14 | (hashCode [this] (System/identityHashCode this)) 15 | (equals [this b] (identical? this b)) 16 | 17 | Comparable 18 | (compareTo [this a] 19 | (let [t1 (.start this) 20 | t2 (.start ^Event a)] 21 | (compare t1 t2)))) 22 | 23 | (definterface IEventList 24 | (^void setEventProcFn 25 | [proc-fn] 26 | "Set event processing function. proc-fn should be an arity 2 function with 27 | input arguments of type double and Event. First argument will be the 28 | current beat time of the event list and the second argument will be the 29 | current Event to process.") 30 | (getEventProcFn 31 | [] "Returns the current event processing function for the EventList.") 32 | (^double getCurBeat [] "Return current beat time") 33 | (^void setCurBeat [^double beat] "Set current beat time") 34 | (^double getTempo [] "Return tempo") 35 | (^void setTempo [^double beat] "Set tempo")) 36 | 37 | (deftype EventList [^PriorityQueue events ^ArrayBlockingQueue pending-events 38 | ^ArrayBlockingQueue temp-pending 39 | ^:unsynchronized-mutable ^double cur-beat 40 | ^long buffer-size ^long sr 41 | ^:unsynchronized-mutable ^double tempo 42 | ^:unsynchronized-mutable event-proc-fn] 43 | IEventList 44 | (^void setEventProcFn [_ proc-fn] (set! event-proc-fn proc-fn) nil) 45 | (getEventProcFn [_] event-proc-fn) 46 | (^double getCurBeat [_] cur-beat) 47 | (^void setCurBeat [_ ^double beat] (set! cur-beat beat) nil) 48 | (^double getTempo [_] tempo) 49 | (^void setTempo [_ ^double new-tempo] (set! tempo new-tempo) nil) 50 | 51 | Object 52 | (toString [_] (str events)) 53 | (hashCode [this] (System/identityHashCode this)) 54 | (equals [this b] (identical? this b))) 55 | 56 | (defn event 57 | "Create an Event object. Can either pass args as list or variadic args." 58 | ([f start] 59 | (Event. f start [])) 60 | ([f start args] 61 | (if (sequential? args) 62 | (Event. f start args) 63 | (Event. f start [args]))) 64 | ([f start x & args] 65 | (Event. f start (list* x args)))) 66 | 67 | (defn wrap-event 68 | "Wraps an event with other top-level functions." 69 | [f pre-args ^Event evt ] 70 | (event f (.start evt) (conj pre-args evt))) 71 | 72 | (defn alter-event-time 73 | "Utility function to create a new Event using the same values as the 74 | passed-in event and new start time." 75 | [^double start ^Event evt] 76 | (event (.event-func evt) start (.event-args evt))) 77 | 78 | (defn wrap-relative-start 79 | [^double cur-beat ^Event a] 80 | (alter-event-time (+ cur-beat (.start a)) a)) 81 | 82 | 83 | (defn events [f & args] 84 | (map #(apply event f %) args)) 85 | 86 | (defn event-list 87 | "Creates an EventList. 88 | 89 | EventLists maintain their own internal time and fire off events whose start 90 | times have been met. Events have no notion of duration. An event may do 91 | things like schedule an audio function to be added to an engine's 92 | performance list, force turning off an audio function, and so on." 93 | 94 | ([buffer-size sr] (event-list [] buffer-size sr)) 95 | ([^Collection evts buffer-size sr] 96 | (EventList. 97 | (PriorityQueue. evts) (ArrayBlockingQueue. 32768) (ArrayBlockingQueue. 32768) 98 | 0.0 buffer-size sr (double *tempo*) 99 | wrap-relative-start))) 100 | 101 | (defn event-list-add 102 | "Add an event or events to an event list" 103 | [^EventList evtlst evts] 104 | (let [^ArrayBlockingQueue pending (.pending-events evtlst)] 105 | (cond 106 | (sequential? evts) 107 | (.addAll pending evts) 108 | (:events evts) 109 | (.addAll pending (.events ^EventList evts)) 110 | (instance? Event evts) 111 | (.add pending evts) 112 | :else 113 | (throw (Exception. (str "Unexpected event: " evts))))) 114 | nil) 115 | 116 | (defn event-list-clear 117 | "Clear all events from an EventList" 118 | [^EventList evtlst] 119 | (.clear ^PriorityQueue (.events evtlst))) 120 | 121 | (defn event-list-remove 122 | "remove an event from the event list" 123 | [^EventList evtlst evt] 124 | 125 | ; this needs to be done using a pending-removals list 126 | 127 | ) 128 | 129 | (defn event-list-empty? 130 | [^EventList evtlst] 131 | (.isEmpty ^PriorityQueue (.events evtlst))) 132 | 133 | (defn fire-event 134 | "Evaluates event as delayed function application. Swallows exceptions and 135 | returns nil." 136 | [evt] 137 | (try 138 | (apply!*! (.event-func ^Event evt) 139 | (.event-args ^Event evt)) 140 | (catch Throwable t 141 | (.printStackTrace t) 142 | nil))) 143 | 144 | (defn- merge-pending! 145 | "Merges pending-events with the PriorityQueue of known events. Event start 146 | times are processed relative to the EventList's cur-beat." 147 | [^EventList evtlst] 148 | (let [^ArrayBlockingQueue pending (.pending-events evtlst) 149 | ^ArrayBlockingQueue temp-pending (.temp-pending evtlst) 150 | ^PriorityQueue active-events (.events evtlst)] 151 | (.drainTo pending temp-pending) 152 | (try 153 | (when (> (.size temp-pending) 0) 154 | (let [cur-beat (.getCurBeat evtlst) 155 | tempo (.getTempo evtlst) 156 | event-proc-fn (.getEventProcFn evtlst)] 157 | (doseq [x temp-pending] 158 | (.add active-events (event-proc-fn cur-beat x))) 159 | (.clear temp-pending))) 160 | (catch Exception e 161 | (println "Error: Invalid pending events found!") 162 | nil)))) 163 | 164 | (defn seconds->beats 165 | ^double [^double seconds ^double tempo] 166 | (* seconds (/ tempo 60.0))) 167 | 168 | (defn beats->seconds 169 | ^double [^double beats ^double tempo] 170 | (* beats (/ 60.0 tempo))) 171 | 172 | (defn- proc-events 173 | [^PriorityQueue events ^double cur-beat 174 | ^double end-time] 175 | (loop [evt ^Event (.peek events)] 176 | (when evt 177 | (if (< (.start evt) cur-beat) 178 | (do 179 | (.poll events) 180 | (recur (.peek events))) 181 | (when (< (.start evt) end-time) 182 | (fire-event (.poll events)) 183 | (recur (.peek events))))))) 184 | 185 | (defn event-list-tick! 186 | [^EventList evtlst] 187 | (merge-pending! evtlst) 188 | (let [cur-beat (.getCurBeat evtlst) 189 | tempo (.getTempo evtlst) 190 | time-adj (seconds->beats 191 | (/ (double (.buffer-size evtlst)) 192 | (double (.sr evtlst))) 193 | tempo) 194 | end-time (+ cur-beat time-adj) 195 | events ^PriorityQueue (.events evtlst)] 196 | ;; setting curbeat before binding so that 197 | ;; binding is in tail-position and therefore does 198 | ;; not produce closure by Clojure Compiler 199 | (.setCurBeat evtlst end-time) 200 | (binding [*tempo* tempo 201 | *beat* cur-beat] 202 | (proc-events events cur-beat end-time)) 203 | )) 204 | 205 | (defn event-list-processor 206 | "Returns a control-function that ticks through an event list" 207 | [^EventList evtlst] 208 | (fn ^doubles [] 209 | (event-list-tick! evtlst) 210 | (not (.isEmpty ^PriorityQueue (.events evtlst))))) 211 | 212 | 213 | (defn use-absolute-time! 214 | "Set EventList to insert new events without modification 215 | to start times." 216 | [^EventList evtlst] 217 | (.setEventProcFn evtlst (fn [_ evt] evt)) ) 218 | 219 | 220 | (defn use-relative-time! 221 | "Set EventList to insert new events processing their start times as relative 222 | to the cur-beat. (This is the default behavior of EventList.)" 223 | [^EventList evtlst] 224 | (.setEventProcFn evtlst wrap-relative-start)) 225 | -------------------------------------------------------------------------------- /src/main/pink/io/midi.clj: -------------------------------------------------------------------------------- 1 | (ns ^{ :doc 2 | "Functions for handling MIDI event and controller input 3 | 4 | Pink's design uses a virtual device system so that projects 5 | can be written to depend on the virtual device, and the 6 | real device can be configured per-system using a .pinkrc 7 | file. This allows both swapping in and out of hardware as 8 | well as creating mock hardware devices. 9 | 10 | Conventions are to use the following for virtual hardware 11 | names: 12 | 13 | * \"keyboard x\" - number of keyboard 14 | * \"knobs/sliders x\" - number of knobs/slider device 15 | 16 | Note, a hardware device can map to multiple virtual devices." 17 | 18 | :author "Steven Yi"} 19 | pink.io.midi 20 | (:require [pink.config :refer :all]) 21 | (:import [javax.sound.midi MidiSystem MidiDevice MidiDevice$Info 22 | Receiver ShortMessage] 23 | [clojure.lang IFn])) 24 | 25 | ;; functions for listing registered MIDI devices 26 | 27 | (defn- device-info->device 28 | "Parses out information about a MIDI connection from a MidiDevice$Info object 29 | and returns it and the MidiDevice it describes in a map." 30 | [^MidiDevice$Info info] 31 | {:name (.getName info) 32 | :description (.getDescription info) 33 | :device-info info 34 | :device (MidiSystem/getMidiDevice info)}) 35 | 36 | (defn list-devices 37 | "Fetches list of available MIDI devices." 38 | [] 39 | (map device-info->device (MidiSystem/getMidiDeviceInfo))) 40 | 41 | (defn input-device? 42 | "True when device can act as MIDI input. False otherwise." 43 | [{:keys [^MidiDevice device]}] 44 | (not (zero? (.getMaxTransmitters device)))) 45 | 46 | (defn output-device? 47 | "True when device can act as MIDI output. False otherwise." 48 | [{:keys [^MidiDevice device]}] 49 | (not (zero? (.getMaxReceivers device)))) 50 | 51 | (defn list-input-devices 52 | "Lists all MIDI input devices." 53 | [] 54 | (filter input-device? (list-devices))) 55 | 56 | (defn list-output-devices 57 | "Lists all MIDI output devices." 58 | [] 59 | (filter output-device? (list-devices))) 60 | 61 | ;; Pink MIDI Manager 62 | 63 | (defn create-manager [] 64 | (atom {})) 65 | 66 | ;; processors set per channel 67 | (defn add-virtual-device 68 | [midi-manager device-name] 69 | (let [vd {:name device-name 70 | :keys (boolean-array 128 false) 71 | :event-processors (make-array IFn 16) 72 | :cc-processors (into-array (for [i (range 16)] 73 | (into-array 74 | (for [x (range 128)] 75 | (atom 0.0))))) 76 | :listener nil 77 | }] 78 | (swap! midi-manager assoc device-name vd) 79 | vd)) 80 | 81 | (defn list-virtual-devices 82 | [midi-manager] 83 | @midi-manager) 84 | 85 | (comment 86 | (let [f (create-manager)] 87 | (add-virtual-device f "slider/knobs 1") 88 | (add-virtual-device f "keyboard 1") 89 | (println (list-virtual-devices f)))) 90 | 91 | ;; Binding 92 | 93 | (defn device-is-named? 94 | "true when device-name is part of device's description or name." 95 | [^String device-name {:keys [^String description ^String name]}] 96 | (or (>= (.indexOf description device-name) 0) 97 | (>= (.indexOf name device-name) 0))) 98 | 99 | (defn find-device 100 | "Finds device with device-name of device-type :in (input) or :out (output). 101 | Throws exception when multiple or zero matching devices are found." 102 | [device-name device-type] 103 | (let [found (filter (partial device-is-named? device-name) 104 | ((device-type {:in list-input-devices 105 | :out list-output-devices}))) 106 | num-found (count found)] 107 | (cond 108 | (<= num-found 0) 109 | (throw (Exception. (str "No MIDI " 110 | ({:in "input" :out "output"} device-type) 111 | " devices found matching name: " device-name))) 112 | (> num-found 1) 113 | (let [names (map #(str "\t" (:name %) ": " (:description %) "\n") found) 114 | msg ^String (apply str "Multiple devices found (" num-found 115 | ") matching name: " device-name "\n" names)] 116 | (throw (Exception. msg))) 117 | :else (first found)))) 118 | 119 | (defn create-receiver [virtual-device] 120 | (let [^"[[Lclojure.lang.Atom;" cc-processors 121 | (:cc-processors virtual-device) 122 | ^"[Lclojure.lang.IFn;" event-processors 123 | (:event-processors virtual-device) 124 | ] 125 | (reify Receiver 126 | (send [this msg timestamp] 127 | (when (instance? ShortMessage msg) 128 | (let [smsg ^ShortMessage msg 129 | cmd (.getCommand smsg) 130 | channel (.getChannel smsg) 131 | data1 (.getData1 smsg) 132 | data2 (.getData2 smsg)] 133 | (condp = cmd 134 | ShortMessage/CONTROL_CHANGE 135 | (when-let [atm (aget cc-processors channel data1)] 136 | (reset! atm data2)) 137 | 138 | ShortMessage/NOTE_ON 139 | (when-let [efn (aget event-processors channel)] 140 | (efn cmd data1 data2)) 141 | 142 | ShortMessage/NOTE_OFF 143 | (when-let [efn (aget event-processors channel)] 144 | (efn cmd data1 data2)) 145 | )) 146 | 147 | ))))) 148 | 149 | (defn bind-device 150 | [midi-manager ^String hardware-id ^String virtual-device-name] 151 | {:pre [midi-manager hardware-id virtual-device-name]} 152 | (println (format "Connecting %s to %s" hardware-id virtual-device-name)) 153 | (let [device ^MidiDevice (:device (find-device hardware-id :in)) 154 | virtual-device (@midi-manager virtual-device-name)] 155 | (when (nil? virtual-device) 156 | (throw (Exception. (format "Unknown virtual device: %s" virtual-device-name)))) 157 | (when (not (.isOpen device)) 158 | (.open device)) 159 | (.setReceiver (.getTransmitter device) 160 | (create-receiver virtual-device)) 161 | )) 162 | 163 | (defn bind-key-func 164 | [virtual-device ^long channel ^IFn afn] 165 | (aset ^"[Lclojure.lang.IFn;" ( :event-processors virtual-device) 166 | channel afn)) 167 | 168 | (defn get-cc-atom 169 | [virtual-device channel cc-num] 170 | (aget (:cc-processors virtual-device) 171 | channel cc-num)) 172 | 173 | ;(defn cc-trigger 174 | ; [trigfn] 175 | ; (fn [key atm old-v new-v] 176 | ; (when (and (< old-v 127) (= new-v 127)) 177 | ; (trigfn) 178 | ; ))) 179 | 180 | (defn set-event-processor 181 | [virtual-device channel midi-event-func] 182 | 183 | ) 184 | 185 | ;; MIDI Device Debugging 186 | 187 | (defn create-debug-receiver [] 188 | (reify Receiver 189 | (send [this msg timestamp] 190 | (when (instance? ShortMessage msg) 191 | (let [smsg ^ShortMessage msg 192 | cmd (.getCommand smsg) 193 | channel (.getChannel smsg) 194 | data1 (.getData1 smsg) 195 | data2 (.getData2 smsg)] 196 | (println (format "%d %d %d %d" cmd channel data1 data2))))))) 197 | 198 | (defn device-debug 199 | [^String hardware-id] 200 | (let [device ^MidiDevice (:device (find-device hardware-id :in))] 201 | (when (not (.isOpen device)) 202 | (.open device)) 203 | (.setReceiver (.getTransmitter device) (create-debug-receiver)) 204 | )) 205 | 206 | ;; MIDI Output 207 | 208 | (defn note-on [^Receiver receiver channel note-num velocity] 209 | (let [msg (ShortMessage.)] 210 | (.setMessage msg ShortMessage/NOTE_ON channel note-num velocity) 211 | (.send receiver msg -1))) 212 | 213 | (defn note-off [^Receiver receiver channel note-num velocity] 214 | (let [msg (ShortMessage.)] 215 | (.setMessage msg ShortMessage/NOTE_ON channel note-num 0) 216 | (.send receiver msg -1))) 217 | 218 | (defn midi-note 219 | [receiver dur channel note-num velocity] 220 | (note-on receiver channel note-num velocity) 221 | (let [start (long *current-buffer-num*) 222 | end (long (/ (* dur *sr*) *buffer-size*))] 223 | (fn [] 224 | (if (> (- (long *current-buffer-num*) start) end) 225 | (do 226 | (note-off receiver channel note-num velocity) 227 | false) 228 | true)))) 229 | 230 | ;; Utility functions 231 | 232 | 233 | (defn midi->freq 234 | "Convert MIDI Note number to frequency in hertz" 235 | ^double [^long notenum] 236 | (* 440.0 (Math/pow 2.0 (/ (- notenum 57) 12)))) 237 | 238 | -------------------------------------------------------------------------------- /src/demo/pink/demo/demo_filters.clj: -------------------------------------------------------------------------------- 1 | (ns pink.demo.demo-filters 2 | (:require [pink.simple :refer :all] 3 | [pink.event :refer :all] 4 | [pink.space :refer [pan]] 5 | [pink.oscillators :refer :all] 6 | [pink.envelopes :refer :all] 7 | [pink.util :refer :all] 8 | [pink.noise :refer :all] 9 | [pink.filters :refer :all] 10 | [pink.delays :refer [adelay]] 11 | [pink.config :refer :all] 12 | )) 13 | 14 | (defn setup-filter 15 | [filterfn & args] 16 | (pan (mul 0.5 (apply filterfn (white-noise) args)) 17 | 0.0)) 18 | 19 | (defn test-filter 20 | [filterfn & args] 21 | (add-audio-events 22 | (apply event setup-filter 0.0 filterfn args))) 23 | 24 | (comment 25 | 26 | (def score 27 | (events test-filter 28 | [0.0 butterlp (env [0.0 20 5 20000])] 29 | [5.0 butterhp (env [0.0 20 5 20000])] 30 | [10.0 butterbp (env [0.0 20 5 20000]) 100] 31 | [15.0 butterbr (env [0.0 20 5 20000]) 1000] 32 | )) 33 | 34 | (add-audio-events score) 35 | 36 | (start-engine) 37 | 38 | ;; Individual tests 39 | 40 | (test-filter butterlp (env [0.0 20 10 20000])) 41 | (test-filter butterlp (env [0.0 20 10 20000])) 42 | (test-filter butterhp (env [0.0 20 5 20000])) 43 | (test-filter butterbp (env [0.0 20 5 20000]) 100 ) 44 | (test-filter butterbr (env [0.0 20 5 20000]) 1000 ) 45 | (test-filter butterbr (env [0.0 20 5 20000]) 100 ) 46 | (test-filter moogladder (env [0.0 20 10 20000]) 0.1 ) 47 | (test-filter biquad-lpf (env [0.0 20 5 20000]) 0.4 ) 48 | (test-filter biquad-hpf (env [0.0 20 5 20000]) 0.1 ) 49 | (test-filter biquad-bpf (env [0.0 20 5 20000]) 0.9 ) 50 | (test-filter biquad-notch (env [0.0 20 5 20000]) 0.6 ) 51 | (test-filter biquad-peaking (env [0.0 20 5 20000]) 0.6 12 ) 52 | (test-filter biquad-peaking (env [0.0 20 5 20000]) 0.9 -24) 53 | (test-filter biquad-lowshelf (env [0.0 20 5 20000]) 0.6 12) 54 | (test-filter biquad-lowshelf (env [0.0 20 5 20000]) 0.9 -24) 55 | (test-filter biquad-highshelf (env [0.0 20 5 20000]) 0.6 12 ) 56 | (test-filter biquad-highshelf (env [0.0 20 5 20000]) 0.9 -24) 57 | 58 | (doseq [_ (range 5)] 59 | (add-afunc 60 | (let [pch (+ 60 (rand-int 400))] 61 | (let-s [;ampenv (xar 0.025 1.5) 62 | ampenv (env [0.0 0.0 0.025 1.0 0.025 0.9 1.0 0.9 2.0 0.0]) 63 | cutenv (env [0.0 (* 6.0 pch) 0.025 (* 3.0 pch) 3.025 (* 3.0 pch)]) 64 | ] 65 | (pan (mul 0.5 ampenv 66 | (moogladder (sum (mul 0.9 (blit-saw pch)) 67 | (mul 0.2 (blit-saw (* pch 1.5)))) 68 | (sum (* pch 3) (mul (* pch 4) ampenv)) 69 | ;cutenv 70 | ;(* pch 5) 71 | 0.85 72 | 73 | )) 74 | (- 1 (/ (rand-int 200) 100.0))))))) 75 | 76 | ;(add-afunc (mul 0.5 (butterlp (white-noise) (env [0.0 20 5 20000])))) 77 | 78 | (add-afunc 79 | (with-signals [[hp _ _ _] (statevar (white-noise) (env [0.0 20 5 10000]) 0.8)] 80 | (pan hp 0.0))) 81 | 82 | (add-afunc 83 | (with-signals [[_ lp _ _] (statevar (white-noise) (env [0.0 20 5 10000]) 0.8)] 84 | (pan lp 0.0))) 85 | 86 | (add-afunc 87 | (with-signals [[_ _ bp _] (statevar (white-noise) (env [0.0 20 5 10000]) 0.8)] 88 | (pan bp 0.0))) 89 | 90 | (add-afunc 91 | (with-signals [[_ _ _ br] (statevar (white-noise) (env [0.0 20 5 10000]) 0.8)] 92 | (pan br 0.0))) 93 | 94 | 95 | (defn example [freq] 96 | (let-s [ramp-env (env [0.0 0.0 5.0 1.0 10.0 0.0]) 97 | e (adsr140 98 | (sine2 (sum 3.0 (mul ramp-env 15.0))) 99 | 0 100 | 0.04 0.02 0.9 0.15)] 101 | (-> 102 | (sum (blit-saw freq) 103 | (blit-saw (mul freq 1.002581))) 104 | (mul e ramp-env) 105 | (moogladder (sum 1000 (mul 500 6 e ramp-env)) 0.6) 106 | (pan 0.0) 107 | ))) 108 | 109 | (add-afunc (example 660.0)) 110 | (add-afunc (example 550.0)) 111 | (add-afunc (example 880.0)) 112 | (add-afunc (example 440.0)) 113 | (add-afunc (example 1320.0)) 114 | (add-afunc (example 1000.0)) 115 | 116 | (defn example2 [freq] 117 | (let-s [ramp-env (env [0.0 0.0 5.0 1.0 10.0 0.0]) 118 | e (adsr140 119 | (sine2 (sum 3.0 (mul ramp-env 15.0))) 120 | 0 121 | 0.04 0.02 0.9 0.15)] 122 | (let [s (sum (blit-saw freq) (blit-saw (mul freq 1.002581))) 123 | source (mul e ramp-env s) 124 | filtered (statevar source (sum 400 (mul 400 6 e ramp-env)) 0.5)] 125 | (with-signals [[hp lp _ _] filtered] 126 | (-> 127 | (sum (mul (sub 1.0 ramp-env) lp) 128 | (mul ramp-env hp)) 129 | (pan 0.0)))))) 130 | 131 | (add-afunc (example2 100.0)) 132 | (add-afunc (example2 400.0)) 133 | (add-afunc (example2 600.0)) 134 | (add-afunc (example2 900.0)) 135 | (add-afunc (example2 1200.0)) 136 | (add-afunc (example2 1800.0)) 137 | 138 | (add-afunc 139 | (let [asig (shared (blit-saw (exp-env [0.0 2000 3.0 20]))) 140 | l (comb asig 3.5 0.1) 141 | r (comb asig 3.5 0.02) 142 | ^"[[D" out (create-buffers 2)] 143 | (fn [] 144 | (let [a (l) b (r)] 145 | (when (and a b) 146 | (aset out 0 a) 147 | (aset out 1 b) 148 | out))))) 149 | 150 | (add-afunc 151 | (let [asig (shared (blit-saw (exp-env [0.0 2000 3.0 20]))) 152 | l (combinv asig 3.5 0.1) 153 | r (combinv asig 3.5 0.02) 154 | ^"[[D" out (create-buffers 2)] 155 | (fn [] 156 | (let [a (l) b (r)] 157 | (when (and a b) 158 | (aset out 0 a) 159 | (aset out 1 b) 160 | out))))) 161 | 162 | 163 | (defn example3 [freq] 164 | (let-s [ramp-env (env [0.0 0.0 5.0 1.0 10.0 0.0]) 165 | e (adsr140 166 | (unirect (env [0.0 8.0 10.0 1.0]) (env [0.0 0.6 10.0 0.1])) 167 | 0 168 | 0.04 0.02 0.9 0.15)] 169 | (-> 170 | (sum (blit-saw freq) 171 | (blit-saw (mul freq 1.002581))) 172 | (mul e ramp-env) 173 | (moogladder (sum 1000 (mul 500 6 e ramp-env)) 0.6) 174 | (pan 0.0) 175 | ))) 176 | 177 | 178 | (add-afunc (example3 1200.0)) 179 | (add-afunc (example3 1800.0)) 180 | 181 | (add-afunc 182 | (-> 183 | (blit-saw 220) 184 | (lpf18 (env [0.0 10000 5 20]) 0.5 1) 185 | (pan 0.0))) 186 | 187 | (add-afunc 188 | (-> 189 | (white-noise) 190 | (zdf-1pole (env [0.0 10000 5 20])) 191 | (pan 0.0))) 192 | 193 | (add-afunc 194 | (-> 195 | (white-noise) 196 | (zdf-1pole (env [0.0 20 5 10000]) 1) 197 | (pan 0.0))) 198 | 199 | (add-afunc 200 | (-> 201 | (white-noise) 202 | (zdf-1pole (env [0.0 20 5 10000]) 2) 203 | (pan 0.0))) 204 | 205 | 206 | (add-afunc 207 | (-> 208 | (white-noise) 209 | (zdf-2pole (env [0.0 10000 5 20]) 4) 210 | (pan 0.0))) 211 | 212 | (add-afunc 213 | (-> 214 | (white-noise) 215 | (zdf-2pole (exp-env [0.0 20 5 10000]) 4 1) 216 | (pan 0.0))) 217 | 218 | (add-afunc 219 | (-> 220 | (white-noise) 221 | (zdf-2pole (exp-env [0.0 20 5 10000]) 4 2) 222 | (pan 0.0))) 223 | 224 | 225 | (add-afunc 226 | (-> 227 | (white-noise) 228 | (zdf-ladder (exp-env [0.0 5000 5 20]) 25) 229 | (pan 0.0))) 230 | 231 | (add-afunc 232 | (-> 233 | (white-noise) 234 | (k35-lpf (exp-env [0.0 5000 0.5 1000]) 9.95) 235 | (pan 0.0))) 236 | 237 | (add-afunc 238 | (-> 239 | (white-noise) 240 | (k35-hpf (exp-env [0.0 10000 5 20]) 10) 241 | (pan 0.0))) 242 | 243 | (add-afunc 244 | (-> 245 | (dust2 (exp-env [0.0 20000 4 10 1 10])) 246 | (zdf-ladder (exp-env [0.0 4000 5 3000]) 10) 247 | (pan 0.0))) 248 | 249 | (add-afunc 250 | (with-duration 0.5 251 | (let [e (shared (adsr 0.01 0.2 0.09 0.15))] 252 | (-> 253 | (sum (blit-saw 220) (blit-square 110)) 254 | (k35-hpf 400 7) 255 | (k35-lpf 256 | (sum 110 (mul 3000 e)) 9.5) 257 | ;(zdf-2pole (sum 200 (mul 3000 e)) 8) 258 | ;(get-channel 0) 259 | (mul e 0.25) 260 | (pan 0.0) 261 | )))) 262 | 263 | (add-afunc 264 | (with-duration 0.25 265 | (let [e (shared (adsr 0.01 0.00 1.0 0.15))] 266 | (-> 267 | (blit-saw 110) 268 | (diode-ladder (sum 200 (mul (adsr 0.01 0.25 0.0001 0.25) 6000)) 269 | 10 :norm 4) 270 | (mul e) 271 | (pan 0.0) 272 | )))) 273 | ) 274 | 275 | --------------------------------------------------------------------------------