-- | Envelope generators.
module Sound.SC3.Common.Envelope where

import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Sound.SC3.Common.Base as Base
import qualified Sound.SC3.Common.Math.Interpolate as I

-- * Curve

-- | Envelope curve indicator input.
data Envelope_Curve a = EnvStep
                      | EnvLin
                      | EnvExp
                      | EnvSin
                      | EnvWelch -- ^ Note: not implemented at SC3
                      | EnvNum a
                      | EnvSqr
                      | EnvCub
                      | EnvHold
                        deriving (Envelope_Curve a -> Envelope_Curve a -> Bool
(Envelope_Curve a -> Envelope_Curve a -> Bool)
-> (Envelope_Curve a -> Envelope_Curve a -> Bool)
-> Eq (Envelope_Curve a)
forall a. Eq a => Envelope_Curve a -> Envelope_Curve a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Envelope_Curve a -> Envelope_Curve a -> Bool
$c/= :: forall a. Eq a => Envelope_Curve a -> Envelope_Curve a -> Bool
== :: Envelope_Curve a -> Envelope_Curve a -> Bool
$c== :: forall a. Eq a => Envelope_Curve a -> Envelope_Curve a -> Bool
Eq, Int -> Envelope_Curve a -> ShowS
[Envelope_Curve a] -> ShowS
Envelope_Curve a -> String
(Int -> Envelope_Curve a -> ShowS)
-> (Envelope_Curve a -> String)
-> ([Envelope_Curve a] -> ShowS)
-> Show (Envelope_Curve a)
forall a. Show a => Int -> Envelope_Curve a -> ShowS
forall a. Show a => [Envelope_Curve a] -> ShowS
forall a. Show a => Envelope_Curve a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Envelope_Curve a] -> ShowS
$cshowList :: forall a. Show a => [Envelope_Curve a] -> ShowS
show :: Envelope_Curve a -> String
$cshow :: forall a. Show a => Envelope_Curve a -> String
showsPrec :: Int -> Envelope_Curve a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Envelope_Curve a -> ShowS
Show)

-- | Envelope curve pair.
type Envelope_Curve_2 a = Base.T2 (Envelope_Curve a)

-- | Envelope curve triple.
type Envelope_Curve_3 a = Base.T3 (Envelope_Curve a)

-- | Envelope curve quadruple.
type Envelope_Curve_4 a = Base.T4 (Envelope_Curve a)

-- | Convert 'Envelope_Curve' to shape value.
--
-- > map env_curve_shape [EnvSin,EnvSqr] == [3,6]
env_curve_shape :: Num a => Envelope_Curve a -> a
env_curve_shape :: Envelope_Curve a -> a
env_curve_shape Envelope_Curve a
e =
    case Envelope_Curve a
e of
      Envelope_Curve a
EnvStep -> a
0
      Envelope_Curve a
EnvLin -> a
1
      Envelope_Curve a
EnvExp -> a
2
      Envelope_Curve a
EnvSin -> a
3
      Envelope_Curve a
EnvWelch -> a
4
      EnvNum a
_ -> a
5
      Envelope_Curve a
EnvSqr -> a
6
      Envelope_Curve a
EnvCub -> a
7
      Envelope_Curve a
EnvHold -> a
8

-- | The /value/ of 'EnvCurve' is non-zero for 'EnvNum'.
--
-- > map env_curve_value [EnvWelch,EnvNum 2] == [0,2]
env_curve_value :: Num a => Envelope_Curve a -> a
env_curve_value :: Envelope_Curve a -> a
env_curve_value Envelope_Curve a
e =
    case Envelope_Curve a
e of
      EnvNum a
u -> a
u
      Envelope_Curve a
_ -> a
0

-- | 'Interpolation_F' of 'Envelope_Curve'.
env_curve_interpolation_f :: (Ord t, Floating t) => Envelope_Curve t -> I.Interpolation_F t
env_curve_interpolation_f :: Envelope_Curve t -> Interpolation_F t
env_curve_interpolation_f Envelope_Curve t
c =
    case Envelope_Curve t
c of
      Envelope_Curve t
EnvStep -> Interpolation_F t
forall t. Interpolation_F t
I.step
      Envelope_Curve t
EnvLin -> Interpolation_F t
forall t. Num t => Interpolation_F t
I.linear
      Envelope_Curve t
EnvExp -> Interpolation_F t
forall t. Floating t => Interpolation_F t
I.exponential
      Envelope_Curve t
EnvSin -> Interpolation_F t
forall t. Floating t => Interpolation_F t
I.sine
      Envelope_Curve t
EnvWelch -> Interpolation_F t
forall t. (Ord t, Floating t) => Interpolation_F t
I.welch
      EnvNum t
n -> t -> Interpolation_F t
forall t. (Ord t, Floating t) => t -> Interpolation_F t
I.curve t
n
      Envelope_Curve t
EnvSqr -> Interpolation_F t
forall t. Floating t => Interpolation_F t
I.squared
      Envelope_Curve t
EnvCub -> Interpolation_F t
forall t. Floating t => Interpolation_F t
I.cubed
      Envelope_Curve t
EnvHold -> Interpolation_F t
forall a. HasCallStack => a
undefined

-- | Apply /f/ to 'EnvNum' value.
env_curve_coerce :: (a -> b) -> Envelope_Curve a -> Envelope_Curve b
env_curve_coerce :: (a -> b) -> Envelope_Curve a -> Envelope_Curve b
env_curve_coerce a -> b
f Envelope_Curve a
e =
    case Envelope_Curve a
e of
      Envelope_Curve a
EnvStep -> Envelope_Curve b
forall a. Envelope_Curve a
EnvStep
      Envelope_Curve a
EnvLin -> Envelope_Curve b
forall a. Envelope_Curve a
EnvLin
      Envelope_Curve a
EnvExp -> Envelope_Curve b
forall a. Envelope_Curve a
EnvExp
      Envelope_Curve a
EnvSin -> Envelope_Curve b
forall a. Envelope_Curve a
EnvSin
      Envelope_Curve a
EnvWelch -> Envelope_Curve b
forall a. Envelope_Curve a
EnvWelch
      EnvNum a
x -> b -> Envelope_Curve b
forall a. a -> Envelope_Curve a
EnvNum (a -> b
f a
x)
      Envelope_Curve a
EnvSqr -> Envelope_Curve b
forall a. Envelope_Curve a
EnvSqr
      Envelope_Curve a
EnvCub -> Envelope_Curve b
forall a. Envelope_Curve a
EnvCub
      Envelope_Curve a
