{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE
DataKinds
, ExistentialQuantification
, KindSignatures
, LambdaCase
, NoIncoherentInstances
, NoMonomorphismRestriction
, NoUndecidableInstances
, FlexibleContexts
#-}
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 = \case
Curve_Step -> 0
Curve_Linear -> 1
Curve_Lin -> 1
Curve_Exponential -> 2
Curve_Exp -> 2
Curve_Sine -> 3
Curve_Sin -> 3
Curve_Welch -> 4
Curve_Wel -> 4
Curve_Squared -> 6
Curve_Sqr -> 6
Curve_Cubed -> 7
Curve_Cub -> 7
Curve_Curve _ -> 5
envCurveFloatNumber :: EnvCurve -> Float
envCurveFloatNumber = \case
Curve_Curve f -> f
_ -> 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
}