module Vivid.UGens.Envelopes (
adsrGen
, envGate
, envGen
, envGen_wGate
, line
, linen
, percGen
, xLine
) where
import Vivid.Envelopes
import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SynthDef
import Vivid.SynthDef.FromUA
import Vivid.UGens.Args
import Vivid.UGens.Algebraic
import GHC.TypeLits
import Data.Monoid
import Data.Proxy
adsrGen :: (Args '[] '["peakLevel", "bias", "gate", "doneAction"] as, ToSig attackTime (SDBodyArgs as), ToSig decayTime (SDBodyArgs as), ToSig sustainLevel (SDBodyArgs as), ToSig releaseTime (SDBodyArgs as)) => attackTime -> decayTime -> sustainLevel -> releaseTime -> EnvCurve -> as -> SDBody as Signal
adsrGen attackTime decayTime sustainLevel releaseTime curve userArgs = do
attackTime' <- toSig attackTime
decayTime' <- toSig decayTime
sustainLevel' <- toSig sustainLevel
releaseTime' <- toSig releaseTime
peakLevel <- uaArgValWDefault (1::Float) userArgs (Proxy::Proxy "peakLevel")
bias <- uaArgValWDefault (0::Float) userArgs (Proxy::Proxy "bias")
doneAction <- uaArgValWDefault (0::Float) userArgs (Proxy::Proxy "doneAction")
gate <- uaArgValWDefault (1::Float) userArgs (Proxy::Proxy "gate")
peakXSustain <- peakLevel ~* sustainLevel'
let plusBias :: (Signal, Signal) -> SDBody' a (Signal, Signal)
plusBias (a, b) = do
a' <- bias ~+ a
return (a', b)
biasPlusCurveSegs <- mapM plusBias [
(peakLevel, attackTime')
, (peakXSustain, decayTime')
, (Constant 0, releaseTime')
]
signals <- envLiterallyToSignals $ EnvLiterally {
_envLiterally_initialVal = bias
, _envLiterally_releaseNode = Just 2
, _envLiterally_offset = 0
, _envLiterally_loopNode = Nothing
, _envLiterally_curveSegments =
map (\(a,b)->EnvSegment a b curve) biasPlusCurveSegs
}
addUGen $ UGen (UGName_S "EnvGen") AR ([
gate
, Constant 1
, Constant 0
, Constant 1
, doneAction
] <> signals) 1
envGate :: Subset '["gate","fadeSecs"] a => SDBody' a Signal
envGate = do
gate <- biOp Le (V::V "fadeSecs") (0::Float)
let theEnv = EnvLiterally {
_envLiterally_initialVal = gate
, _envLiterally_releaseNode = Just 1
, _envLiterally_offset = 0
, _envLiterally_loopNode = Nothing
, _envLiterally_curveSegments = [
EnvSegment (Constant 1) (Constant 1) Curve_Sin
, EnvSegment (Constant 0) (Constant 1) Curve_Sin
]
}
envGen_wGate (V::V "gate") (V::V "fadeSecs") theEnv FreeEnclosing
envGen :: EnvLiterally a -> DoneAction -> SDBody' a Signal
envGen theEnv doneAction = do
curveSignals <- envLiterallyToSignals theEnv
addUGen $ UGen (UGName_S "EnvGen") AR ([
Constant 1
, Constant 1
, Constant 0
, Constant 1
, Constant $ doneActionNum doneAction
] <> curveSignals) 1
envGen_wGate :: (ToSig gate a, ToSig timeScale a) => gate -> timeScale -> EnvLiterally a -> DoneAction -> SDBody' a Signal
envGen_wGate gate timeScale theEnv doneAction = do
gate' <- toSig gate
timeScale' <- toSig timeScale
curveSignals <- envLiterallyToSignals theEnv
addUGen $ UGen (UGName_S "EnvGen") AR ([
gate'
, Constant 1
, Constant 0
, timeScale'
, Constant $ doneActionNum doneAction
] <> curveSignals) 1
line :: (Args '[] '["start","end","duration","doneAction"] a) => a -> SDBody a Signal
line = makeUGen
"Line" AR
(Vs::Vs '["start","end","duration","doneAction"])
(start_ (0::Float), end_ (0::Float), duration_ (1::Float), doneAction_ (0::Float))
linen :: (Args '[] '["gate", "attackSecs", "susLevel", "releaseSecs", "doneAction"] a) => a -> SDBody a Signal
linen = makeUGen
"Linen" KR
(Vs::Vs '["gate", "attackSecs", "susLevel", "releaseSecs", "doneAction"])
(gate_ (1::Float), attackTime_ (0.01::Float), susLevel_ (1::Float), releaseTime_ (1::Float), doneAction_ (0::Float))
percGen :: (Args '[] '["attackSecs", "releaseSecs", "level", "curve", "doneAction"] a) => a -> SDBody a Signal
percGen userArgs = do
level <- uaArgWDef_onlyConst (1::Float) userArgs (V::V "level")
attackTime <- uaArgWDef_onlyConst (0.01::Float) userArgs (V::V "attackSecs")
releaseTime <- uaArgWDef_onlyConst (1::Float) userArgs (V::V "releaseSecs")
curve <- uaArgWDef_onlyConst (4::Float) userArgs (V::V "curve")
doneAction <- fromEnum <$> uaArgWDef_onlyConst (2::Float) userArgs (V::V "doneAction")
envGen (env 0 [(level, attackTime), (0, releaseTime)] (Curve_Curve curve)) (DoneAction_AsNum doneAction)
where
uaArgWDef_onlyConst defaultVal args argName =
uaArgValWDefault defaultVal args argName >>= \case
Constant x -> return x
_ -> error $ "bad argument type: "<>show (symbolVal argName)<>" wasn't a Constant"
xLine :: (Args '[] '["start","end","duration","doneAction"] a) => a -> SDBody a Signal
xLine = makeUGen
"XLine" KR
(Vs::Vs '["start","end","duration","doneAction"])
(start_ (1::Float), end_ (2::Float), duration_ (1::Float), doneAction_ (0::Float))