EnvHold -> Envelope_Curve b
forall a. Envelope_Curve a
EnvHold

-- * Envelope

-- | SC3 envelope segment model
data Envelope a =
    Envelope {Envelope a -> [a]
env_levels :: [a] -- ^ Set of /n/ levels, n is >= 1
             ,Envelope a -> [a]
env_times :: [a] -- ^ Set of /n-1/ time intervals
             ,Envelope a -> [Envelope_Curve a]
env_curves :: [Envelope_Curve a] -- ^ Possibly empty curve set
             ,Envelope a -> Maybe Int
env_release_node :: Maybe Int -- ^ Maybe index to release node
             ,Envelope a -> Maybe Int
env_loop_node :: Maybe Int -- ^ Maybe index to loop node
             ,Envelope a -> a
env_offset :: a -- ^ An offset for all time values (IEnvGen only)
             }
    deriving (Envelope a -> Envelope a -> Bool
(Envelope a -> Envelope a -> Bool)
-> (Envelope a -> Envelope a -> Bool) -> Eq (Envelope a)
forall a. Eq a => Envelope a -> Envelope a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Envelope a -> Envelope a -> Bool
$c/= :: forall a. Eq a => Envelope a -> Envelope a -> Bool
== :: Envelope a -> Envelope a -> Bool
$c== :: forall a. Eq a => Envelope a -> Envelope a -> Bool
Eq,Int -> Envelope a -> ShowS
[Envelope a] -> ShowS
Envelope a -> String
(Int -> Envelope a -> ShowS)
-> (Envelope a -> String)
-> ([Envelope a] -> ShowS)
-> Show (Envelope a)
forall a. Show a => Int -> Envelope a -> ShowS
forall a. Show a => [Envelope a] -> ShowS
forall a. Show a => Envelope a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Envelope a] -> ShowS
$cshowList :: forall a. Show a => [Envelope a] -> ShowS
show :: Envelope a -> String
$cshow :: forall a. Show a => Envelope a -> String
showsPrec :: Int -> Envelope a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Envelope a -> ShowS
Show)

-- | Apply /f/ to all /a/ at 'Envelope'.
envelope_coerce :: (a -> b) -> Envelope a -> Envelope b
envelope_coerce :: (a -> b) -> Envelope a -> Envelope b
envelope_coerce a -> b
f Envelope a
e =
    let Envelope [a]
l [a]
t [Envelope_Curve a]
c Maybe Int
rn Maybe Int
ln a
os = Envelope a
e
    in [b]
-> [b]
-> [Envelope_Curve b]
-> Maybe Int
-> Maybe Int
-> b
-> Envelope b
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
l) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
t) ((Envelope_Curve a -> Envelope_Curve b)
-> [Envelope_Curve a] -> [Envelope_Curve b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Envelope_Curve a -> Envelope_Curve b
forall a b. (a -> b) -> Envelope_Curve a -> Envelope_Curve b
env_curve_coerce a -> b
f) [Envelope_Curve a]
c) Maybe Int
rn Maybe Int
ln (a -> b
f a
os)

-- | fmap = 'envelope_coerce'
instance Functor Envelope where
  fmap :: (a -> b) -> Envelope a -> Envelope b
fmap = (a -> b) -> Envelope a -> Envelope b
forall a b. (a -> b) -> Envelope a -> Envelope b
envelope_coerce

