{-# 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 args -> Maybe Int
_envLiterally_releaseNode :: Maybe Int
, EnvLiterally args -> Float
_envLiterally_offset :: Float
, EnvLiterally args -> Maybe Int
_envLiterally_loopNode :: Maybe Int
, EnvLiterally args -> [EnvSegment]
_envLiterally_curveSegments :: [EnvSegment]
}
envLiterallyToSignals :: EnvLiterally (b::[Symbol]) -> SDBody' b [Signal]
envLiterallyToSignals :: EnvLiterally b -> SDBody' b [Signal]
envLiterallyToSignals envLiterally :: EnvLiterally b
envLiterally@(EnvLiterally initial
a Maybe Int
_ Float
_ Maybe Int
_ [EnvSegment]
_) = do
Signal
foo <- initial -> SDBody' b Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig initial
a
[Signal] -> SDBody' b [Signal]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Signal] -> SDBody' b [Signal]) -> [Signal] -> SDBody' b [Signal]
forall a b. (a -> b) -> a -> b
$ [
Signal
foo
, Float -> Signal
Constant (Float -> Signal)
-> ([EnvSegment] -> Float) -> [EnvSegment] -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float
forall a. Enum a => Int -> a
toEnum (Int -> Float) -> ([EnvSegment] -> Int) -> [EnvSegment] -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length::[a]->Int) ([EnvSegment] -> Signal) -> [EnvSegment] -> Signal
forall a b. (a -> b) -> a -> b
$ EnvLiterally b -> [EnvSegment]
forall (args :: [Symbol]). EnvLiterally args -> [EnvSegment]
_envLiterally_curveSegments EnvLiterally b
envLiterally
, Float -> Signal
Constant (Float -> Signal) -> Float -> Signal
forall a b. (a -> b) -> a -> b
$ case EnvLiterally b -> Maybe Int
forall (args :: [Symbol]). EnvLiterally args -> Maybe Int
_envLiterally_releaseNode EnvLiterally b
envLiterally of
Just Int
x -> Int -> Float
forall a. Enum a => Int -> a
toEnum Int
x
Maybe Int
Nothing -> (-Float
99)
, Float -> Signal
Constant (Float -> Signal) -> Float -> Signal
forall a b. (a -> b) -> a -> b
$ case EnvLiterally b -> Maybe Int
forall (args :: [Symbol]). EnvLiterally args -> Maybe Int
_envLiterally_loopNode EnvLiterally b
envLiterally of
Just Int
x -> Int -> Float
forall a. Enum a => Int -> a
toEnum Int
x
Maybe Int
Nothing -> (-Float
99)
] [Signal] -> [Signal] -> [Signal]
forall a. Semigroup a => a -> a -> a
<> (EnvSegment -> [Signal]) -> [EnvSegment] -> [Signal]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EnvSegment -> [Signal]
envSegmentToSignals (EnvLiterally b -> [EnvSegment]
forall (args :: [Symbol]). EnvLiterally args -> [EnvSegment]
_envLiterally_curveSegments EnvLiterally b
envLiterally)
where
envSegmentToSignals :: EnvSegment -> [Signal]
envSegmentToSignals :: EnvSegment -> [Signal]
envSegmentToSignals EnvSegment
envSegment = [
EnvSegment -> Signal
_envSegment_targetVal EnvSegment
envSegment
, EnvSegment -> Signal
_envSegment_timeToGetThere EnvSegment
envSegment
, Float -> Signal
Constant (Float -> Signal) -> Float -> Signal
forall a b. (a -> b) -> a -> b
$ EnvCurve -> Float
envCurveNumber (EnvCurve -> Float) -> EnvCurve -> Float
forall a b. (a -> b) -> a -> b
$ EnvSegment -> EnvCurve
_envSegment_curve EnvSegment
envSegment
, Float -> Signal
Constant (Float -> Signal) -> Float -> Signal
forall a b. (a -> b) -> a -> b
$ EnvCurve -> Float
envCurveFloatNumber (EnvCurve -> Float) -> EnvCurve -> Float
forall a b. (a -> b) -> a -> b
$ EnvSegment -> EnvCurve
_envSegment_curve EnvSegment
envSegment
]
data EnvSegment
= EnvSegment {
EnvSegment -> Signal
_envSegment_targetVal :: Signal
, EnvSegment -> Signal
_envSegment_timeToGetThere :: Signal
, EnvSegment -> EnvCurve
_envSegment_curve :: EnvCurve
}
deriving (Int -> EnvSegment -> ShowS
[EnvSegment] -> ShowS
EnvSegment -> String
(Int -> EnvSegment -> ShowS)
-> (EnvSegment -> String)
-> ([EnvSegment] -> ShowS)
-> Show EnvSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvSegment] -> ShowS
$cshowList :: [EnvSegment] -> ShowS
show :: EnvSegment -> String
$cshow :: EnvSegment -> String
showsPrec :: Int -> EnvSegment -> ShowS
$cshowsPrec :: Int -> EnvSegment -> ShowS
Show, EnvSegment -> EnvSegment -> Bool
(EnvSegment -> EnvSegment -> Bool)
-> (EnvSegment -> EnvSegment -> Bool) -> Eq EnvSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvSegment -> EnvSegment -> Bool
$c/= :: EnvSegment -> EnvSegment -> Bool
== :: EnvSegment -> EnvSegment -> Bool
$c== :: EnvSegment -> EnvSegment -> Bool
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 (Int -> EnvCurve -> ShowS
[EnvCurve] -> ShowS
EnvCurve -> String
(Int -> EnvCurve -> ShowS)
-> (EnvCurve -> String) -> ([EnvCurve] -> ShowS) -> Show EnvCurve
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvCurve] -> ShowS
$cshowList :: [EnvCurve] -> ShowS
show :: EnvCurve -> String
$cshow :: EnvCurve -> String
showsPrec :: Int -> EnvCurve -> ShowS
$cshowsPrec :: Int -> EnvCurve -> ShowS
Show, EnvCurve -> EnvCurve -> Bool
(EnvCurve -> EnvCurve -> Bool)
-> (EnvCurve -> EnvCurve -> Bool) -> Eq EnvCurve
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvCurve -> EnvCurve -> Bool
$c/= :: EnvCurve -> EnvCurve -> Bool
== :: EnvCurve -> EnvCurve -> Bool
$c== :: EnvCurve -> EnvCurve -> Bool
Eq)
shapeNumber :: EnvCurve -> Float
shapeNumber :: EnvCurve -> Float
shapeNumber = EnvCurve -> Float
envCurveNumber
curveNumber :: EnvCurve -> Float
curveNumber :: EnvCurve -> Float
curveNumber = EnvCurve -> Float
shapeNumber
envCurveNumber :: EnvCurve -> Float
envCurveNumber :: EnvCurve -> Float
envCurveNumber = \case
EnvCurve
Curve_Step -> Float
0
EnvCurve
Curve_Linear -> Float
1
EnvCurve
Curve_Lin -> Float
1
EnvCurve
Curve_Exponential -> Float
2
EnvCurve
Curve_Exp -> Float
2
EnvCurve
Curve_Sine -> Float
3
EnvCurve
Curve_Sin -> Float
3
EnvCurve
Curve_Welch -> Float
4
EnvCurve
Curve_Wel -> Float
4
EnvCurve
Curve_Squared -> Float
6
EnvCurve
Curve_Sqr -> Float
6
EnvCurve
Curve_Cubed -> Float
7
EnvCurve
Curve_Cub -> Float
7
Curve_Curve Float
_ -> Float
5
envCurveFloatNumber :: EnvCurve -> Float
envCurveFloatNumber :: EnvCurve -> Float
envCurveFloatNumber = \case
Curve_Curve Float
f -> Float
f
EnvCurve
_ -> Float
0
env :: Float -> [(Float, Float)] -> EnvCurve -> EnvLiterally args
env :: Float -> [(Float, Float)] -> EnvCurve -> EnvLiterally args
env Float
firstPoint [(Float, Float)]
pointsAndLengths EnvCurve
curve = EnvLiterally :: forall (args :: [Symbol]) initial.
ToSig initial args =>
initial
-> Maybe Int
-> Float
-> Maybe Int
-> [EnvSegment]
-> EnvLiterally args
EnvLiterally {
_envLiterally_initialVal :: Float
_envLiterally_initialVal = Float
firstPoint
, _envLiterally_releaseNode :: Maybe Int
_envLiterally_releaseNode = Maybe Int
forall a. Maybe a
Nothing
, _envLiterally_offset :: Float
_envLiterally_offset = Float
0
, _envLiterally_loopNode :: Maybe Int
_envLiterally_loopNode = Maybe Int
forall a. Maybe a
Nothing
, _envLiterally_curveSegments :: [EnvSegment]
_envLiterally_curveSegments = ((Float, Float) -> EnvSegment) -> [(Float, Float)] -> [EnvSegment]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> EnvSegment
foo [(Float, Float)]
pointsAndLengths
}
where
foo :: (Float, Float) -> EnvSegment
foo :: (Float, Float) -> EnvSegment
foo (Float
point, Float
dur) = EnvSegment :: Signal -> Signal -> EnvCurve -> EnvSegment
EnvSegment {
_envSegment_targetVal :: Signal
_envSegment_targetVal = Float -> Signal
Constant Float
point
, _envSegment_timeToGetThere :: Signal
_envSegment_timeToGetThere = Float -> Signal
Constant Float
dur
, _envSegment_curve :: EnvCurve
_envSegment_curve = EnvCurve
curve
}