module Vivid.Envelopes (
EnvLiterally(..)
, envLiterallyToSignals
, env
, EnvCurve(..)
, EnvSegment(..)
, shapeNumber
, curveNumber
) where
import Vivid.SynthDef.ToSig (ToSig(..))
import Vivid.SynthDef.Types
import Data.Monoid
import GHC.TypeLits
import Prelude
data EnvLiterally (args :: [Symbol])
= forall initial. (ToSig initial args) =>
EnvLiterally {
_envLiterally_initialVal :: initial
, _envLiterally_releaseNode :: Maybe Int
, _envLiterally_offset :: Float
, _envLiterally_loopNode :: Maybe Int
, _envLiterally_curveSegments :: [EnvSegment]
}
envLiterallyToSignals :: EnvLiterally (b::[Symbol]) -> SDBody' b [Signal]
envLiterallyToSignals envLiterally@(EnvLiterally a _ _ _ _) = do
foo <- toSig a
return $ [
foo
, Constant . toEnum . (length::[a]->Int) $ _envLiterally_curveSegments envLiterally
, Constant $ case _envLiterally_releaseNode envLiterally of
Just x -> toEnum x
Nothing -> (99)
, Constant $ case _envLiterally_loopNode envLiterally of
Just x -> toEnum x
Nothing -> (99)
] <> concatMap envSegmentToSignals (_envLiterally_curveSegments envLiterally)
where
envSegmentToSignals :: EnvSegment -> [Signal]
envSegmentToSignals envSegment = [
_envSegment_targetVal envSegment
, _envSegment_timeToGetThere envSegment
, Constant $ envCurveNumber $ _envSegment_curve envSegment
, Constant $ envCurveFloatNumber $ _envSegment_curve envSegment
]
data EnvSegment
= EnvSegment {
_envSegment_targetVal :: Signal
, _envSegment_timeToGetThere :: Signal
, _envSegment_curve :: EnvCurve
}
deriving (Show, Eq)
data EnvCurve
= Curve_Step
| Curve_Linear
| Curve_Lin
| Curve_Exponential
| Curve_Exp
| Curve_Sine
| Curve_Sin
| Curve_Welch
| Curve_Wel
| Curve_Squared
| Curve_Sqr
| Curve_Cubed
| Curve_Cub
| Curve_Curve Float
deriving (Show, Eq)
shapeNumber :: EnvCurve -> Float
shapeNumber = envCurveNumber
curveNumber :: EnvCurve -> Float
curveNumber = shapeNumber
envCurveNumber :: EnvCurve -> Float
envCurveNumber Curve_Step = 0
envCurveNumber Curve_Linear = 1
envCurveNumber Curve_Lin = 1
envCurveNumber Curve_Exponential = 2
envCurveNumber Curve_Exp = 2
envCurveNumber Curve_Sine = 3
envCurveNumber Curve_Sin = 3
envCurveNumber Curve_Welch = 4
envCurveNumber Curve_Wel = 4
envCurveNumber Curve_Squared = 6
envCurveNumber Curve_Sqr = 6
envCurveNumber Curve_Cubed = 7
envCurveNumber Curve_Cub = 7
envCurveNumber (Curve_Curve _) = 5
envCurveFloatNumber :: EnvCurve -> Float
envCurveFloatNumber (Curve_Curve f) = f
envCurveFloatNumber _ = 0
env :: Float -> [(Float, Float)] -> EnvCurve -> EnvLiterally a
env firstPoint pointsAndLengths curve = EnvLiterally {
_envLiterally_initialVal = firstPoint
, _envLiterally_releaseNode = Nothing
, _envLiterally_offset = 0
, _envLiterally_loopNode = Nothing
, _envLiterally_curveSegments = map foo pointsAndLengths
}
where
foo :: (Float, Float) -> EnvSegment
foo (point, dur) = EnvSegment {
_envSegment_targetVal = Constant point
, _envSegment_timeToGetThere = Constant dur
, _envSegment_curve = curve
}