{- | Variant without release and loop node inputs (defaulting to nil).

> Sound.SC3.Plot.plotEnvelope [envelope [0,1,0] [3,2] [EnvSin,EnvSin]]

-}
envelope :: Num a => [a] -> [a] -> [Envelope_Curve a] -> Envelope a
envelope :: [a] -> [a] -> [Envelope_Curve a] -> Envelope a
envelope [a]
l [a]
t [Envelope_Curve a]
c = [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing a
0

-- | Duration of 'Envelope', ie. 'sum' '.' 'env_times'.
envelope_duration :: Num n => Envelope n -> n
envelope_duration :: Envelope n -> n
envelope_duration = [n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([n] -> n) -> (Envelope n -> [n]) -> Envelope n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope n -> [n]
forall a. Envelope a -> [a]
env_times

-- | Number of segments at 'Envelope', ie. 'length' '.' 'env_times'.
envelope_n_segments :: Integral i => Envelope n -> i
envelope_n_segments :: Envelope n -> i
envelope_n_segments = [n] -> i
forall i a. Num i => [a] -> i
genericLength ([n] -> i) -> (Envelope n -> [n]) -> Envelope n -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope n -> [n]
forall a. Envelope a -> [a]
env_times

-- | Determine which envelope segment a given time /t/ falls in.
envelope_segment_ix :: (Ord a, Num a) => Envelope a -> a -> Maybe Int
envelope_segment_ix :: Envelope a -> a -> Maybe Int
envelope_segment_ix Envelope a
e a
t =
    let d :: [a]
d = [a] -> [a]
forall n. Num n => [n] -> [n]
Base.dx_d (Envelope a -> [a]
forall a. Envelope a -> [a]
env_times Envelope a
e)
    in (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
t) [a]
d

-- | A set of start time, start level, end time, end level and curve.
type Envelope_Segment t = (t,t,t,t,Envelope_Curve t)

-- | Extract envelope segment given at index /i/.
envelope_segment :: Num t => Envelope t -> Int -> Envelope_Segment t
envelope_segment :: Envelope t -> Int -> Envelope_Segment t
envelope_segment Envelope t
e Int
i =
    let l :: [t]
l = Envelope t -> [t]
forall a. Envelope a -> [a]
env_levels Envelope t
e
        t :: [t]
t = Envelope t -> [t]
forall a. Envelope a -> [a]
env_times Envelope t
e
        x0 :: t
x0 = [t]
l [t] -> Int -> t
forall a. [a] -> Int -> a
!! Int
i
        x1 :: t
x1 = [t]
l [t] -> Int -> t
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        t0 :: t
t0 = (t
0 t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t] -> [t]
forall n. Num n => [n] -> [n]
Base.dx_d [t]
t) [t] -> Int -> t
forall a. [a] -> Int -> a
!! Int
i
        t1 :: t
t1 = t
t0 t -> t -> t
forall a. Num a => a -> a -> a
+ [t]
t [t] -> Int -> t
forall a. [a] -> Int -> a
!! Int
i
        c :: Envelope_Curve t
c = Envelope t -> [Envelope_Curve t]
forall a. Envelope a -> [Envelope_Curve a]
envelope_curves Envelope t
e [Envelope_Curve t] -> Int -> Envelope_Curve t
forall a. [a] -> Int -> a
!! Int
i
    in (t
t0,t
x0,t
t1,t
x1,Envelope_Curve t
c)

-- | Extract all segments.
envelope_segments :: Num t => Envelope t -> [Envelope_Segment t]
envelope_segments :: Envelope t -> [Envelope_Segment t]
envelope_segments Envelope t
e =
    let n :: Int
n = Envelope t -> Int
forall i n. Integral i => Envelope n -> i
envelope_n_segments Envelope t
e
    in (Int -> Envelope_Segment t) -> [Int] -> [Envelope_Segment t]
forall a b. (a -> b) -> [a] -> [b]
map (Envelope t -> Int -> Envelope_Segment t
forall t. Num t => Envelope t -> Int -> Envelope_Segment t
envelope_segment Envelope t
e) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

-- | Transform list of 'Envelope_Segment's into lists ('env_levels','env_times','env_curves').
pack_envelope_segments :: Num t => [Envelope_Segment t] -> ([t],[t],[Envelope_Curve t])
pack_envelope_segments :: [Envelope_Segment t] -> ([t], [t], [Envelope_Curve t])
pack_envelope_segments [Envelope_Segment t]
s =
    case [Envelope_Segment t]
s of
      [] -> String -> ([t], [t], [Envelope_Curve t])
forall a. HasCallStack => String -> a
error String
""
      [(t
t0,t
l0,t
t1,t
l1,Envelope_Curve t
c)] -> ([t
l0,t
l1],[t
t1 t -> t -> t
forall a. Num a => a -> a -> a
- t
t0],[Envelope_Curve t
c])
      (t
_,t
l0,t
_,t
_,Envelope_Curve t
_) : [Envelope_Segment t]
_ ->
          let t :: (a, b, a, d, e) -> a
t (a
t0,b
_,a
t1,d
_,e
_) = a
t1 a -> a -> a
forall a. Num a => a -> a -> a
- a
t0
              c :: (a, b, c, d, e) -> e
c (a
_,b
_,c
_,d
_,e
x) = e
x
              l :: (a, b, c, d, e) -> d
l (a
_,b
_,c
_,d
x,e
_) = d
x
          in (t
l0 t -> [t] -> [t]
forall a. a -> [a] -> [a]
: (Envelope_Segment t -> t) -> [Envelope_Segment t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Envelope_Segment t -> t
forall a b c d e. (a, b, c, d, e) -> d
l [Envelope_Segment t]
s,(Envelope_Segment t -> t) -> [Envelope_Segment t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Envelope_Segment t -> t
forall a b d e. Num a => (a, b, a, d, e) -> a
t [Envelope_Segment t]
s,(Envelope_Segment t -> Envelope_Curve t)
-> [Envelope_Segment t] -> [Envelope_Curve t]
forall a b. (a -> b) -> [a] -> [b]
map Envelope_Segment t -> Envelope_Curve t
forall a b c d e. (a, b, c, d, e) -> e
c [Envelope_Segment t]
s)

-- | An envelope is /normal/ if it has no segments with zero duration.
envelope_is_normal :: (Eq n,Num n) => Envelope n -> Bool
envelope_is_normal :: Envelope n -> Bool
envelope_is_normal = n -> [n] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem n
0 ([n] -> Bool) -> (Envelope n -> [n]) -> Envelope n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope n -> [n]
forall a. Envelope a -> [a]
env_times

-- | Normalise envelope by deleting segments of zero duration.
envelope_normalise :: (Num a, Ord a) => Envelope a -> Envelope a
envelope_normalise :: Envelope a -> Envelope a
envelope_normalise Envelope a
e =
    let s :: [Envelope_Segment a]
s = Envelope a -> [Envelope_Segment a]
forall t. Num t => Envelope t -> [Envelope_Segment t]
envelope_segments Envelope a
e
        f :: (a, b, a, d, e) -> Bool
f (a
t0,b
_,a
t1,d
_,e
_) = a
t1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
t0
        s' :: [Envelope_Segment a]
s' = (Envelope_Segment a -> Bool)
-> [Envelope_Segment a] -> [Envelope_Segment a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Envelope_Segment a -> Bool) -> Envelope_Segment a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope_Segment a -> Bool
forall a b d e. Ord a => (a, b, a, d, e) -> Bool
f) [Envelope_Segment a]
s
        ([a]
l,[a]
t,[Envelope_Curve a]
c) = [Envelope_Segment a] -> ([a], [a], [Envelope_Curve a])
forall t.
Num t =>
[Envelope_Segment t] -> ([t], [t], [Envelope_Curve t])
pack_envelope_segments [Envelope_Segment a]
s'
    in case Envelope a
e of
         Envelope [a]
_ [a]
_ [Envelope_Curve a]
_ Maybe Int
Nothing Maybe Int
Nothing  a
os -> [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing a
os
         Envelope a
_ -> String -> Envelope a
forall a. HasCallStack => String -> a
error String
"envelope_normalise: has release or loop node..."

-- | Get value for 'Envelope' at time /t/, or zero if /t/ is out of
-- range.  By convention if the envelope has a segment of zero
-- duration we give the rightmost value.
envelope_at :: (Ord t, Floating t) => Envelope t -> t -> t
envelope_at :: Envelope t -> t -> t
envelope_at Envelope t
e t
t =
    case Envelope t -> t -> Maybe Int
forall a. (Ord a, Num a) => Envelope a -> a -> Maybe Int
envelope_segment_ix Envelope t
e t
t of
      Just Int
n -> let (t
t0,t
x0,t
t1,t
x1,Envelope_Curve t
c) = Envelope t -> Int -> (t, t, t, t, Envelope_Curve t)
forall t. Num t => Envelope t -> Int -> Envelope_Segment t
envelope_segment Envelope t
e Int
n
                    d :: t
d = t
t1 t -> t -> t
forall a. Num a => a -> a -> a
- t
t0
                    t' :: t
t' = (t
t t -> t -> t
forall a. Num a => a -> a -> a
- t
t0) t -> t -> t
forall a. Fractional a => a -> a -> a
/ t
d
                    f :: Interpolation_F t
f = Envelope_Curve t -> Interpolation_F t
forall t.
(Ord t, Floating t) =>
Envelope_Curve t -> Interpolation_F t
env_curve_interpolation_f Envelope_Curve t
c
                in if t
d t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
                   then t
x1
                   else Interpolation_F t
f t
x0 t
x1 t
t'
      Maybe Int
Nothing -> t
0

-- | Render 'Envelope' to breakpoint set of /n/ equi-distant places.
envelope_render :: (Ord t, Floating t, Enum t) => Int -> Envelope t -> [(t,t)]
envelope_render :: Int -> Envelope t -> [(t, t)]
envelope_render Int
n Envelope t
e =
    let d :: t
d = Envelope t -> t
forall n. Num n => Envelope n -> n
envelope_duration Envelope t
e
        k :: t
k = t
d t -> t -> t
forall a. Fractional a => a -> a -> a
/ (Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
        t :: [t]
t = [t
0,t
k .. t
d]
    in [t] -> [t] -> [(t, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [t]
t ((t -> t) -> [t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Envelope t -> t -> t
forall t. (Ord t, Floating t) => Envelope t -> t -> t
envelope_at Envelope t
e) [t]
t)

-- | Contruct a lookup table of /n/ places from 'Envelope'.
envelope_table :: (Ord t, Floating t, Enum t) => Int -> Envelope t -> [t]
envelope_table :: Int -> Envelope t -> [t]
envelope_table Int
n = ((t, t) -> t) -> [(t, t)] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (t, t) -> t
forall a b. (a, b) -> b
snd ([(t, t)] -> [t]) -> (Envelope t -> [(t, t)]) -> Envelope t -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Envelope t -> [(t, t)]
forall t.
(Ord t, Floating t, Enum t) =>
Int -> Envelope t -> [(t, t)]
envelope_render Int
n

-- | Variant on 'env_curves' that expands the, possibly empty, user
-- list by cycling (if not empty) or by filling with 'EnvLin'.
envelope_curves :: Envelope a -> [Envelope_Curve a]
envelope_curves :: Envelope a -> [Envelope_Curve a]
envelope_curves Envelope a
e =
    let c :: [Envelope_Curve a]
c = Envelope a -> [Envelope_Curve a]
forall a. Envelope a -> [Envelope_Curve a]
env_curves Envelope a
e
        n :: Int
n = Envelope a -> Int
forall i n. Integral i => Envelope n -> i
envelope_n_segments Envelope a
e
    in if [Envelope_Curve a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Envelope_Curve a]
c
       then Int -> Envelope_Curve a -> [Envelope_Curve a]
forall a. Int -> a -> [a]
replicate Int
n Envelope_Curve a
forall a. Envelope_Curve a
EnvLin
       else Int -> [Envelope_Curve a] -> [Envelope_Curve a]
forall a. Int -> [a] -> [a]
take Int
n ([Envelope_Curve a] -> [Envelope_Curve a]
forall a. [a] -> [a]
cycle [Envelope_Curve a]
c)

{- | Linear SC3 form of 'Envelope' data.

Form is: l0 #t reset loop l1 t0 c0 c0' ...

envelope_sc3_array (envelope [0,1] [0.1] [EnvLin]) == Just [0,1,-99,-99,1,0.1,1,0]

> let {l = [0,0.6,0.3,1.0,0]
>     ;t = [0.1,0.02,0.4,1.1]
>     ;c = [EnvLin,EnvExp,EnvNum (-6),EnvSin]
>     ;e = Envelope l t c Nothing Nothing
>     ;r = [0,4,-99,-99,0.6,0.1,1,0,0.3,0.02,2,0,1,0.4,5,-6,0,1.1,3,0]}
> in envelope_sc3_array e == Just r
-}
envelope_sc3_array :: Num a => Envelope a -> Maybe [a]
envelope_sc3_array :: Envelope a -> Maybe [a]
envelope_sc3_array Envelope a
e =
    let Envelope [a]
l [a]
t [Envelope_Curve a]
_ Maybe Int
rn Maybe Int
ln a
_ = Envelope a
e
        n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t
        n' :: a
n' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        rn' :: a
rn' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
99) Maybe Int
rn)
        ln' :: a
ln' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
99) Maybe Int
ln)
        c :: [Envelope_Curve a]
c = Envelope a -> [Envelope_Curve a]
forall a. Envelope a -> [Envelope_Curve a]
envelope_curves Envelope a
e
        f :: a -> a -> Envelope_Curve a -> [a]
f a
i a
j Envelope_Curve a
k = [a
i,a
j,Envelope_Curve a -> a
forall a. Num a => Envelope_Curve a -> a
env_curve_shape Envelope_Curve a
k,Envelope_Curve a -> a
forall a. Num a => Envelope_Curve a -> a
env_curve_value Envelope_Curve a
k]
    in case [a]
l of
         a
l0:[a]
l' -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just (a
l0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
n' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
rn' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
ln' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> a -> Envelope_Curve a -> [a])
-> [a] -> [a] -> [Envelope_Curve a] -> [[a]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 a -> a -> Envelope_Curve a -> [a]
forall a. Num a => a -> a -> Envelope_Curve a -> [a]
f [a]
l' [a]
t [Envelope_Curve a]
c))
         [a]
