-- | Envelopes. **This module is the least mature in vivid and is likely to
--   change a lot in the future!**

{-# 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(..)) -- , SDBody)
import Vivid.SynthDef.Types
-- import Vivid.SynthDef.FromUA (fromUA, Args)

-- import Data.Int
import Data.Monoid
import GHC.TypeLits
import Prelude -- BBP

data EnvLiterally (args :: [Symbol])
   = forall initial. (ToSig initial args) =>
     EnvLiterally {
    ()
_envLiterally_initialVal :: initial
   -- ,_envLiterally_numSegments :: Int -- i know this is a 'Literally' but it's so computable...
  , EnvLiterally args -> Maybe Int
_envLiterally_releaseNode :: Maybe Int
  , EnvLiterally args -> Float
_envLiterally_offset :: Float -- ?? -- only used for 'IEnvGen', which i dont have
    -- invariant: releasenode must be larger (or equal?) to/than loopnode
    -- also, if one is Just, i think the other must be -- so if that's true, use
    -- a different data structure
    -- at least for the non-'Literally' one
  , EnvLiterally args -> Maybe Int
_envLiterally_loopNode :: Maybe Int
  , EnvLiterally args -> [EnvSegment]
_envLiterally_curveSegments :: [EnvSegment]
  }
 -- deriving (Show, Eq)

{-
  InputSpec_UGen {_inputSpec_uGen_index = 2, _inputSpec_uGen_outputIndex = 0}
  Constant: 2.0 (index 2) -- length segments
  Constant: 1.0 (index 1) -- release node
  Constant: -99.0 (index 3) -- loop node

signals?:
  Constant: 1.0 (index 1)
  Constant: 1.0 (index 1)
  Constant: 3.0 (index 4)
  Constant: 0.0 (index 0)
  Constant: 0.0 (index 0)
  Constant: 1.0 (index 1)
  Constant: 3.0 (index 4)
  Constant: 0.0 (index 0)
-}

-- i think this is (only) for the arguments to EnvGen:
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
   {-
  foo <- case _envLiterally_initialVal envLiterally of
    x -> toSigM $ x
-}
  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 -- ^ 0 is linear, positive curves up, negative curves down
 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)

-- | Same as \"Env.shapeNumber\" in SC.
-- 
--   This is useful if you want to set a the env shape of a running synth
shapeNumber :: EnvCurve -> Float
shapeNumber :: EnvCurve -> Float
shapeNumber = EnvCurve -> Float
envCurveNumber

-- | "shapeNumber" with a name I like better
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
         -- this is, of course, limiting:
      , _envSegment_curve :: EnvCurve
_envSegment_curve = EnvCurve
curve
      }