module Sound.SC3.UGen.Envelope.Construct where
import Sound.SC3.UGen.Bindings
import Sound.SC3.UGen.Math
import Sound.SC3.UGen.Enum
import Sound.SC3.UGen.Envelope
import Sound.SC3.UGen.Rate
import Sound.SC3.UGen.Type
import Sound.SC3.UGen.UGen
envCoord :: Num a => [(a,a)] -> a -> a -> Envelope_Curve a -> Envelope a
envCoord bp dur amp c =
let l = map ((* amp) . snd) bp
t = map (* dur) (tail (d_dx (map fst bp)))
in Envelope l t [c] Nothing Nothing
envTrapezoid :: (Num a,OrdE a) => a -> a -> a -> a -> Envelope a
envTrapezoid shape skew dur amp =
let x1 = skew * (1 shape)
bp = [(0,skew <=* 0)
,(x1,1)
,(shape + x1,1)
,(1,skew >=* 1)]
in envCoord bp dur amp EnvLin
envPerc' :: Num a => a -> a -> a -> Envelope_Curve2 a -> Envelope a
envPerc' atk rls lvl (c0,c1) =
let c = [c0,c1]
in Envelope [0,lvl,0] [atk,rls] c Nothing Nothing
envPerc :: Num a => a -> a -> Envelope a
envPerc atk rls =
let cn = EnvNum (4)
in envPerc' atk rls 1 (cn,cn)
envTriangle :: (Num a,Fractional a) => a -> a -> Envelope a
envTriangle dur lvl =
let c = replicate 2 EnvLin
d = replicate 2 (dur / 2)
in Envelope [0,lvl,0] d c Nothing Nothing
envSine :: (Num a,Fractional a) => a -> a -> Envelope a
envSine dur lvl =
let c = replicate 2 EnvSin
d = replicate 2 (dur / 2)
in Envelope [0,lvl,0] d c Nothing Nothing
data LINEN a = LINEN {linen_attackTime :: a
,linen_sustainTime :: a
,linen_releaseTime :: a
,linen_level :: a
,linen_curve :: Envelope_Curve3 a}
envLinen_r :: Num a => LINEN a -> Envelope a
envLinen_r (LINEN aT sT rT lv (c0,c1,c2)) =
let l = [0,lv,lv,0]
t = [aT,sT,rT]
c = [c0,c1,c2]
in Envelope l t c Nothing Nothing
envLinen' :: Num a => a -> a -> a -> a -> Envelope_Curve3 a -> Envelope a
envLinen' aT sT rT lv c = envLinen_r (LINEN aT sT rT lv c)
envLinen :: Num a => a -> a -> a -> a -> Envelope a
envLinen aT sT rT l =
let c = (EnvLin,EnvLin,EnvLin)
in envLinen' aT sT rT l c
data ADSR a = ADSR {adsr_attackTime :: a
,adsr_decayTime :: a
,adsr_sustainLevel :: a
,adsr_releaseTime :: a
,adsr_peakLevel :: a
,adsr_curve :: Envelope_Curve3 a
,adsr_bias :: a}
adsrDefault :: Fractional n => ADSR n
adsrDefault =
let c = EnvNum (4)
in ADSR 0.01 0.3 0.5 1 1 (c,c,c) 0
envADSR :: Num a => a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a
envADSR aT dT sL rT pL c b = envADSR_r (ADSR aT dT sL rT pL (c,c,c) b)
envADSR_r :: Num a => ADSR a -> Envelope a
envADSR_r (ADSR aT dT sL rT pL (c0,c1,c2) b) =
let l = map (+ b) [0,pL,pL*sL,0]
t = [aT,dT,rT]
c = [c0,c1,c2]
in Envelope l t c (Just 2) Nothing
data ADSSR a = ADSSR {adssr_attackTime :: a
,adssr_attackLevel :: a
,adssr_decayTime :: a
,adssr_decayLevel :: a
,adssr_slopeTime :: a
,adssr_sustainLevel :: a
,adssr_releaseTime :: a
,adssr_curve :: Envelope_Curve4 a
,adssr_bias :: a}
envADSSR :: Num a => a -> a -> a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a
envADSSR t1 l1 t2 l2 t3 l3 t4 c b = envADSSR_r (ADSSR t1 l1 t2 l2 t3 l3 t4 (c,c,c,c) b)
envADSSR_r :: Num a => ADSSR a -> Envelope a
envADSSR_r (ADSSR t1 l1 t2 l2 t3 l3 t4 (c1,c2,c3,c4) b) =
let l = map (+ b) [0,l1,l2,l3,0]
t = [t1,t2,t3,t4]
c = [c1,c2,c3,c4]
in Envelope l t c (Just 3) Nothing
data ASR a = ASR {asr_attackTime :: a
,asr_sustainLevel :: a
,asr_releaseTime :: a
,asr_curve :: Envelope_Curve2 a}
envASR :: Num a => a -> a -> a -> Envelope_Curve a -> Envelope a
envASR aT sL rT c = envASR_r (ASR aT sL rT (c,c))
envASR_r :: Num a => ASR a -> Envelope a
envASR_r (ASR aT sL rT (c0,c1)) =
let l = [0,sL,0]
t = [aT,rT]
c' = [c0,c1]
in Envelope l t c' (Just 1) Nothing
envStep :: [a] -> [a] -> Maybe Int -> Maybe Int -> Envelope a
envStep levels times releaseNode loopNode =
if length levels /= length times
then error ("envStep: levels and times must have same size")
else let levels' = head levels : levels
in Envelope levels' times [EnvStep] releaseNode loopNode
envGate :: UGen -> UGen -> UGen -> DoneAction -> Envelope_Curve UGen -> UGen
envGate level gate_ fadeTime doneAction curve =
let startVal = fadeTime <=* 0
e = Envelope [startVal,1,0] [1,1] [curve] (Just 1) Nothing
in envGen KR gate_ level 0 fadeTime doneAction e
envGate' :: UGen
envGate' =
let level = 1
gate_ = meta_control KR "gate" 1 (0,1,"lin",1,"")
fadeTime = meta_control KR "fadeTime" 0.02 (0,10,"lin",0,"s")
doneAction = RemoveSynth
curve = EnvSin
in envGate level gate_ fadeTime doneAction curve