_ -> Maybe [a]
forall a. Maybe a
Nothing

{- | @IEnvGen@ SC3 form of 'Envelope' data.

> l = [0,0.6,0.3,1.0,0]
> t = [0.1,0.02,0.4,1.1]
> c = [EnvLin,EnvExp,EnvNum (-6),EnvSin]
> e = Envelope l t c Nothing Nothing 0
> r = [0,0,4,1.62,0.1,1,0,0.6,0.02,2,0,0.3,0.4,5,-6,1,1.1,3,0,0]
> envelope_sc3_ienvgen_array e == Just r
-}
envelope_sc3_ienvgen_array :: Num a => Envelope a -> Maybe [a]
envelope_sc3_ienvgen_array :: Envelope a -> Maybe [a]
envelope_sc3_ienvgen_array Envelope a
e =
    let Envelope [a]
l [a]
t [Envelope_Curve a]
_ Maybe Int
_ Maybe Int
_ a
os = Envelope a
e
        n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t
        n' :: a
n' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        c :: [Envelope_Curve a]
c = Envelope a -> [Envelope_Curve a]
forall a. Envelope a -> [Envelope_Curve a]
envelope_curves Envelope a
e
        f :: a -> a -> Envelope_Curve a -> [a]
f a
i a
j Envelope_Curve a
k = [a
j,Envelope_Curve a -> a
forall a. Num a => Envelope_Curve a -> a
env_curve_shape Envelope_Curve a
k,Envelope_Curve a -> a
forall a. Num a => Envelope_Curve a -> a
env_curve_value Envelope_Curve a
k,a
i]
    in case [a]
l of
         a
