vivid-0.1.0.1: Sound synthesis with SuperCollider

Safe HaskellNone
LanguageHaskell98
Extensions
  • OverloadedStrings
  • LambdaCase

Vivid.SynthDef

Contents

Description

Synth Definitions in SuperCollider are how you define the way synths should sound -- you describe parameters and a graph of sound generators, add them to the server with defineSD, and then create instances of the Synth Definition (called "synths"), which each play separately. You can set parameters of the synth at any time while they're playing

Usually, you shouldn't be making SynthDefs explicitly -- there's a state monad SDState which lets you construct synthdefs like so:

  test :: SynthDef
  test = sdNamed "testSynthDef" [("note", 0)] $ do
     s <- 0.1 ~* sinOsc (Freq $ midiCPS "note")
     out 0 [s, s]
  

You then optionally explicitly send the synth definition to the SC server with

>>> defineSD test

You then create a synth from the synthdef like:

>>> s <- synth "testSynthDef" [("note", 45)]

Or, alternately:

>>> s <- synth test [("note", 45)]

This returns a NodeId which is a reference to the synth, which you can use to e.g. change the params of the running synth with e.g.

>>> set s [("note", 38)]

Then you can free it (stop its playing) with

>>> free s

Synopsis

Synth actions

synth :: HasSynthRef a => a -> [(String, Float)] -> IO NodeId Source

Create a real live music-playing synth from a boring, dead SynthDef.

If you haven't defined the SynthDef on the server, this will do it automatically (Note that this may cause jitters in musical timing)

Uses HasSynthRef so that given...

>>> let foo = sdNamed "foo" [] $ out 0 [0.1 ~* whiteNoise]

...you can create a synth either with...

>>> synth "foo" []

...or...

>>> synth foo []

Careful!: The SC server doesn't keep track of your nodes for you, so if you do something like...

>>> s <- synth "someSynth" []
>>> s <- synth "oops" []           -- 's' is overwritten

...you've got no way to refer to the first synth you've created, and if you want to stop it you have to cmdPeriod

set :: NodeId -> [(String, Float)] -> IO () Source

Set the given parameters of a running synth

e.g.

>>> let setTest = sd [("pan", 0.5)] $ out 0 =<< pan2 (In $ 0.1 ~* whiteNoise) (Pos "pan")
>>> s <- synth setTest []
>>> set s [("pan", -0.5)]

Any parameters not referred to will be unaffected, and any you specify that don't exist will be (silently) ignored

free :: NodeId -> IO () Source

Immediately stop a synth playing

This can create a "clipping" artifact if the sound goes from a high amplitude to 0 in an instant -- you can avoid that with e.g. lag

Synth Definition Construction

data SynthDef Source

Internal representation of Synth Definitions. Usually, use sd instead of making these by hand.

This representation (especially _sdUGens) might change in the future.

Constructors

SynthDef 

Instances

Show SynthDef 
Hashable SynthDef

This is the hash of the UGen graph and params, but not the name! So (re)naming a SynthDef will not change its hash.

HasSynthRef SynthDef 
ToSigM (SDState Signal) 

data UGen Source

Representation of Unit Generators. You usually won't be creating these by hand, but instead using things from the library in UGens

Instances

addMonoUGen :: UGen -> SDState Signal Source

Add a unit generator with one output

addPolyUGen :: UGen -> SDState [Signal] Source

Polyphonic -- returns a list of Signals. In the future this might be a tuple instead of a list

class ToSig s where Source

Methods

toSig :: s -> Signal Source

Instances

ToSig String 
(Num a, Real a) => ToSig a

For Constant (Float) values

ToSig Signal 

class ToSigM s where Source

Methods

toSigM :: s -> SDState Signal Source

Instances

defineSD :: SynthDef -> IO () Source

Send a synth definition to be loaded on the SC server

Note that this is sort of optional -- if you don't call it, it'll be called the first time you call synth with the SynthDef

sd :: [(String, Float)] -> SDState x -> SynthDef Source

Define a Synth Definition

sdNamed :: String -> [(String, Float)] -> SDState x -> SynthDef Source

Define a Synth Definition and give it a name you can refer to from e.g. sclang

(?) :: SDState Signal -> CalculationRate -> SDState Signal Source

Set the calculation rate of a UGen

e.g.

play $ do
   s0 <- 1 ~+ (lfSaw (Freq 1) ? KR)
   s1 <- 0.1 ~* lfSaw (Freq $ 220 ~* s0)
   out 0 [s1, s1]

Mnemonic: "?" is like thinking

In the future, the representation of calculation rates definitely may change

play :: SDState a -> IO NodeId Source

Given a UGen graph, just start playing it right away.

e.g.

play $ do
   s <- 0.2 ~* lpf (In whiteNoise) (Freq 440)
   out 0 [s, s]

cmdPeriod :: IO () Source

Your "emergency" button. Run this and everything playing on the SC server will be freed -- silence!

Corresponds to the cmd-. / ctrl-. key command in the SuperCollider IDE

class HasSynthRef a Source

Minimal complete definition

getSynthRef

execState

Arguments

:: State s a

state-passing computation to execute

-> s

initial value

-> s

final state

Evaluate a state computation with the given initial state and return the final state, discarding the final value.

Built-in Unit Generator Operations

data UnaryOp Source

Unary signal operations. Many of these have functions so you don't need to use this internal representation (e.g. Neg has neg, etc).

This type might not be exposed in the future.

data BinaryOp Source

Binary signal operations. For the simple ones (like Add, Mul, etc.), there are functions (like ~+, ~*, etc.) that wrap them up so you don't have to make a ugen for them yourself.

In the future these may not be exported -- we'll just have functions for all of them.

Constructors

Add 
Sub 
Mul 
IDiv

Integer division

FDiv

Float division

Mod 
Eq 
Ne 
Lt 
Gt 
Le 
Ge 
Min 
Max 
BitAnd 
BitOr 
BitXor 
Lcm 
Gcd 
Round 
RoundUp 
Trunc 
Atan2 
Hypot 
Hypotx 
Pow 
ShiftLeft 
ShiftRight 
UnsignedShift 
Fill 
Ring1

a * (b + 1) == a * b + a

Ring2

a * b + a + b

Ring3

a * a * b

Ring4

a * a * b - a * b * b

DifSqr

a * a - b * b

SumSqr

a * a + b * b

SqrSum

(a + b) ^ 2

SqrDif

(a - b) ^ 2

AbsDif

abs(a - b)

Thresh 
AMClip 
ScaleNeg 
Clip2 
Excess 
Fold2 
Wrap2 
FirstArg 
RandRange 
ExpRandRange 
NumBinarySelectors