├── .gitignore ├── BootScript.hs ├── ChangeLog.md ├── LICENSE ├── README.org ├── TimeLines.cabal ├── app └── Main.hs ├── doc └── Kyriakoudis2018.pdf ├── images ├── color_keyboard.png └── waves.png ├── package.yaml ├── src └── Sound │ └── TimeLines │ ├── Constants.hs │ ├── Context.hs │ ├── Globals.hs │ ├── Instruments.hs │ ├── OSC.hs │ ├── Time.hs │ ├── TimeLines.hs │ ├── Types.hs │ └── Util.hs ├── stack.yaml └── test └── Spec.hs /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | timelines2.cabal 3 | *~ -------------------------------------------------------------------------------- /BootScript.hs: -------------------------------------------------------------------------------- 1 | :set prompt "TimeLines>> " 2 | :set prompt-cont "" 3 | setupOSC 4 | import qualified Prelude as Pr -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for timelines2 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2019 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: TimeLines: A Live Coding Modular Synth & Sequencer 2 | 3 | #+caption: 4 | [[file:./images/waves.png]] 5 | 6 | A versatile, customizable, and live codable modular synth and sequencer. 7 | See it in action celebrating 15 years of TOPLAP.org! 8 | 9 | http://www.youtube.com/watch?v=dsHnWE6_JbE 10 | 11 | * Status Update 12 | 05/06/2021 13 | 14 | Development of TimeLines has been in hibernation for a while now, but the project is certainly not dead. The long-term roadmap includes goals like a custom language, a domain-specific editor, a purpose-designed keyboard and other hardware controllers, visual feedback and more. Currently, development efforts are focused there. More details to follow soon. 15 | 16 | * What is it? 17 | TimeLines is a powerful, versatile, and customizable modular synth 18 | and sequencer in the form of a live coding language. This means that instead of 19 | patching cables, moving sliders, and turning dials, one writes and modifies code 20 | (which is just maths in disguise) to describe how each synth's parameters should be changing over time. 21 | 22 | You can think of it as the automation feature of modern DAWs on steroids, only instead of painstakingly clicking and dragging to get that shape just right, you use maths to do the job for you. 23 | 24 | TimeLines is based on the idea that all music is a function of time. This simply 25 | means that, ultimately, music is what emerges as time flows forwards, bringing 26 | about all changes in sound that we perceive as melodies, rhythms, chord 27 | progressions etc. TimeLines builds on that concept by forming all musical 28 | structure as functions of time. Time is not dealt with behind the scenes, as is 29 | the case for most synthesizers and music software, but is rather brought to the 30 | surface and subjected to all kinds of transformations: we can stretch it, 31 | compress it, loop it, turn it into discrete steps, speed it up and slow it down, and give it all sorts of funny shapes. 32 | 33 | Every parameter of a musical process (synth, effect, sequence etc.) is 34 | controlled through an equation that asks a simple question: "If the time right 35 | now is 't' seconds (counting from the beginning of the piece or performance), what value should this parameter have right now?". This question is then answered for every consecutive moment in time, essentially mapping out the "automation line" of that parameter. This allows one to become arbitrarily specific when making music, gaining full control over each and every aspect of their sound and composition. 36 | 37 | The best part? The level of maths required is taught in schools, with the overwhelming majority of the equations using just addition, subtraction, multiplication, division, and modulo operations. All you have to do is learn how each of these changes the sound and behavior of your instruments. 38 | ** More Technical Bits 39 | TimeLines is a real-time environment for live coding music as functions of explicit time. It is embedded in Haskell, a purely functional programming language, and currently lives within the Emacs programmable editor. It acts as a front-end to the SuperCollider synthesis server, modulating all parameters of a synth (such as its amplitude, frequency, filter cutoff etc.) over time by sampling mathematical equations hundreds or thousands of times per second. 40 | 41 | At the moment, TimeLines is used as the "brains" of the SuperCollider synthesis engine, a completely modular environment for building and connecting sound synthesis and editing processes. TimeLines plugs on top of those processes and hijacks their behavior, taking full control of their parameters over time. Synths can be created, freed, and patched into one another in all sorts of different ways, making TimeLines a fully modular synth and sequencer. Everything is purely functional: no state is changed, no envelopes are triggered, no sequencers are manipulated, just waves that dictate the motion of each parameter. 42 | 43 | Currently TimeLines is being developed to also control and sequence hardware modular synths. 44 | * Installation 45 | *Disclaimer*: The installation process is subject to change. In principle it should work on all major OSes (Linux, macOS, Windows), but it hasn't been tested thoroughly yet. If you encounter problems, please email us at ~lnfinitemonkeys@tuta.io~ (mind the first letter) and we'll fix it. 46 | 47 | *** Quick (if you know what you're doing) 48 | To use TimeLines you will need the following installed: 49 | 1. [[https://git-scm.com/downloads][Git]]. If you don't have it already, you should install it first as it will be used for the others. 50 | 2. [[https://supercollider.github.io/download][SuperCollider]] and the [[https://github.com/lnfiniteMonkeys/TimeLines-SC][TimeLines Quark]]. 51 | 3. [[https://www.haskell.org/downloads#platform][Haskell Platform]] (required for Stack and MSYS2 on Windows). 52 | 4. [[https://www.gnu.org/software/emacs][Emacs]] and the [[https://github.com/lnfiniteMonkeys/TimeLines-emacs][timelines-mode]]. (support for more editors coming soon!) 53 | 5. *Important*: You will also need the C library ~libsndfile~ installed. Installation might vary for different operating systems. See here for more information on Linux (https://stackoverflow.com/questions/2057395/package-libsndfile-dev-has-no-installation-candidate#2057481), MacOS (http://macappstore.org/libsndfile/) and Windows (http://www.mega-nerd.com/libsndfile/#Download). 54 | 55 | *** In-Depth (for the rest of us) 56 | 1. Install [[https://git-scm.com/downloads][Git]], [[https://supercollider.github.io/download][SuperCollider]], [[https://www.gnu.org/software/emacs][Emacs]], and the [[https://www.haskell.org/downloads#platform][Haskell Platform]] (should be pretty 57 | straightforward on all major OSes). 58 | 2. Clone this repository to a directory on your machine (by default your home 59 | directory) using something like ~git clone 60 | https://github.com/lnfiniteMonkeys/TimeLines.git ~/timelines~. Take note of 61 | that path. 62 | 63 | *Windows Users* should use something like ~git clone 64 | https://github.com/lnfiniteMonkeys/TimeLines.git %HOMEPATH%\timelines~ instead. 65 | 3. Install the [[https://github.com/lnfiniteMonkeys/TimeLines-SC][TimeLines Quark]] by opening Supercollider and evaluating the line 66 | ~Quarks.install("https://github.com/lnfiniteMonkeys/TimeLines-SC.git");~ (you 67 | can evaluate single lines by pressing ~Shift + Enter~). Verify that it was 68 | successfully installed by running ~TimeLines.start;~ and looking for a 69 | boot confirmation in the console. 70 | 4. Lastly, install the [[https://github.com/lnfiniteMonkeys/TimeLines-emacs][timelines-mode]] for Emacs by cloning it into a directory 71 | (for example ~Git clone 72 | https://github.com/lnfiniteMonkeys/TimeLines-Emacs.git ~/timelines-emacs~) 73 | and then adding the following lines in your ~.emacs~ or ~.emacs.d/init.el~, 74 | replacing the dummy paths for where you cloned the repos above: 75 | #+BEGIN_SRC elisp 76 | ;; Tell emacs where it can find timelines-mode 77 | (add-to-list 'load-path "~/path/to/timelines-mode") 78 | (require 'timelines-mode) 79 | (setq timelines-path "~/path/to/timelines/source") 80 | #+END_SRC 81 | 5. (Windows Only) 82 | * Usage 83 | Once all of these are successfully installed, the following steps will get you up and running with a session: 84 | 1. Start Supercollider and start the server (see boot script). You should see a message confirming that TimeLines has been successfully booted. 85 | 2. Start Emacs, create and navigate to a file ending in ~.tl~ (e.g. by pressing ~C-x C-f~ in Emacs and typing the name of the file), and press ~C-c C-s~ to start a session. More keyboard shortcuts shown below. 86 | 3. Type some code and execute it by pressing ~C-ENTER~. See below for examples that you can copy-paste to make sound. 87 | 88 | #+CAPTION: The basic color-coded shortcuts for timelines-mode in Emacs 89 | [[file:./images/color_keyboard.png]] 90 | 91 | ** Main Concepts 92 | *** Signal 93 | Signals are the building blocks of music in TimeLines, defined as functions that take time and return a value. These signals are not what comes out of the speakers, but they are used to control all the parameters of the instruments. Digital or analog, discreete or continuous, signals make the world go round. 94 | 95 | There are, give or take, five main types of signals: 96 | 1. *Constant:* The simplest type of signal, which completely ignores the time and always returns the same value. Signals like ~2~, ~pi~, and ~5/4~ are all constant. 97 | 2. *Identity*: The most important type of signal, time itself. Abbreviated as ~t~, this signal will always return the value passed to it, practically acting as a clock. 98 | 3. *Periodic*: Signals that repeat their behaviour after a certain amount of time. This includes anything from simple trigonometric functions such as ~sine~ and ~cosine~, phasors (i.e. ramps that go from 0 to 1 and repeat), or more complicated signals such as whole melodic phrases or rhythms that repeat after some time. 99 | 4. *Pseudo-random*: Any signal whose output seems random to the human ear. As opposed to random number generators, these signals won't just yield a pseudo-random number every time they're called, but rather have to be explicitly indexed into to get the next (or previous) values. This may sound like an unnecessarily tedious way of doing things, but it has some major advantages. For example, previously indexed values can be re-used at any time, simply by passing the same argument to the function. More on this in the examples. 100 | 5. *Arbitrary*: Lastly, the majority of signals will not fall in any of the above categories, but will be arbitrary combinations of one or more of them. Such signals may be constant for a while, then loop for some time before introducing some randomness, and finally falling constant for the rest of time. Arbitrary signals can be put together by taking a few signals of varying behaviours, cropping them so that they only have a non-zero value inside their allocated time slot, and finally summing them all together. The end result creates the illusion of a single signal, whose behaviour seamlessly (or abruptly) changes from one signal to another over time. 101 | *** Timeline 102 | A timeline is a collection of signals. They each may be of different types, have different contents and durations, and only affect the final output at certain times and not others. Ultimately, a timeline describes the life course of each parameter of every instrument in a piece of music. 103 | *** Window 104 | A Window is a frame of time. All signals are defined over continuous, infinite time. A global Window determines the time interval over which all signals are actually being evaluated and observed. Without a Window, nothing actually gets calculated, everything is hypothetical (and completely deterministic, so you can be sure that evaluating the same code over the same Window will always yield the same results). 105 | 106 | If you are familiar with DAWs, you can think of a Window as the selected section of the piece you are currently working on, which is usually either looped, to monitor changes to it while they're applied, or played in between changes. 107 | 108 | If you are more familiar with programming, you can think of the Window as the viewport in a game: the code to put together a whole level already exists, but at any given moment there is only a certain window that has to be loaded and rendered, the one that the player is actually looking at. Everything else remains in the hypothetical realm, ready to be assembled when the time is right. 109 | *** Synths 110 | (WIP) A synth represents a collection of signals, each of which is assigned to a specific parameter of a sound generating and/or processing module. In other words, a synth can be a single oscillator, a filter, a delay, a reverb, a mixer, or all of the above. In fact, synths can even ignore sound altogether and instead send MIDI or OSC messages to other software or external hardware. 111 | *** Patch 112 | (WIP) A patch represents a routing connection between one or more synths, similar to buses in DAWs or actual patched connections in modular synths. 113 | *** Session 114 | (WIP) A session provides a context for all of your synths and signals. There are two main types of sessions, inspired by linear DAW timelines and traditional live coding methods respectively: 115 | - *Finite Session*: You specify a window, say ~(0, 5)~ or ~(2*barDur, 4*barDur)~ for some value of ~barDur~ in seconds, and all signals are only evaluated for that window. 116 | You can think of it as selecting a section of time in a DAW: you can play it once, loop it, or change all of its parameters while its playing for instant feedback. Ideal for working on a section of a track for some time and then being able to come back and find it exactly how you left it. 117 | 118 | - *Infinite Session*: Signals are being evaluated in chunks of 0.5 seconds (can be changed) and the window is constantly increasing behind the scenes. Practically, this means that you can write code that does something different every (milli)second, forever. Pretty neat if you ask us. 119 | ** Code Examples 120 | #+BEGIN_SRC Haskell 121 | {- 122 | All examples are using a finite session with a window of 5 seconds. 123 | You can change the time window by playing with the number in the parentheses, 124 | or you can switch to an infinite session simply by replacing the top line of 125 | each example to "infiniteSession $ do". 126 | -} 127 | 128 | -- An FM synth whose parameters stay constant over time 129 | finiteSession (0, 5) $ do 130 | synth "staticTone_fm" $ do 131 | "amp" <>< 0.1 132 | "freq" <>< 200 133 | "modRatio" <>< 2 134 | "modAmt" <>< 100 135 | "pan" <>< 0 136 | 137 | -- Using a sine LFO of time-varying frequency to modulate 138 | -- the frequency and amount of modulation 139 | finiteSession (0, 5) $ do 140 | synth "wobble_fm" $ do 141 | let lfoSpeed = goFromTo 2 8 $ t/10 -- goes linearly from 2 to 8 Hz over 10 seconds 142 | lfo = sin $ 2*pi*t*lfoSpeed 143 | "amp" <>< 0.1 144 | "freq" <>< 300 + 100 * lfo 145 | "modRatio" <>< 10 146 | "modAmt" <>< 500 + 300 * lfo 147 | "pan" <>< 0 148 | 149 | -- Playing a looping melody while applying a tremolo LFO to the 150 | -- amplitude and a slowed down version to the modulation amount. 151 | -- The result is then patched into a delay synth, using the same 152 | -- LFO to slightly modulate the delay time. 153 | finiteSession (0, 5) $ do 154 | let fundFreq = 120 155 | -- this will loop through the semitones every 5 seconds 156 | melody = fundFreq * (semitones $ fromList [0, 0, 5, 7, 8, 4, 12, 12] $ wrap01 $ t/5) 157 | tremoloLFO = sin01 $ 2*pi*t*6 158 | synth "tremoloMelody_fm" $ do 159 | "amp" <>< 0.1 * tremoloLFO 160 | "freq" <>< melody 161 | "modRatio" <>< 5 162 | "modAmt" <>< 1000 * (slow 2 $ tremoloLFO) 163 | "pan" <>< 0 164 | "tremoloMelody_fm" ><> "delaySynth_delay" 165 | synth "delaySynth_delay" $ do 166 | "amp" <>< 1 167 | "delayTime" <>< lerp 0.99 1.01 $ slow 4 tremoloLFO 168 | "decayTime" <>< 5 169 | "pan" <>< 0 170 | #+END_SRC 171 | 172 | -------------------------------------------------------------------------------- /TimeLines.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.35.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: TimeLines 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/lnfiniteMonkeys/TimeLines#readme 11 | bug-reports: https://github.com/lnfiniteMonkeys/TimeLines/issues 12 | author: lnfinite Monkeys 13 | maintainer: lnfiniteMonkeys@tuta.io 14 | copyright: 2019 lnfinite Monkeys 15 | license: GPL-3 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | ChangeLog.md 21 | BootScript.hs 22 | 23 | source-repository head 24 | type: git 25 | location: https://github.com/lnfiniteMonkeys/TimeLines 26 | 27 | library 28 | exposed-modules: 29 | Sound.TimeLines.Constants 30 | Sound.TimeLines.Context 31 | Sound.TimeLines.Globals 32 | Sound.TimeLines.Instruments 33 | Sound.TimeLines.OSC 34 | Sound.TimeLines.Time 35 | Sound.TimeLines.TimeLines 36 | Sound.TimeLines.Types 37 | Sound.TimeLines.Util 38 | other-modules: 39 | Paths_TimeLines 40 | hs-source-dirs: 41 | src 42 | build-depends: 43 | array ==0.5.3.0 44 | , async ==2.2.2 45 | , base >=4.7 && <5 46 | , containers ==0.6.0.1 47 | , deepseq ==1.4.4.0 48 | , directory ==1.3.3.0 49 | , filepath ==1.4.2.1 50 | , hosc ==0.17 51 | , hsndfile ==0.8.0 52 | , mtl ==2.2.2 53 | , random ==1.1 54 | default-language: Haskell2010 55 | 56 | test-suite timelines-test 57 | type: exitcode-stdio-1.0 58 | main-is: Spec.hs 59 | other-modules: 60 | Paths_TimeLines 61 | hs-source-dirs: 62 | test 63 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 64 | build-depends: 65 | array ==0.5.3.0 66 | , async ==2.2.2 67 | , base >=4.7 && <5 68 | , containers ==0.6.0.1 69 | , deepseq ==1.4.4.0 70 | , directory ==1.3.3.0 71 | , filepath ==1.4.2.1 72 | , hosc ==0.17 73 | , hsndfile ==0.8.0 74 | , mtl ==2.2.2 75 | , random ==1.1 76 | , timelines 77 | default-language: Haskell2010 78 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Lib 4 | 5 | main :: IO () 6 | main = someFunc 7 | -------------------------------------------------------------------------------- /doc/Kyriakoudis2018.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lnfiniteMonkeys/TimeLines-hs/ffcca2b57e3f77115275879c493e020fb5aa36b4/doc/Kyriakoudis2018.pdf -------------------------------------------------------------------------------- /images/color_keyboard.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lnfiniteMonkeys/TimeLines-hs/ffcca2b57e3f77115275879c493e020fb5aa36b4/images/color_keyboard.png -------------------------------------------------------------------------------- /images/waves.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lnfiniteMonkeys/TimeLines-hs/ffcca2b57e3f77115275879c493e020fb5aa36b4/images/waves.png -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: TimeLines 2 | version: 0.1.0.0 3 | github: "lnfiniteMonkeys/TimeLines" 4 | license: GPL-3 5 | author: "lnfinite Monkeys" 6 | maintainer: "lnfiniteMonkeys@tuta.io" 7 | copyright: "2019 lnfinite Monkeys" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | - BootScript.hs 13 | 14 | # Metadata used when publishing your package 15 | # synopsis: Short description of your package 16 | # category: Web 17 | 18 | description: Please see the README on GitHub at 19 | 20 | dependencies: 21 | - base >= 4.7 && < 5 22 | - mtl == 2.2.2 23 | - containers == 0.6.0.1 24 | - deepseq == 1.4.4.0 25 | - array == 0.5.3.0 26 | - directory == 1.3.3.0 27 | - filepath == 1.4.2.1 28 | - hosc == 0.17 29 | - hsndfile == 0.8.0 30 | - async == 2.2.2 31 | - random == 1.1 32 | library: 33 | source-dirs: src 34 | 35 | tests: 36 | timelines-test: 37 | main: Spec.hs 38 | source-dirs: test 39 | ghc-options: 40 | - -threaded 41 | - -rtsopts 42 | - -with-rtsopts=-N 43 | dependencies: 44 | - timelines 45 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/Constants.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.Constants where 2 | 3 | import Sound.TimeLines.Types 4 | 5 | ionian :: [Signal Value] 6 | ionian = [0, 2, 4, 5, 7, 9, 11] 7 | dorian :: [Signal Value] 8 | dorian = [0, 2, 3, 5, 7, 9, 10] 9 | phrygian :: [Signal Value] 10 | phrygian = [0, 1, 3, 5, 7, 8, 10] 11 | lydian :: [Signal Value] 12 | lydian = [0, 2, 4, 6, 7, 9, 11] 13 | mixolydian :: [Signal Value] 14 | mixolydian = [0, 2, 4, 5, 7, 9, 10] 15 | aeolian :: [Signal Value] 16 | aeolian = [0, 2, 3, 5, 7, 8, 10] 17 | locrian :: [Signal Value] 18 | locrian = [0, 1, 3, 5, 6, 8, 10] 19 | 20 | 21 | maj :: [Signal Value] 22 | maj = [0, 4, 7] 23 | 24 | minor :: [Signal Value] 25 | minor = [0, 3, 7] 26 | 27 | maj7 :: [Signal Value] 28 | maj7 = [0, 4, 7, 11] 29 | 30 | minor7 :: [Signal Value] 31 | minor7 = [0, 4, 7, 11] -------------------------------------------------------------------------------- /src/Sound/TimeLines/Context.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.Context (module C) where 2 | 3 | -- This module is for convenientnly grouping and exporting all other modules 4 | -- so that they can be loaded at once 5 | 6 | import Sound.TimeLines.TimeLines as C 7 | import Sound.TimeLines.Types as C 8 | import Sound.TimeLines.Util as C 9 | import Sound.TimeLines.Instruments as C 10 | import Sound.TimeLines.OSC as C 11 | import Sound.TimeLines.Constants as C 12 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/Globals.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.Globals where 2 | 3 | import Data.IORef 4 | import Sound.TimeLines.Types 5 | import System.IO.Unsafe (unsafePerformIO) 6 | --import Data.Global 7 | 8 | 9 | -- | Global reference of the time Window over which 10 | -- | to render each TimeLine 11 | {-# NOINLINE globalWindowRef #-} 12 | -- the "NOINLINE" statement makes sure to never 13 | -- replace globalWindowRef with its body, thus creating 14 | -- another IORef 15 | globalWindowRef :: IORef Window 16 | globalWindowRef = unsafePerformIO $ newIORef (0, 1) 17 | 18 | -- | A global reference to the current session 19 | {-# NOINLINE globalSessionRef #-} 20 | globalSessionRef :: IORef Session 21 | globalSessionRef = unsafePerformIO $ newIORef defaultSession 22 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/Instruments.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.Instruments where 2 | 3 | import Prelude as Pr 4 | import Sound.TimeLines.Types 5 | import Sound.TimeLines.Constants 6 | import Sound.TimeLines.Util 7 | import Data.Fixed 8 | import Control.Applicative 9 | 10 | 11 | --TODO: test 12 | {- 13 | arpeggio :: ChordProg -> Signal Value -> Signal Value -> Signal Value 14 | arpeggio chords octaves sig = 15 | let firstOctaveLoop = fromLists chords $ wrap01 $ octaves * sig 16 | octaves = 12 * (flor $ octaves * sig) 17 | in firstOctaveLoop + octaves 18 | -- firstOctaveloop * (fromList [0..octaves] sig) 19 | -} 20 | 21 | {- 22 | scaleToChords :: Scale -> ChordProg 23 | scaleToChords scale = map f [0..l] 24 | where l = length scale 25 | f = \x -> [scale!!x, scale!!((x+2)%l), scale!!((x+4)%l)] 26 | -} 27 | 28 | rotate :: Int -> [a] -> [a] 29 | rotate _ [] = [] 30 | rotate n xs = zipWith const (drop n (cycle xs)) xs 31 | 32 | replace a b = a 33 | 34 | range lo hi sig = lo + f*sig 35 | where f = hi - lo 36 | 37 | rangeInt lo hi sig = flor $ range lo hi sig 38 | 39 | 40 | realTime phasor dur mult = (fast mult phasor) * (dur/mult) 41 | 42 | 43 | -- | Indexes into a number of unipolar random numbers using a phasor 44 | randoms :: Signal Value -> Signal Value -> Signal Value -> Signal Value 45 | randoms num offset sig = rand $ add offset $ flor $ num*sig 46 | 47 | -- | Indexes into a number of bipolar random numbers using a phasor 48 | randomsBi :: Signal Value -> Signal Value -> Signal Value -> Signal Value 49 | randomsBi num offset sig = uniToBi $ randoms num offset sig 50 | 51 | helperChord :: Scale -> Signal Value -> Int -> Signal Value 52 | helperChord scale numSig voiceNum = Signal $ \t -> 53 | let index = floor (runSig numSig t) 54 | voiceIndex = Pr.mod (index + 2*voiceNum) 7 55 | scale' = map (flip runSig 0) scale 56 | in scale'!!voiceIndex 57 | 58 | 59 | -- | Raises a (normalised) signal's minimum value 60 | raise :: Signal Value -> Signal Value -> Signal Value 61 | raise amt sig = amt +(1-amt)*sig 62 | 63 | -- | Takes a scale and a list of degrees and returns a list of chords 64 | degreesToChords :: Scale -> [Signal Value] -> ChordProg 65 | degreesToChords scale deg = map (degree scale . add 1) deg 66 | 67 | -- | Returns a list of ratios representing a degree of a scale 68 | degree :: Scale -> Signal Value -> [Signal Value] 69 | degree scale degreeNum = map semi $ chordFromDegree scale degreeNum 70 | 71 | -- | Shortcut for indexing into a list of semitones 72 | melody list sig = semi $ fromList list sig 73 | 74 | chordFromDegree :: Scale -> Signal Value -> [Signal Value] 75 | chordFromDegree scale num = map (helperChord scale num) [0..3] 76 | 77 | degreeFromProg l ph = add (-1) $ fromList l ph 78 | 79 | condApply func when val = lerp (val) (func val) when 80 | 81 | -- | Takes a chord progression, a number of octaves, and a 82 | -- | normalised phasor and arpeggiates them 83 | arpeggio :: ChordProg -> Signal Value -> Signal Value -> Signal Value 84 | arpeggio chords octaves sig = 85 | let loop = sequenceLists chords $ wrap01 $ octaves*sig 86 | octave = 12 * (flor $ octaves * sig) 87 | in loop + octave 88 | 89 | 90 | -- | Flattens a list of lists 91 | flattenLists :: [[Signal a]] -> Signal Value -> [Signal a] 92 | flattenLists listOfLists phasor = map f listOfLists 93 | where f list = flip fromList (wrap01 $ mul (constSig $ fromIntegral $ length listOfLists) phasor) list 94 | 95 | -- | Takes a list of lists and a normalized phasors 96 | -- | and sequences their elements 97 | sequenceLists listsofLists phasor = fromList (flattenLists listsofLists phasor) phasor 98 | 99 | --sequenceChords :: ChordProg -> Signal Value -> Chord 100 | 101 | -- | Returns the (absolute) fractional part of a signal 102 | fract :: (RealFrac a) => a -> a 103 | fract x = x - (fromIntegral $ truncate x) 104 | 105 | -- | Floors a signal while keeping it a double 106 | flor :: Signal Value -> Signal Value 107 | flor s = Signal $ \t -> fromIntegral $ floor (runSig s t) 108 | 109 | binaryRand s = flor $ mul 2 $ rand s 110 | 111 | 112 | -- | Indexes into a sine-based pseudo-random domain using a signal 113 | -- TODO: add more distributions 114 | rand :: (RealFrac a, Floating a) => Signal a -> Signal a 115 | rand s = Signal $ \t -> fract $ (0.5 + 0.5 * (sin $ runSig s t))*1293984.31323 116 | 117 | -- | Speeds up a signal by an amount 118 | speed :: Signal Value -> Signal a -> Signal a 119 | speed (Signal amt) (Signal sf) = Signal $ \t -> sf $ (amt t)*t 120 | fast = speed 121 | 122 | -- | Offsets a signal in time by an amount 123 | offset :: Signal Value -> Signal a -> Signal a 124 | offset amt s = Signal $ \t -> runSig s $ t + (runSig amt t) 125 | 126 | -- | Slows down a signal by an amount 127 | slow :: Signal Value -> Signal a -> Signal a 128 | slow (Signal amt) (Signal sf) = Signal $ \t -> sf $ t/(amt t) 129 | 130 | -- | Takes bpm, number of beats in a bar, and number of bars 131 | -- | and returns two phasors, one for beat and one for bar, 132 | -- | and the beat, bar, and total durations 133 | --bpmToPhasors :: Signal Value -> Signal Value -> Signal Value -> (Signal Value, Signal Value, Signal Value, Signal Value, Time) 134 | bpmToPhasors bpm beatsPerBar = 135 | let beatDur = 60/bpm 136 | barDur = beatsPerBar*beatDur 137 | beatPhasor = wrap01 $ t/beatDur 138 | barPhasor = wrap01 $ t/barDur 139 | in (beatPhasor, barPhasor, beatDur, barDur) 140 | 141 | 142 | -- | Takes two signals and returns 1 if both of them are 1, 143 | -- | otherwise 0 144 | andGate :: (Num a, Eq a) => Signal a -> Signal a -> Signal a 145 | andGate v1 v2 = Signal $ \t -> 146 | if (runSig v1 t == 1 && runSig v2 t == 1) then 1 else 0 147 | 148 | -- | Takes two signals and returns 1 if either of them is 1, 149 | -- | otherwise returns 0 150 | orGate :: (Num a, Eq a) => Signal a -> Signal a -> Signal a 151 | orGate v1 v2 = Signal $ \t -> 152 | if (runSig v1 t == 1 || runSig v2 t == 1) then 1 else 0 153 | 154 | -- | Takes a value in semitones and returns the ratio by which to 155 | -- | multiply a fundamental to get that interval 156 | semi :: (Num a, Floating a, Eq a) => Signal a -> Signal a 157 | semi s = 2**(s/12) 158 | 159 | -- | Takes a list of semitones and returns a list of ratios 160 | semis ss = map semi ss 161 | 162 | 163 | -- | Indexes into a list of Signals using a normalized signal 164 | -- | (i.e. between 0 and 1) 165 | fromList :: (RealFrac b) => [Signal a] -> Signal b -> Signal a 166 | fromList vs phasor = Signal $ \t -> 167 | let ln = fromIntegral $ length vs 168 | phVal = clamp 0.0 0.99999999 (runSig phasor t) 169 | index = floor $ phVal*ln 170 | in runSig (vs!!index) t 171 | 172 | 173 | 174 | -- | Clamps between 0 and 1 175 | saturate = clamp 0 1 176 | 177 | boolToNum :: (Num a) => Bool -> a 178 | boolToNum b 179 | | b == True = 1 180 | | b == False = 0 181 | 182 | -- | Positive = 1, negative = 0 183 | _sign :: (Num a, Ord a) => a -> a 184 | _sign v = boolToNum (v <= 0) 185 | -- Bipolar (considering 0) 186 | 187 | -- | Positive = 1, 0 = 0, negative = -1 188 | _signB :: (Num a, Ord a) => a -> a 189 | _signB v 190 | | v == 0 = 0 191 | | v < 0 = -1 192 | | v > 0 = 1 193 | 194 | -- | Returns 1 for positive signals and 0 for negative 195 | sign :: (Ord a, Num a, Functor f) => f a -> f a 196 | sign s = fmap _sign s 197 | 198 | -- | Returns 1 for positive signals, 0 for 0, -1 for negative 199 | signB :: (Ord a, Num a, Functor f) => f a -> f a 200 | signB s = fmap _signB s 201 | 202 | -- | Normalized square wave with period of 2*pi 203 | sqr :: Signal Value -> Signal Value 204 | sqr = sign . sin 205 | 206 | -- Convenience functions for use with $ 207 | --add :: (Num a) => Signal a -> Signal a -> Signal a 208 | add = liftA2 (+) 209 | sub amt val = val - amt 210 | subFrom num val = num - val 211 | mul = liftA2 lazyMul 212 | div a = mul (1/a) 213 | 214 | --Ken Perlin, "Texturing and Modeling: A Procedural Approach" 215 | -- | Smoothstep 216 | smoothstep :: Signal Value -> Signal Value -> Signal Value -> Signal Value 217 | smoothstep s e t = x*x*x*(x*(x*6-15) + 10) 218 | where x = fmap (clamp 0 1) t 219 | 220 | -- | Clamps a value 221 | clamp :: (Ord a) => a -> a -> a -> a 222 | clamp mn mx = max mn . min mx 223 | 224 | -- | Convert a bipolar wave to unipolar 225 | biToUni v = 0.5+0.5*v 226 | 227 | -- | Convert a unipolar wave to bipolar 228 | uniToBi v = 1 - 2*v 229 | 230 | -- | Normalized sine wave 231 | sin01 :: (Fractional a, Floating a) => a -> a 232 | sin01 = biToUni . sin 233 | 234 | --s1 % s2 = fmap mod' 235 | moduloSig :: (Real a, Applicative f) => f a -> f a -> f a 236 | moduloSig s1 s2 = liftA2 (mod') s1 s2 237 | (%) = moduloSig 238 | 239 | -- | Modulo 1 240 | wrap01 s = s % 1 241 | --mod1 = wrap01 242 | 243 | -- | Linear interpolation using a signal 244 | lerp :: (Num a) => Signal a -> Signal a -> Signal a -> Signal a 245 | lerp s e phsr = Signal $ \t -> 246 | let v1 = runSig s t 247 | v2 = runSig e t 248 | mix = runSig phsr t 249 | in (v1*(1-mix)) + (v2*mix) 250 | 251 | -- convenience shortcuts 252 | lerp01 = lerp 0 1 253 | lerp10 = lerp 1 0 254 | 255 | fromTo = lerp 256 | 257 | -- pow x $ a + b = (a+b)**x 258 | -- | Applies an exponent to a signal 259 | pow :: (Floating a, Eq a) => Signal a -> Signal a -> Signal a 260 | pow = flip (**) 261 | 262 | --step p t = if (t < p) then 0 else 1 263 | -- Takes a point, time, and a value, returning 264 | -- an identity number before point and the value after 265 | {- 266 | step p v = Signal $ \t -> 267 | if (t < runSig p t) then 0 else (runSig v t) 268 | 269 | --for use with non-signal values 270 | step' p t 271 | | t < p = 0 272 | | otherwise = 1 273 | 274 | step1 p v = Signal $ \t -> 275 | if (t < runSig p t) then 1 else (runSig v t) 276 | 277 | switch s e v = Signal $ \t -> 278 | if (t < runSig s t || t > runSig e t) then 0 else (runSig v t) 279 | 280 | switchT s e tm = Signal $ \t -> 281 | let s' = runSig s t 282 | e' = runSig s t 283 | tm' = runSig tm t 284 | in if (tm' < s' || tm' > e') then 0 else 1 285 | 286 | --for use with non-signal values 287 | switch' s e t 288 | | t < s || t > e = 0 289 | | otherwise = 1 290 | 291 | switch1 s e v = Signal $ \t -> 292 | if (t < runSig s t || t > runSig e t) then 1 else (runSig v t) 293 | 294 | --Simple AD envelope driven by an input t in seconds, increasing from 0 295 | --env :: Value -> Value -> Value -> Value -> Value -> Value 296 | 297 | {- 298 | env atk rel c1 c2 t 299 | 300 | 301 | 302 | -} 303 | 304 | -- need to test 305 | env atk crv1 rel crv2 t = 306 | let phase1 = mul (switchT 0 atk t) $ (t/atk)**crv1 307 | phase2 = mul (switchT atk (atk+rel) t) $ (1 - (t-atk)/rel)**crv2 308 | in phase1 + phase2 309 | 310 | -} 311 | 312 | 313 | --switch s e sig = 314 | 315 | divd x = mul (1/x) 316 | 317 | 318 | envAD atk rel crv1 crv2 phasor = Signal $ \t -> 319 | let a = runSig atk t 320 | r = runSig rel t 321 | c1 = runSig crv1 t 322 | c2 = runSig crv2 t 323 | t' = runSig phasor t 324 | v 325 | | t' > a + r = 0 326 | | t' < a = (t'/a)**c1 327 | | otherwise = (1 - (t'-a)/r)**c2 328 | in v 329 | 330 | switch0 s e phasor sig = Signal $ \t -> 331 | let t' = runSig phasor t 332 | in if (t' < s || t' > e) then 0 else runSig sig t 333 | 334 | switch1 s e phasor sig = Signal $ \t -> 335 | let t' = runSig phasor t 336 | in if (t' < s || t' > e) then 1 else runSig sig t 337 | 338 | 339 | {- 340 | envR :: Signal Value -> Signal Value -> Signal Value -> Signal Value -> Signal Value -> Signal Value 341 | envR atk rel crv1 crv2 phasor = 342 | let phase1 = mul (switchT 0 atk phasor) $ pow crv1 (phasor/atk) 343 | phase2 = mul (switchT atk (atk+rel) phasor) $ (1 - (pow crv2 (phasor-atk)/rel)) 344 | in saturate $ phase1 + phase2 345 | 346 | -} 347 | 348 | 349 | {- 350 | envlp :: (Floating a, Ord a) => Signal a -> Signal a -> Signal a -> Signal a -> Signal a -> Signal a 351 | envlp atk rel c1 c2 ph = Signal $ \t -> 352 | let t' = runSig ph t 353 | atk' = runSig atk t 354 | rel' = runSig rel t 355 | c1' = runSig c1 t 356 | c2' = runSig c2 t 357 | phase1 = mul (switch' 0 atk' t') $ ((t'/atk')**c1') 358 | phase2 = mul (switch' atk' (atk' + rel') t') $ (1 - (t'-atk')/rel')**c2' 359 | in phase1 + phase2 360 | -} 361 | 362 | 363 | 364 | 365 | {- 366 | fract v = v - (fromIntegral $ floor v) 367 | rand t = fract $ 123456.9 * sin t 368 | flor v = v - fract v 369 | -} 370 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/OSC.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.OSC where 2 | 3 | -- This module handles the OSC communication with SCLang 4 | -- and generally keeping track of IO 5 | 6 | import qualified Sound.OSC as OSC 7 | import qualified Sound.OSC.FD as FD 8 | 9 | import Data.IORef (IORef, newIORef, readIORef, writeIORef) 10 | import System.IO.Unsafe (unsafePerformIO) 11 | 12 | import Control.Concurrent 13 | import Control.Monad (void, forever, when) 14 | import Data.Maybe 15 | import Data.IORef 16 | 17 | import Sound.TimeLines.Types 18 | import Sound.TimeLines.Util 19 | import Sound.TimeLines.Globals 20 | 21 | -- set to true for OSC tracing 22 | debugMode = False 23 | 24 | makeStringMessage :: String -> [String] -> OSC.Message 25 | makeStringMessage path ss = OSC.Message path $ map OSC.string ss 26 | 27 | makeImmediateBundle :: [OSC.Message] -> OSC.Bundle 28 | makeImmediateBundle ms = OSC.Bundle OSC.immediately ms 29 | 30 | sendBundle :: OSC.Bundle -> IO () 31 | sendBundle b = FD.sendBundle globalUDPRef b 32 | 33 | -- | Takes a path and an argument (both strings) 34 | -- | and sends them to SCLang 35 | sendStringMessage :: String -> String -> IO () 36 | sendStringMessage path str = do 37 | FD.sendMessage globalUDPRef $ OSC.Message path [OSC.string str] 38 | when debugMode $ putStrLn $ "sent string message: " ++ path ++ " " ++ str 39 | 40 | sendIntMessage :: String -> Int -> IO () 41 | sendIntMessage path i = do 42 | FD.sendMessage globalUDPRef $ OSC.Message path [OSC.int32 i] 43 | when debugMode $ putStrLn $ "sent Int message: " ++ path ++ " " ++ (show i) 44 | 45 | sendTestMessage :: IO () 46 | sendTestMessage = sendStringMessage "TimeLines" "test" 47 | 48 | sendStringMessages :: String -> [String] -> IO () 49 | sendStringMessages path strs = do 50 | let m = OSC.Message path $ map OSC.string strs 51 | FD.sendMessage globalUDPRef m 52 | when debugMode $ putStrLn $ "sent string messages: " ++ path ++ " " ++ (show strs) 53 | 54 | -- | The port at which SCLang is expecting communication 55 | -- | (default = 57120) 56 | scLangPort = 57120 57 | localPort = 70000 58 | 59 | -- | Global reference of the UDP port used to 60 | -- | communicate with SCLang 61 | {-# NOINLINE globalUDPRef #-} 62 | globalUDPRef :: OSC.UDP 63 | globalUDPRef = unsafePerformIO $ OSC.openUDP "127.0.0.1" scLangPort 64 | 65 | udpServer :: (IO (), IO ()) -> IO () 66 | udpServer (aIncr, aEval) = void $ forkIO $ FD.withTransport s f 67 | where s = FD.udpServer "127.0.0.1" localPort 68 | f t = forever $ FD.recvMessage t >>= checkMessages (aIncr, aEval) 69 | 70 | checkMessages :: (IO (), IO ()) -> Maybe FD.Message -> IO () 71 | checkMessages _ (Nothing) = return () 72 | checkMessages (aIncr, aEval) (Just m) = case FD.messageAddress m of 73 | "/incrementWindow" -> aIncr 74 | "/evalSession" -> aEval 75 | _ -> print "Not matching" 76 | 77 | 78 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/Time.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.Time where 2 | -- or call it Flow? 3 | 4 | import Sound.TimeLines.OSC 5 | import Sound.TimeLines.Types 6 | import Sound.TimeLines.TimeLines 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/TimeLines.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.TimeLines where 2 | 3 | import qualified Sound.File.Sndfile as SF 4 | 5 | import Sound.TimeLines.Types 6 | import Sound.TimeLines.Util 7 | import Sound.TimeLines.OSC 8 | import Sound.TimeLines.Globals (globalSessionRef) 9 | 10 | import System.Random 11 | import Control.Concurrent (forkIO) 12 | import Control.Concurrent.Async (mapConcurrently) 13 | import System.IO.Unsafe (unsafePerformIO) 14 | import Control.Monad (void, when) 15 | --import Control.Monad.Writer (Writer, execWriter, tell) 16 | import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef') 17 | --import qualified Data.Map.Strict as Map 18 | import Numeric (showFFloat) 19 | --import Data.Global 20 | import Control.DeepSeq (force) 21 | {- INTERFACE FUNCTIONS -} 22 | 23 | 24 | -- fork session wrappers? 25 | emptyForkIO = void . forkIO 26 | 27 | -- | A session in which the window is explicit and static 28 | -- | (that window can be either looped or one-shot trigerred) 29 | finiteSession :: Window -> Collector Action -> IO () 30 | finiteSession w actions = do 31 | let newSess = Session (collectList actions) w FiniteMode 32 | evalSession newSess 33 | writeSessionRef newSess 34 | 35 | -- | A session in which time constantly and infinitely 36 | -- | increases (with the option of resetting it at any point) 37 | infiniteSession :: Collector Action -> IO () 38 | infiniteSession as = do 39 | (Session _ w prevMode) <- readSessionRef 40 | case prevMode of 41 | InfiniteMode -> writeSessionRef $ Session (collectList as) w InfiniteMode 42 | FiniteMode -> do 43 | let newWindow = (0, windowStep) 44 | newSess = Session (collectList as) newWindow InfiniteMode 45 | evalSession newSess 46 | writeSessionRef newSess 47 | 48 | -- | Interface function that groups params into Synths 49 | synth :: SynthID -> Collector ParamSignal -> Collector Action 50 | synth id params = registerSynthAction (id, collectList params) 51 | 52 | -- | Ignores a synth 53 | mute :: Collector Action -> Collector Action 54 | mute s = register EmptyAction 55 | 56 | -- TODO 57 | solo = undefined 58 | 59 | -- | Interface function that registers signals to a Synth 60 | addParam :: Param -> Signal Value -> Collector ParamSignal 61 | addParam p sig = registerParam (p, (sig, fromIntegral defaultSamplingRate)) 62 | (<><) = addParam 63 | 64 | -- | Same as above, but with user-defined sampling rate 65 | addParamSR :: (Param, SamplingRate) -> Signal Value -> Collector ParamSignal 66 | addParamSR (p, sr) sig = registerParam (p, (sig, sr)) 67 | (<><<) = addParamSR 68 | 69 | -- | Register a patch between two synths 70 | patchSynths :: SynthID -> SynthID -> Collector Action 71 | patchSynths src dst = registerPatchAction (src, dst) 72 | (><>) = patchSynths 73 | 74 | ------------ 75 | {- UPDATE LOOP -} 76 | -- | OSC receiving server 77 | setupOSC :: IO () 78 | setupOSC = udpServer (incrementAndEvalIfInfinite, evalCurrSession) 79 | 80 | incrementAndEvalIfInfinite :: IO () 81 | incrementAndEvalIfInfinite = do 82 | sess <- readSessionRef 83 | when (isInfiniteSession sess) $ do 84 | let newSess = incrementWindowBy windowStep sess 85 | writeSessionRef newSess 86 | evalSession newSess 87 | 88 | isInfiniteSession :: Session -> Bool 89 | isInfiniteSession (Session _ _ m) = m == InfiniteMode 90 | 91 | isFiniteSession :: Session -> Bool 92 | isFiniteSession = not . isInfiniteSession 93 | 94 | readSessionRef :: IO Session 95 | readSessionRef = readIORef globalSessionRef 96 | 97 | writeSessionRef :: Session -> IO () 98 | writeSessionRef s = modifyIORef' globalSessionRef $ \_ -> force s 99 | 100 | -- | Fixed increment by which the window increases in an infinite session 101 | windowStep :: Time 102 | windowStep = 0.5 103 | 104 | incrementWindowBy :: Time -> Session -> Session 105 | incrementWindowBy amt (Session as (s, e) m) = 106 | Session as (s+amt, e+amt) m 107 | 108 | reset :: IO () 109 | reset = do 110 | sendStringMessage "/TimeLines/resetSession" "" 111 | writeSessionRef defaultSession 112 | print "Server reset" 113 | 114 | 115 | ------------ 116 | {- Eval functions -} 117 | 118 | -- | Evaluate all actions in the current Session 119 | -- | and update the server 120 | evalSession :: Session -> IO () 121 | evalSession sess@(Session as w m) = do 122 | let synthNames = synthIDList sess 123 | synthsWithID = synthList sess 124 | patches = patchList sess 125 | -- Send session mode, followed by synth names 126 | sendStringMessages "/TimeLines/setSession" $ [show m] ++ synthNames 127 | sendStringMessage "/TimeLines/setWindowDur" $ show $ windowDur w 128 | -- Write all buffers to disk and get a list of lists of paths 129 | listsOfPaths <- mapConcurrently (evalSynthWithID w) synthsWithID 130 | -- Send all filepaths to be loaded 131 | mapM_ (sendStringMessages "/TimeLines/loadSynthBuffers") listsOfPaths 132 | -- Set the order of synth execution (relevant for patches) 133 | sendStringMessages "/TimeLines/setSynthOrder" $ sortPatches patches 134 | -- Send patches that should be performed 135 | sendStringMessages "/TimeLines/setPatches" $ flattenPatches patches 136 | sendIntMessage "/TimeLines/setMute" 0 137 | 138 | showWindowStep :: String 139 | showWindowStep = Numeric.showFFloat Nothing windowStep "" 140 | 141 | evalCurrSession :: IO () 142 | evalCurrSession = readIORef globalSessionRef >>= evalSession 143 | 144 | sendWindow :: Window -> IO () 145 | sendWindow (s, e) = sendStringMessage "/TimeLines/setWindowDur" $ show $ e - s 146 | 147 | -- | Write a synth's signal buffers, return all filepaths 148 | evalSynthWithID :: Window -> SynthWithID -> IO [FilePath] 149 | evalSynthWithID w (synthID, synth) = do 150 | mapConcurrently (writeParam synthID w) synth 151 | 152 | getRandDistinguisher :: IO String 153 | getRandDistinguisher = do 154 | g <- newStdGen 155 | return $ concat $ map show $ take 10 (randomRs (0::Int, 9) g) 156 | 157 | -- TODO: clean up 158 | -- | Takes a param and a signal, evaluates it over the current window 159 | -- | writes it to a file, and returns its filepath 160 | writeParam :: SynthID -> Window -> ParamSignal -> IO FilePath 161 | writeParam synthID w pSig@(p, (sig, sr)) = do 162 | randDistinguisher <- getRandDistinguisher 163 | let filePath = pathToTemp ++ synthID ++ "_" ++ p ++ "_" ++ randDistinguisher ++ ".w64" 164 | ftl = FTL pSig w 165 | _ <- removeFileIfExists filePath 166 | h <- openHandle filePath ftl 167 | arrayPtr <- getArrayPtr ftl 168 | framesWritten <- SF.hPutBuf h arrayPtr $ ftlNumSteps ftl 169 | closeHandle h 170 | return filePath 171 | 172 | replaceActions :: [Action] -> Session -> Session 173 | replaceActions newActions (Session _ w m) = Session newActions w m 174 | 175 | sendLoadSynthBuffers :: [Param] -> IO () 176 | sendLoadSynthBuffers filepaths = sendStringMessages "/TimeLines/load" filepaths 177 | 178 | --sendLoadAllSynths :: [(SynthID, )] 179 | {- PRINT FUNCTIONS -} 180 | 181 | printNumSynths :: IO () 182 | printNumSynths = do 183 | sess <- readIORef globalSessionRef 184 | putStrLn $ (++) "Number of running synths: " $ show $ length $ synthList sess 185 | 186 | printSynths :: IO () 187 | printSynths = do 188 | sess <- readIORef globalSessionRef 189 | putStrLn $ "Running synths:" ++ (show $ synthIDList sess) 190 | 191 | -- TODO: test 192 | printPatches :: [Patch] -> IO () 193 | printPatches = 194 | print . map (\(s1, s2) -> show $ s1 ++ "->>" ++ s2 ++ " ") 195 | 196 | printWindow :: IO () 197 | printWindow = do 198 | (Session _ w _) <- readIORef globalSessionRef 199 | putStrLn $ (++) "Current window: " $ show w 200 | 201 | printMode :: IO () 202 | printMode = do 203 | (Session _ _ m) <- readIORef globalSessionRef 204 | putStrLn $ (++) "Current mode: " $ show m 205 | 206 | pathToTemp :: FilePath 207 | pathToTemp = unsafePerformIO getTLTempDir 208 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module Sound.TimeLines.Types where 3 | 4 | import Control.Applicative 5 | import Control.Monad 6 | import Control.Monad.Writer 7 | import Data.List 8 | import qualified Data.Set as Set 9 | 10 | import Control.DeepSeq 11 | import GHC.Generics 12 | 13 | --import qualified Data.Map.Strict as Map 14 | 15 | -- | The type actually written to files 16 | -- | (default = Double) 17 | type Value = Double 18 | 19 | -- | The type passed to Signals 20 | type Time = Double 21 | 22 | -- | A section of time between start and end points 23 | type Window = (Time, Time) 24 | 25 | windowDur :: Window -> Time 26 | windowDur (s, e) = e - s 27 | 28 | -- | The rate at which a Signal is to be sampled 29 | type SamplingRate = Int 30 | 31 | {- ? 32 | type Scale = [Value] --> used as "Signal Scale" 33 | type Chord = [Value] --> used as "Signal Chord" 34 | type ChordProg = [Chord] 35 | -} 36 | 37 | type Scale = [Signal Value] 38 | type Chord = [Signal Value] 39 | type ChordProg = [Chord] 40 | 41 | -- | The name of a synth as stored on the server (including SynthDef) 42 | type SynthID = String 43 | 44 | type SynthGroup = String 45 | 46 | -- | The name of a SynthDef's parameter 47 | type Param = String 48 | 49 | -- | The fundamental type of TimeLines. A Signal of 50 | -- | type "a" is a function from Time to "a" 51 | newtype Signal a = Signal {runSig :: Time -> a} 52 | deriving Generic 53 | 54 | 55 | -- | A parameter name and the signal to control it 56 | type ControlSignal = (Signal Value, SamplingRate) 57 | 58 | -- | A combination of a Control Signal and a Parameter to control 59 | type ParamSignal = (Param, ControlSignal) 60 | 61 | -- | A list of Param & Signal pairs 62 | type Synth = [ParamSignal] 63 | 64 | -- | A SynthID & Synth pair 65 | type SynthWithID = (SynthID, Synth) 66 | 67 | -- | A pair of Synths (Output, Input) 68 | type Patch = (SynthID, SynthID) 69 | 70 | -- | An Action can either be a Synth or a Path 71 | data Action = ActionSynth SynthWithID 72 | | ActionPatch Patch 73 | | EmptyAction 74 | deriving Generic 75 | 76 | -- | A Collection of objects to be registered along the way 77 | type Collector a = Writer [a] () 78 | 79 | -- | Finite: Window is static and set by user, with optional looping. 80 | -- | Infinite: Window is constantly and infinitely increasing in fixed 81 | -- | increments, with optional resetting. 82 | data SessionMode = FiniteMode | InfiniteMode 83 | deriving (Eq, Show, Generic) 84 | 85 | 86 | -- | A list of Actions, a Window, and a Mode 87 | data Session = Session {actions::[Action], 88 | sessionWindow::Window, 89 | sessionMode::SessionMode 90 | } 91 | deriving Generic 92 | 93 | 94 | -- | Everything needed to write a Param control buffer 95 | data FiniteTimeLine = FTL {ftlParamSig::ParamSignal, 96 | ftlWindow::Window 97 | } 98 | 99 | 100 | -- NFData instances 101 | instance NFData Session where 102 | instance NFData SessionMode 103 | instance NFData Action 104 | instance (NFData a) => NFData (Signal a) 105 | 106 | 107 | -- Defaults -- 108 | defaultSamplingRate = 700 109 | 110 | defaultSession :: Session 111 | defaultSession = Session [] (0, 1) FiniteMode 112 | 113 | defaultSignal :: Signal Value 114 | defaultSignal = Signal (\t -> 0) 115 | 116 | 117 | -- Action Functions -- 118 | isSynth :: Action -> Bool 119 | isSynth (ActionSynth _) = True 120 | isSynth _ = False 121 | 122 | toSynth :: Action -> SynthWithID 123 | toSynth (ActionSynth s) = s 124 | toSynth _ = undefined 125 | 126 | isPatch :: Action -> Bool 127 | isPatch (ActionPatch _) = True 128 | isPatch _ = False 129 | 130 | toPatch :: Action -> Patch 131 | toPatch (ActionPatch p) = p 132 | toPatch _ = undefined 133 | 134 | 135 | -- Session Functions -- 136 | synthList :: Session -> [SynthWithID] 137 | synthList = map toSynth . filter isSynth . actions 138 | 139 | patchList :: Session -> [Patch] 140 | patchList = map toPatch . filter isPatch . actions 141 | 142 | --patchList' sess = (patchList sess) ++ [(s, "mainOut") | s <- unPatchedSynths sess] 143 | 144 | --unPatchedSynths :: Session -> [SynthID] 145 | --unPatchedSynths sess = synthIDList sess \\ patchedSynths sess 146 | 147 | --patchedSynths sess = removeDups [src | (src, dst) <- patchList' sess] 148 | 149 | removeDups :: Ord a => [a] -> [a] 150 | removeDups = Set.toList . Set.fromList 151 | 152 | synthIDList :: Session -> [SynthID] 153 | synthIDList = map fst . synthList 154 | 155 | -- FiniteTimeLine functions -- 156 | ftlSR :: FiniteTimeLine -> SamplingRate 157 | ftlSR (FTL (_, (_, sr)) _) = sr 158 | 159 | 160 | -- Signal Functions -- 161 | 162 | -- | The identity Signal, always returns the current time 163 | t :: Signal Value 164 | t = Signal $ \t -> t 165 | 166 | -- | Raises any argument to a constant signal of itself 167 | constSig :: a -> Signal a 168 | constSig v = Signal $ \t -> v 169 | 170 | 171 | -- Collector Functions -- 172 | collectList :: Collector a -> [a] 173 | collectList = execWriter 174 | 175 | register :: a -> Collector a 176 | register a = tell [a] 177 | 178 | registerEmptyAction :: Collector Action 179 | registerEmptyAction = register EmptyAction 180 | 181 | registerSynthAction :: SynthWithID -> Collector Action 182 | registerSynthAction = register . ActionSynth 183 | 184 | registerPatchAction :: Patch -> Collector Action 185 | registerPatchAction = register . ActionPatch 186 | 187 | registerParam :: ParamSignal -> Collector ParamSignal 188 | registerParam = register 189 | 190 | ---------------------------INSTANCES--------------------------- 191 | -- FUNCTOR 192 | instance Functor Signal where 193 | fmap f (Signal sf) = Signal $ fmap f sf 194 | --Alternate implementation: 195 | --fmap f (Signal sf) = Signal $ \t -> f (sf t) 196 | (<$) = fmap . const 197 | 198 | -- APPLICATIVE 199 | instance Applicative Signal where 200 | -- Transform a value "a" to a signal of constant value "a" 201 | pure = constSig 202 | liftA2 f s1 s2 = Signal $ \t -> f (runSig s1 t) (runSig s2 t) 203 | sf <*> s = Signal $ \t -> (runSig sf t) (runSig s t) 204 | -- A signal with function "f" of type "Time -> (a -> b)", applied at Time "t" to 205 | -- a signal with function "x" of type "Time -> b", is equal to the value of f for 206 | -- Time t, applied to the value of x for Time t 207 | 208 | -- MONAD 209 | instance Monad Signal where 210 | return = pure 211 | (Signal s) >>= f = Signal $ \t -> let firstResult = s t 212 | sigB = f firstResult 213 | in runSig sigB t 214 | 215 | -- | Lazy multiplicator, doesn't evauate the second 216 | -- | term if first term is equal to 0 217 | lazyMul :: (Num a, Eq a) => a -> a -> a 218 | lazyMul 0 _ = 0 219 | lazyMul a b = a * b 220 | 221 | -- NUM 222 | instance (Num a, Eq a) => Num (Signal a) where 223 | negate = fmap negate 224 | (+) = liftA2 (+) 225 | (*) = liftA2 lazyMul -- lazy multiplicator 226 | fromInteger = pure . fromInteger 227 | abs = fmap abs 228 | signum = fmap signum 229 | 230 | 231 | -- FRACTIONAL 232 | instance (Fractional a, Eq a) => Fractional (Signal a) where 233 | fromRational = pure . fromRational 234 | recip = fmap recip 235 | 236 | -- FLOATING 237 | instance (Floating a, Eq a) => Floating (Signal a) where 238 | pi = pure pi 239 | sqrt = fmap sqrt 240 | exp = fmap exp 241 | log = fmap log 242 | sin = fmap sin 243 | cos = fmap cos 244 | asin = fmap asin 245 | atan = fmap atan 246 | acos = fmap acos 247 | sinh = fmap sinh 248 | cosh = fmap cosh 249 | asinh = fmap asinh 250 | atanh = fmap atanh 251 | acosh = fmap acosh 252 | 253 | -------------------------------------------------------------------------------- /src/Sound/TimeLines/Util.hs: -------------------------------------------------------------------------------- 1 | module Sound.TimeLines.Util where 2 | 3 | import Data.List 4 | import Data.Maybe 5 | 6 | import Data.Array 7 | import qualified Data.Graph as Graph 8 | import qualified Data.Set as Set 9 | 10 | import Prelude 11 | import System.Directory 12 | import Control.Exception 13 | import System.IO.Error 14 | import System.Directory as DIR 15 | import System.FilePath 16 | 17 | import Foreign.Marshal.Array as MA 18 | import Foreign.Ptr 19 | import Foreign.ForeignPtr as FP 20 | import qualified Sound.File.Sndfile as SF 21 | import Prelude as Pr 22 | 23 | import Data.Fixed 24 | import qualified Data.Map as Map 25 | import Sound.TimeLines.Types 26 | 27 | replaceSessionWindow :: Window -> Session -> Session 28 | replaceSessionWindow newWindow (Session as _ m) = Session as newWindow m 29 | 30 | {- SYNTH PATCHES -} 31 | 32 | data PatchGraph = PatchGraph {graphVertices::[String], 33 | graphEdges::[(String, String)] 34 | } 35 | 36 | testPatchOrder :: [SynthID] -> [Patch] -> Bool 37 | testPatchOrder order = all (\(s1, s2) -> 38 | (findIdx s1 order) < (findIdx s2 order)) 39 | 40 | findIdx :: Eq a => a -> [a] -> Int 41 | findIdx i is = fromJust $ elemIndex i is 42 | 43 | patchNodes :: [Patch] -> [(Graph.Vertex, SynthID)] 44 | patchNodes ps = zip [0..] $ nameSetList ps 45 | 46 | nameSetList :: [Patch] -> [SynthID] 47 | nameSetList = Set.toList . Set.fromList . (concatMap tuppleToList) 48 | 49 | patchEdges :: [Patch] -> [(Graph.Vertex, [Graph.Vertex])] 50 | patchEdges ps = zip [0..] $ map (findEdges ps) $ nameSetList ps 51 | 52 | findEdges :: [Patch] -> SynthID -> [Graph.Vertex] 53 | findEdges [] _ = [] 54 | findEdges ps s = [synthIdToVertex ps dest | (src, dest) <- ps, src == s] 55 | 56 | synthIdToVertex :: [Patch] -> SynthID -> Graph.Vertex 57 | synthIdToVertex ps id = findIdx id $ nameSetList ps 58 | 59 | graphFromPatches :: [Patch] -> Graph.Graph 60 | graphFromPatches ps = array (0, n - 1) $ patchEdges ps 61 | where n = length $ nameSetList ps 62 | 63 | sortPatches :: [Patch] -> [SynthID] 64 | sortPatches [] = [] 65 | sortPatches ps = [(nameSetList ps)!!i | i <- Graph.topSort $ graphFromPatches ps] 66 | 67 | flattenPatches :: [Patch] -> [SynthID] 68 | flattenPatches [] = [] 69 | flattenPatches ((s1, s2):ps) = [s1, s2] ++ flattenPatches ps 70 | 71 | {- /SYNTH PATCHES -} 72 | 73 | 74 | -- | Returns a list going from start to end in number of steps 75 | fromToIn :: (Fractional a, Enum a) => a -> a -> Int -> [a] 76 | fromToIn lo hi steps = [lo, lo+step .. hi] 77 | where 78 | range = hi - lo 79 | step = range / (fromIntegral steps) 80 | 81 | -- | Calculates the duration, in seconds, of a TLinfo 82 | ftlDur :: FiniteTimeLine -> Time 83 | ftlDur (FTL _ (s, e)) = e - s 84 | 85 | getTimeDomain :: FiniteTimeLine -> [Time] 86 | getTimeDomain ftl@(FTL _ (s, e)) = fromToIn s e $ ftlNumSteps ftl 87 | 88 | ftlNumSteps :: FiniteTimeLine -> Int 89 | ftlNumSteps ftl = Pr.floor $ ftlDur ftl * fromIntegral (ftlSR ftl) 90 | 91 | -- | Samples the TimeLine according to its info, returns a list of values 92 | getVals :: FiniteTimeLine -> [Value] 93 | getVals ftl@(FTL (_, (sig, _)) _) = map f $ getTimeDomain ftl 94 | where f = runSig sig 95 | 96 | --user ehird, https://stackoverflow.com/questions/8502201/remove-file-if-it-exists#8502391 97 | -- | Deletes a file if it already exists 98 | removeFileIfExists :: FilePath -> IO () 99 | removeFileIfExists fileName = removeFile fileName `catch` handleExists 100 | where handleExists e 101 | | isDoesNotExistError e = return () 102 | | otherwise = throwIO e 103 | 104 | -- | Returns the temp directory on the current OS 105 | getTLTempDir :: IO FilePath 106 | getTLTempDir = do 107 | osTemp <- DIR.getTemporaryDirectory 108 | let tlTemp = addTrailingPathSeparator $ joinPath [osTemp, "TimeLines", "buffers"] 109 | DIR.createDirectoryIfMissing True tlTemp 110 | return tlTemp 111 | 112 | -- | Takes a TLinfo and returns the ReadWrite handle to a file 113 | openHandle :: FilePath -> FiniteTimeLine -> IO SF.Handle 114 | openHandle path ftl = SF.openFile path SF.ReadWriteMode info 115 | where format = SF.Format SF.HeaderFormatW64 SF.SampleFormatDouble SF.EndianFile 116 | info = SF.Info (ftlNumSteps ftl) (ftlSR ftl) 1 format 1 True 117 | 118 | -- | Samples a constant sig for t = 0 119 | constSigToValue :: Signal a -> a 120 | constSigToValue sig = runSig sig 0 121 | 122 | -- | Closes a handle 123 | closeHandle :: SF.Handle -> IO() 124 | closeHandle = SF.hClose 125 | 126 | -- | Takes a TimeLine and returns a Pointer to an array of its values 127 | getArrayPtr :: FiniteTimeLine -> IO (Ptr Value) 128 | getArrayPtr ftl = MA.newArray $ getVals ftl 129 | 130 | 131 | {- GENERAL PURPOSE -} 132 | tuppleToList :: (a, a) -> [a] 133 | tuppleToList (x, y) = [x, y] 134 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-14.6 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # - location: 29 | # git: https://github.com/commercialhaskell/stack.git 30 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 31 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 32 | # subdirs: 33 | # - auto-update 34 | # - wai 35 | packages: 36 | - . 37 | # Dependency packages to be pulled from upstream that are not in the resolver 38 | # using the same syntax as the packages field. 39 | # (e.g., acme-missiles-0.3) 40 | extra-deps: [ 41 | hsndfile-0.8.0 42 | ] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.9" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | --------------------------------------------------------------------------------