l0:[a]
l' -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just (a
os a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
l0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
n' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> a -> Envelope_Curve a -> [a])
-> [a] -> [a] -> [Envelope_Curve a] -> [[a]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 a -> a -> Envelope_Curve a -> [a]
forall a. Num a => a -> a -> Envelope_Curve a -> [a]
f [a]
l' [a]
t [Envelope_Curve a]
c))
         [a]
_ -> Maybe [a]
forall a. Maybe a
Nothing

-- | 'True' if 'env_release_node' is not 'Nothing'.
env_is_sustained :: Envelope a -> Bool
env_is_sustained :: Envelope a -> Bool
env_is_sustained = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool)
-> (Envelope a -> Maybe Int) -> Envelope a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope a -> Maybe Int
forall a. Envelope a -> Maybe Int
env_release_node

-- | Delay the onset of the envelope (add initial segment).
env_delay :: Envelope a -> a -> Envelope a
env_delay :: Envelope a -> a -> Envelope a
env_delay (Envelope [a]
l [a]
t [Envelope_Curve a]
c Maybe Int
rn Maybe Int
ln a
os) a
d =
    let (a
l0:[a]
_) = [a]
l
        l' :: [a]
l' = a
l0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l
        t' :: [a]
t' = a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t
        c' :: [Envelope_Curve a]
c' = Envelope_Curve a
forall a. Envelope_Curve a
EnvLin Envelope_Curve a -> [Envelope_Curve a] -> [Envelope_Curve a]
forall a. a -> [a] -> [a]
: [Envelope_Curve a]
c
        rn' :: Maybe Int
rn' = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
rn
        ln' :: Maybe Int
ln' = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
ln
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l' [a]
t' [Envelope_Curve a]
c' Maybe Int
rn' Maybe Int
ln' a
os

-- | Connect releaseNode (or end) to first node of envelope.
-- z is a value that is first zero and thereafter one.
-- tc & cc are time and curve from first to last.
env_circle_z :: Fractional a => a -> a -> Envelope_Curve a -> Envelope a -> Envelope a
env_circle_z :: a -> a -> Envelope_Curve a -> Envelope a -> Envelope a
env_circle_z a
z a
tc Envelope_Curve a
cc (Envelope [a]
l [a]
t [Envelope_Curve a]
c Maybe Int
rn Maybe Int
_ a
os) =
    let n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t
    in case Maybe Int
rn of
         Maybe Int
Nothing -> let l' :: [a]
l' = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
0]
                        t' :: [a]
t' = a
z a -> a -> a
forall a. Num a => a -> a -> a
* a
tc a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
1] -- inf (but drawings are poor)
                        c' :: [Envelope_Curve a]
c' = Envelope_Curve a
cc Envelope_Curve a -> [Envelope_Curve a] -> [Envelope_Curve a]
forall a. a -> [a] -> [a]
: Int -> [Envelope_Curve a] -> [Envelope_Curve a]
forall a. Int -> [a] -> [a]
take Int
n ([Envelope_Curve a] -> [Envelope_Curve a]
forall a. [a] -> [a]
cycle [Envelope_Curve a]
c) [Envelope_Curve a] -> [Envelope_Curve a] -> [Envelope_Curve a]
forall a. [a] -> [a] -> [a]
++ [Envelope_Curve a
forall a. Envelope_Curve a
EnvLin]
                        rn' :: Maybe Int
rn' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l' [a]
t' [Envelope_Curve a]
c' Maybe Int
rn' (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) a
os
         Just Int
i -> let l' :: [a]
l' = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l
                       t' :: [a]
t' = a
z a -> a -> a
forall a. Num a => a -> a -> a
* a
tc a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t
                       c' :: [Envelope_Curve a]
c' = Envelope_Curve a
cc Envelope_Curve a -> [Envelope_Curve a] -> [Envelope_Curve a]
forall a. a -> [a] -> [a]
: Int -> [Envelope_Curve a] -> [Envelope_Curve a]
forall a. Int -> [a] -> [a]
take Int
n ([Envelope_Curve a] -> [Envelope_Curve a]
forall a. [a] -> [a]
cycle [Envelope_Curve a]
c)
                       rn' :: Maybe Int
rn' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   in  [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l' [a]
t' [Envelope_Curve a]
c' Maybe Int
rn' (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) a
os

-- | env_circle_z with cycle time of zero.
env_circle_0 :: Fractional a => Envelope a -> Envelope a
env_circle_0 :: Envelope a -> Envelope a
env_circle_0 = a -> a -> Envelope_Curve a -> Envelope a -> Envelope a
forall a.
Fractional a =>
a -> a -> Envelope_Curve a -> Envelope a -> Envelope a
env_circle_z a
1 a
0 Envelope_Curve a
forall a. Envelope_Curve a
EnvLin

-- * Construct

{- | Trapezoidal envelope generator.

Requires (<=) and (>=) functions returning @1@ for true and @0@ for false.

The arguments are: 1. @shape@ determines the sustain time as a
proportion of @dur@, zero is a triangular envelope, one a rectangular
envelope; 2. @skew@ determines the attack\/decay ratio, zero is an
immediate attack and a slow decay, one a slow attack and an immediate
decay; 3. @duration@ in seconds; 4. @amplitude@ as linear gain.

-}
envTrapezoid_f :: Num t => (t -> t -> t,t -> t -> t) -> t -> t -> t -> t -> Envelope t
envTrapezoid_f :: (t -> t -> t, t -> t -> t) -> t -> t -> t -> t -> Envelope t
envTrapezoid_f (t -> t -> t
lte_f,t -> t -> t
gte_f) t
shape t
skew t
dur t
amp =
    let x1 :: t
x1 = t
skew t -> t -> t
forall a. Num a => a -> a -> a
* (t
1 t -> t -> t
forall a. Num a => a -> a -> a
- t
shape)
        bp :: [(t, t)]
bp = [(t
0,t -> t -> t
lte_f t
skew t
0)
             ,(t
x1,t
1)
             ,(t
shape t -> t -> t
forall a. Num a => a -> a -> a
+ t
x1,t
1)
             ,(t
1,t -> t -> t
gte_f t
skew t
1)]
    in [(t, t)] -> t -> t -> Envelope_Curve t -> Envelope t
forall n.
Num n =>
[(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n
envCoord [(t, t)]
bp t
dur t
amp Envelope_Curve t
forall a. Envelope_Curve a
EnvLin

{- | Coordinate based static envelope generator.  Points are (time,value) pairs.

> let e = envCoord [(0,0),(1/4,1),(1,0)] 1 1 EnvLin
> envelope_sc3_array e == Just [0,2,-99,-99,1,1/4,1,0,0,3/4,1,0]

> import Sound.SC3.Plot {- hsc3-plot -}

> plotEnvelope [envCoord [(0,0),(1/4,1),(1,0)] 1 1 EnvLin]

-}
envCoord :: Num n => [(n,n)] -> n -> n -> Envelope_Curve n -> Envelope n
envCoord :: [(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n
envCoord [(n, n)]
xy n
dur n
amp Envelope_Curve n
c = [(n, n, Envelope_Curve n)] -> Envelope n
forall n. Num n => [(n, n, Envelope_Curve n)] -> Envelope n
envXYC (((n, n) -> (n, n, Envelope_Curve n))
-> [(n, n)] -> [(n, n, Envelope_Curve n)]
forall a b. (a -> b) -> [a] -> [b]
map (\(n
x,n
y) -> (n
x n -> n -> n
forall a. Num a => a -> a -> a
* n
dur,n
y n -> n -> n
forall a. Num a => a -> a -> a
* n
amp,Envelope_Curve n
c)) [(n, n)]
xy)

-- | Segments given as pairs of (time,level).
--   The input is sorted by time before processing.
--
-- > envPairs [(0, 1), (3, 1.4), (2.1, 0.5)] EnvSin
envPairs :: (Num n,Ord n) => [(n,n)] -> Envelope_Curve n -> Envelope n
envPairs :: [(n, n)] -> Envelope_Curve n -> Envelope n
envPairs [(n, n)]
xy = [(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n
forall n.
Num n =>
[(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n
envCoord (((n, n) -> n) -> [(n, n)] -> [(n, n)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (n, n) -> n
forall a b. (a, b) -> a
fst [(n, n)]
xy) n
1 n
1

-- | Variant 'envPerc' with user specified 'Envelope_Curve a'.
envPerc_c :: Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envPerc_c :: a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envPerc_c a
atk a
rls a
lvl (Envelope_Curve a
c0,Envelope_Curve a
c1) =
    let c :: [Envelope_Curve a]
c = [Envelope_Curve a
c0,Envelope_Curve a
c1]
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a
0,a
lvl,a
0] [a
atk,a
rls] [Envelope_Curve a]
c Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing a
0

-- | Percussive envelope, with attack, release, level and curve
--   inputs.
envPerc :: Num a => a -> a -> Envelope a
envPerc :: a -> a -> Envelope a
envPerc a
atk a
rls =
    let cn :: Envelope_Curve a
cn = a -> Envelope_Curve a
forall a. a -> Envelope_Curve a
EnvNum (-a
4)
    in a -> a -> a -> Envelope_Curve_2 a -> Envelope a
forall a. Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envPerc_c a
atk a
rls a
1 (Envelope_Curve a
cn,Envelope_Curve a
cn)

-- | Triangular envelope, with duration and level inputs.
--
-- > let e = envTriangle 1 0.1
-- > in envelope_sc3_array e = Just [0,2,-99,-99,0.1,0.5,1,0,0,0.5,1,0]
envTriangle :: Fractional a => a -> a -> Envelope a
envTriangle :: a -> a -> Envelope a
envTriangle a
dur a
lvl =
    let c :: [Envelope_Curve a]
c = Int -> Envelope_Curve a -> [Envelope_Curve a]
forall a. Int -> a -> [a]
replicate Int
2 Envelope_Curve a
forall a. Envelope_Curve a
EnvLin
        d :: [a]
d = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
2 (a
dur a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a
0,a
lvl,a
0] [a]
d [Envelope_Curve a]
forall a. [Envelope_Curve a]
c Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing a
0

-- | Sine envelope, with duration and level inputs.
--
-- > let e = envSine 0 0.1
-- > in envelope_sc3_array e == Just [0,2,-99,-99,0.1,0,3.0,0,0,0,3,0]
envSine :: Fractional a => a -> a -> Envelope a
envSine :: a -> a -> Envelope a
envSine a
dur a
lvl =
    let c :: [Envelope_Curve a]
c = Int -> Envelope_Curve a -> [Envelope_Curve a]
forall a. Int -> a -> [a]
replicate Int
2 Envelope_Curve a
forall a. Envelope_Curve a
EnvSin
        d :: [a]
d = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
2 (a
dur a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a
0,a
lvl,a
0] [a]
d [Envelope_Curve a]
forall a. [Envelope_Curve a]
c Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing a
0

-- | Parameters for LINEN envelopes.
data LINEN a = LINEN {LINEN a -> a
linen_attackTime :: a
                     ,LINEN a -> a
linen_sustainTime :: a
                     ,LINEN a -> a
linen_releaseTime :: a
                     ,LINEN a -> a
linen_level :: a
                     ,LINEN a -> Envelope_Curve_3 a
linen_curve :: Envelope_Curve_3 a}

-- | SC3 defaults for LINEN.
linen_def :: Fractional t => LINEN t
linen_def :: LINEN t
linen_def = let c :: Envelope_Curve a
c = Envelope_Curve a
forall a. Envelope_Curve a
EnvLin in t -> t -> t -> t -> Envelope_Curve_3 t -> LINEN t
forall a. a -> a -> a -> a -> Envelope_Curve_3 a -> LINEN a
LINEN t
0.01 t
1 t
1 t
1 (Envelope_Curve t
forall a. Envelope_Curve a
c,Envelope_Curve t
forall a. Envelope_Curve a
c,Envelope_Curve t
forall a. Envelope_Curve a
c)

-- | Record ('LINEN') variant of 'envLinen'.
envLinen_r :: Num a => LINEN a -> Envelope a
envLinen_r :: LINEN a -> Envelope a
envLinen_r (LINEN a
aT a
sT a
rT a
lv (Envelope_Curve a
c0,Envelope_Curve a
c1,Envelope_Curve a
c2)) =
    let l :: [a]
l = [a
0,a
lv,a
lv,a
0]
        t :: [a]
t = [a
aT,a
sT,a
rT]
        c :: [Envelope_Curve a]
c = [Envelope_Curve a
c0,Envelope_Curve a
c1,Envelope_Curve a
c2]
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing a
0

-- | Variant of 'envLinen' with user specified 'Envelope_Curve a'.
envLinen_c :: Num a => a -> a -> a -> a -> Envelope_Curve_3 a -> Envelope a
envLinen_c :: a -> a -> a -> a -> Envelope_Curve_3 a -> Envelope a
envLinen_c a
aT a
sT a
rT a
lv Envelope_Curve_3 a
c = LINEN a -> Envelope a
forall a. Num a => LINEN a -> Envelope a
envLinen_r (a -> a -> a -> a -> Envelope_Curve_3 a -> LINEN a
forall a. a -> a -> a -> a -> Envelope_Curve_3 a -> LINEN a
LINEN a
aT a
sT a
rT a
lv Envelope_Curve_3 a
c)

{- | Linear envelope parameter constructor.

> e = envLinen 0 1 0 1
> s = envelope_segments e
> p = pack_envelope_segments s
> p == (env_levels e,env_times e,env_curves e)
-}
envLinen :: Num a => a -> a -> a -> a -> Envelope a
envLinen :: a -> a -> a -> a -> Envelope a
envLinen a
aT a
sT a
rT a
lv =
    let c :: (Envelope_Curve a, Envelope_Curve a, Envelope_Curve a)
c = (Envelope_Curve a
forall a. Envelope_Curve a
EnvLin,Envelope_Curve a
forall a. Envelope_Curve a
EnvLin,Envelope_Curve a
forall a. Envelope_Curve a
EnvLin)
    in a -> a -> a -> a -> Envelope_Curve_3 a -> Envelope a
forall a.
Num a =>
a -> a -> a -> a -> Envelope_Curve_3 a -> Envelope a
envLinen_c a
aT a
sT a
rT a
lv Envelope_Curve_3 a
forall a a a.
(Envelope_Curve a, Envelope_Curve a, Envelope_Curve a)
c

-- | Parameters for ADSR envelopes.
--   The sustain level is given as a proportion of the peak level.
data ADSR a = ADSR {ADSR a -> a
adsr_attackTime :: a
                   ,ADSR a -> a
adsr_decayTime :: a
                   ,ADSR a -> a
adsr_sustainLevel :: a
                   ,ADSR a -> a
adsr_releaseTime :: a
                   ,ADSR a -> a
adsr_peakLevel :: a
                   ,ADSR a -> Envelope_Curve_3 a
adsr_curve :: Envelope_Curve_3 a
                   ,ADSR a -> a
adsr_bias :: a}

-- | SC3 defaults for ADSR.
adsr_def :: Fractional n => ADSR n
adsr_def :: ADSR n
adsr_def = let c :: Envelope_Curve n
c = n -> Envelope_Curve n
forall a. a -> Envelope_Curve a
EnvNum (-n
4) in n -> n -> n -> n -> n -> Envelope_Curve_3 n -> n -> ADSR n
forall a.
a -> a -> a -> a -> a -> Envelope_Curve_3 a -> a -> ADSR a
ADSR n
0.01 n
0.3 n
0.5 n
1 n
1 (Envelope_Curve n
c,Envelope_Curve n
c,Envelope_Curve n
c) n
0

-- | Attack, decay, sustain, release envelope parameter constructor.
envADSR :: Num a => a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a
envADSR :: a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a
envADSR a
aT a
dT a
sL a
rT a
pL Envelope_Curve a
c a
b = ADSR a -> Envelope a
forall a. Num a => ADSR a -> Envelope a
envADSR_r (a -> a -> a -> a -> a -> Envelope_Curve_3 a -> a -> ADSR a
forall a.
a -> a -> a -> a -> a -> Envelope_Curve_3 a -> a -> ADSR a
ADSR a
aT a
dT a
sL a
rT a
pL (Envelope_Curve a
c,Envelope_Curve a
c,Envelope_Curve a
c) a
b)

-- | Variant with defaults for pL, c and b.
envADSR_def :: Num a => a -> a -> a -> a -> Envelope a
envADSR_def :: a -> a -> a -> a -> Envelope a
envADSR_def a
aT a
dT a
sL a
rT = a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a
forall a.
Num a =>
a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a
envADSR a
aT a
dT a
sL a
rT a
1 (a -> Envelope_Curve a
forall a. a -> Envelope_Curve a
EnvNum (-a
4)) a
0

-- | Record ('ADSR') variant of 'envADSR'.
envADSR_r :: Num a => ADSR a -> Envelope a
envADSR_r :: ADSR a -> Envelope a
envADSR_r (ADSR a
aT a
dT a
sL a
rT a
pL (Envelope_Curve a
c0,Envelope_Curve a
c1,Envelope_Curve a
c2) a
b) =
    let l :: [a]
l = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) [a
0,a
pL,a
pLa -> a -> a
forall a. Num a => a -> a -> a
*a
sL,a
0]
        t :: [a]
t = [a
aT,a
dT,a
rT]
        c :: [Envelope_Curve a]
c = [Envelope_Curve a
c0,Envelope_Curve a
c1,Envelope_Curve a
c2]
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Maybe Int
forall a. Maybe a
Nothing a
0

-- | Parameters for Roland type ADSSR envelopes.
data ADSSR a = ADSSR {ADSSR a -> a
adssr_attackTime :: a
                     ,ADSSR a -> a
adssr_attackLevel :: a
                     ,ADSSR a -> a
adssr_decayTime :: a
                     ,ADSSR a -> a
adssr_decayLevel :: a
                     ,ADSSR a -> a
adssr_slopeTime :: a
                     ,ADSSR a -> a
adssr_sustainLevel :: a
                     ,ADSSR a -> a
adssr_releaseTime :: a
                     ,ADSSR a -> Envelope_Curve_4 a
adssr_curve :: Envelope_Curve_4 a
                     ,ADSSR a -> a
adssr_bias :: a}

-- | Attack, decay, slope, sustain, release envelope parameter constructor.
envADSSR :: Num a => a -> a -> a -> a -> a -> a -> a -> Envelope_Curve a -> a -> Envelope a
envADSSR :: a
-> a
-> a
-> a
-> a
-> a
-> a
-> Envelope_Curve a
-> a
-> Envelope a
envADSSR a
t1 a
l1 a
t2 a
l2 a
t3 a
l3 a
t4 Envelope_Curve a
c a
b = ADSSR a -> Envelope a
forall a. Num a => ADSSR a -> Envelope a
envADSSR_r (a
-> a -> a -> a -> a -> a -> a -> Envelope_Curve_4 a -> a -> ADSSR a
forall a.
a
-> a -> a -> a -> a -> a -> a -> Envelope_Curve_4 a -> a -> ADSSR a
ADSSR a
t1 a
l1 a
t2 a
l2 a
t3 a
l3 a
t4 (Envelope_Curve a
c,Envelope_Curve a
c,Envelope_Curve a
c,Envelope_Curve a
c) a
b)

-- | Record ('ADSSR') variant of 'envADSSR'.
envADSSR_r :: Num a => ADSSR a -> Envelope a
envADSSR_r :: ADSSR a -> Envelope a
envADSSR_r (ADSSR a
t1 a
l1 a
t2 a
l2 a
t3 a
l3 a
t4 (Envelope_Curve a
c1,Envelope_Curve a
c2,Envelope_Curve a
c3,Envelope_Curve a
c4) a
b) =
    let l :: [a]
l = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) [a
0,a
l1,a
l2,a
l3,a
0]
        t :: [a]
t = [a
t1,a
t2,a
t3,a
t4]
        c :: [Envelope_Curve a]
c = [Envelope_Curve a
c1,Envelope_Curve a
c2,Envelope_Curve a
c3,Envelope_Curve a
c4]
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Maybe Int
forall a. Maybe a
Nothing a
0

-- | Parameters for ASR envelopes.
data ASR a = ASR {ASR a -> a
asr_attackTime :: a
                 ,ASR a -> a
asr_sustainLevel :: a
                 ,ASR a -> a
asr_releaseTime :: a
                 ,ASR a -> Envelope_Curve_2 a
asr_curve :: Envelope_Curve_2 a}

-- | SC3 default values for ASR.
asr_def :: Fractional t => ASR t
asr_def :: ASR t
asr_def = let c :: Envelope_Curve t
c = t -> Envelope_Curve t
forall a. a -> Envelope_Curve a
EnvNum (-t
4) in t -> t -> t -> Envelope_Curve_2 t -> ASR t
forall a. a -> a -> a -> Envelope_Curve_2 a -> ASR a
ASR t
0.01 t
1 t
1 (Envelope_Curve t
c,Envelope_Curve t
c)

-- | SC3 .asr has singular curve argument, hence _c suffix.
envASR_c :: Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envASR_c :: a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envASR_c a
aT a
sL a
rT Envelope_Curve_2 a
c = ASR a -> Envelope a
forall a. Num a => ASR a -> Envelope a
envASR_r (a -> a -> a -> Envelope_Curve_2 a -> ASR a
forall a. a -> a -> a -> Envelope_Curve_2 a -> ASR a
ASR a
aT a
sL a
rT Envelope_Curve_2 a
c)

{- | Attack, sustain, release envelope parameter constructor.

> c = 3
> r = Just [0,2,1,-99,0.1,3,c,0,0,2,c,0]
> envelope_sc3_array (envASR 3 0.1 2 EnvSin) == r
-}
envASR :: Num a => a -> a -> a -> Envelope_Curve a -> Envelope a
envASR :: a -> a -> a -> Envelope_Curve a -> Envelope a
envASR a
aT a
sL a
rT Envelope_Curve a
c = a -> a -> a -> Envelope_Curve_2 a -> Envelope a
forall a. Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envASR_c a
aT a
sL a
rT (Envelope_Curve a
c,Envelope_Curve a
c)

-- | Record ('ASR') variant of 'envASR'.
envASR_r :: Num a => ASR a -> Envelope a
envASR_r :: ASR a -> Envelope a
envASR_r (ASR a
aT a
sL a
rT (Envelope_Curve a
c0,Envelope_Curve a
c1)) =
    let l :: [a]
l = [a
0,a
sL,a
0]
        t :: [a]
t = [a
aT,a
rT]
        c' :: [Envelope_Curve a]
c' = [Envelope_Curve a
c0,Envelope_Curve a
c1]
    in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c' (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Maybe Int
forall a. Maybe a
Nothing a
0

-- | All segments are horizontal lines.
envStep :: Num a => [a] -> [a] -> Maybe Int -> Maybe Int -> Envelope a
envStep :: [a] -> [a] -> Maybe Int -> Maybe Int -> Envelope a
envStep [a]
levels [a]
times Maybe Int
releaseNode Maybe Int
loopNode =
    if [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
levels Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
times
    then String -> Envelope a
forall a. HasCallStack => String -> a
error String
"envStep: levels and times must have same size"
    else let levels' :: [a]
levels' = [a] -> a
forall a. [a] -> a
head [a]
levels a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
levels
         in [a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
levels' [a]
times [Envelope_Curve a
forall a. Envelope_Curve a
EnvStep] Maybe Int
releaseNode Maybe Int
loopNode a
0

-- | Segments given as triples of (time,level,curve).  The final curve is ignored.
--
-- > envXYC [(0, 1, EnvSin), (2.1, 0.5, EnvLin), (3, 1.4, EnvLin)]
envXYC :: Num n => [(n,n,Envelope_Curve n)] -> Envelope n
envXYC :: [(n, n, Envelope_Curve n)] -> Envelope n
envXYC [(n, n, Envelope_Curve n)]
xyc =
  let n :: Int
n = [(n, n, Envelope_Curve n)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(n, n, Envelope_Curve n)]
xyc
      ([n]
times,[n]
levels,[Envelope_Curve n]
curves) = [(n, n, Envelope_Curve n)] -> ([n], [n], [Envelope_Curve n])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(n, n, Envelope_Curve n)]
xyc
      offset :: n
offset = [n]
times [n] -> Int -> n
forall a. [a] -> Int -> a
!! Int
0
  in [n]
-> [n]
-> [Envelope_Curve n]
-> Maybe Int
-> Maybe Int
-> n
-> Envelope n
forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [n]
levels ([n] -> [n]
forall n. Num n => [n] -> [n]
Base.d_dx' [n]
times) (Int -> [Envelope_Curve n] -> [Envelope_Curve n]
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Envelope_Curve n]
curves) Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing n
offset

-- | Variant where the input is sorted by time before processing.
--
-- > envXYC_sort [(0, 1, EnvSin), (3, 1.4, EnvLin), (2.1, 0.5, EnvLin)]
envXYC_sort :: (Num n,Ord n) => [(n,n,Envelope_Curve n)] -> Envelope n
envXYC_sort :: [(n, n, Envelope_Curve n)] -> Envelope n
envXYC_sort = [(n, n, Envelope_Curve n)] -> Envelope n
forall n. Num n => [(n, n, Envelope_Curve n)] -> Envelope n
envXYC ([(n, n, Envelope_Curve n)] -> Envelope n)
-> ([(n, n, Envelope_Curve n)] -> [(n, n, Envelope_Curve n)])
-> [(n, n, Envelope_Curve n)]
-> Envelope n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((n, n, Envelope_Curve n) -> n)
-> [(n, n, Envelope_Curve n)] -> [(n, n, Envelope_Curve n)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(n
x,n
_,Envelope_Curve n
_) -> n
x)