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

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

import qualified Sound.Sc3.Common.Base as Base {- hsc3 -}
import qualified Sound.Sc3.Common.Math.Interpolate as Interpolate {- hsc3 -}

-- * 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
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
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 :: forall a. Num a => 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 :: forall a. Num a => 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 -> Interpolate.Interpolation_f t
env_curve_interpolation_f :: forall t.
(Ord t, Floating t) =>
Envelope_Curve t -> Interpolation_f t
env_curve_interpolation_f Envelope_Curve t
c =
    case Envelope_Curve t
c of
      Envelope_Curve t
EnvStep -> forall t. Interpolation_f t
Interpolate.step
      Envelope_Curve t
EnvLin -> forall t. Num t => Interpolation_f t
Interpolate.linear
      Envelope_Curve t
EnvExp -> forall t. Floating t => Interpolation_f t
Interpolate.exponential
      Envelope_Curve t
EnvSin -> forall t. Floating t => Interpolation_f t
Interpolate.sine
      Envelope_Curve t
EnvWelch -> forall t. (Ord t, Floating t) => Interpolation_f t
Interpolate.welch
      EnvNum t
n -> forall t. (Ord t, Floating t) => t -> Interpolation_f t
Interpolate.curve t
n
      Envelope_Curve t
EnvSqr -> forall t. Floating t => Interpolation_f t
Interpolate.squared
      Envelope_Curve t
EnvCub -> forall t. Floating t => Interpolation_f t
Interpolate.cubed
      Envelope_Curve t
EnvHold -> forall a. HasCallStack => a
undefined

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

-- * Envelope

-- | Sc3 envelope segment model
data Envelope a =
    Envelope
    {forall a. Envelope a -> [a]
env_levels :: [a] -- ^ Set of /n/ levels, n is >= 1
    ,forall a. Envelope a -> [a]
env_times :: [a] -- ^ Set of /n-1/ time intervals
    ,forall a. Envelope a -> [Envelope_Curve a]
env_curves :: [Envelope_Curve a] -- ^ Possibly empty curve set
    ,forall a. Envelope a -> Maybe Int
env_release_node :: Maybe Int -- ^ Maybe index to release node
    ,forall a. Envelope a -> Maybe Int
env_loop_node :: Maybe Int -- ^ Maybe index to loop node
    ,forall a. Envelope a -> a
env_offset :: a -- ^ An offset for all time values (IEnvGen only)
    }
    deriving (Envelope a -> Envelope a -> Bool
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
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_map :: (a -> b) -> Envelope a -> Envelope b
envelope_map :: forall a b. (a -> b) -> Envelope a -> Envelope b
envelope_map 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 forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope (forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
l) (forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
t) (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> Envelope_Curve a -> Envelope_Curve b
env_curve_map a -> b
f) [Envelope_Curve a]
c) Maybe Int
rn Maybe Int
ln (a -> b
f a
os)

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

{- | 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 :: forall a. Num a => [a] -> [a] -> [Envelope_Curve a] -> Envelope a
envelope [a]
l [a]
t [Envelope_Curve a]
c = forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c forall a. Maybe a
Nothing forall a. Maybe a
Nothing a
0

-- | Duration of 'Envelope', ie. 'sum' '.' 'env_times'.
envelope_duration :: Num n => Envelope n -> n
envelope_duration :: forall n. Num n => Envelope n -> n
envelope_duration = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall i n. Integral i => Envelope n -> i
envelope_n_segments = forall i a. Num i => [a] -> i
genericLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (Ord a, Num a) => Envelope a -> a -> Maybe Int
envelope_segment_ix Envelope a
e a
t =
    let d :: [a]
d = forall n. Num n => [n] -> [n]
Base.dx_d (forall a. Envelope a -> [a]
env_times Envelope a
e)
    in forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (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 :: forall t. Num t => Envelope t -> Int -> Envelope_Segment t
envelope_segment Envelope t
e Int
i =
    let l :: [t]
l = forall a. Envelope a -> [a]
env_levels Envelope t
e
        t :: [t]
t = forall a. Envelope a -> [a]
env_times Envelope t
e
        x0 :: t
x0 = [t]
l forall a. [a] -> Int -> a
!! Int
i
        x1 :: t
x1 = [t]
l forall a. [a] -> Int -> a
!! (Int
i forall a. Num a => a -> a -> a
+ Int
1)
        t0 :: t
t0 = (t
0 forall a. a -> [a] -> [a]
: forall n. Num n => [n] -> [n]
Base.dx_d [t]
t) forall a. [a] -> Int -> a
!! Int
i
        t1 :: t
t1 = t
t0 forall a. Num a => a -> a -> a
+ [t]
t forall a. [a] -> Int -> a
!! Int
i
        c :: Envelope_Curve t
c = forall a. Envelope a -> [Envelope_Curve a]
envelope_curves Envelope t
e 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 :: forall t. Num t => Envelope t -> [Envelope_Segment t]
envelope_segments Envelope t
e =
    let n :: Int
n = forall i n. Integral i => Envelope n -> i
envelope_n_segments Envelope t
e
    in forall a b. (a -> b) -> [a] -> [b]
map (forall t. Num t => Envelope t -> Int -> Envelope_Segment t
envelope_segment Envelope t
e) [Int
0 .. Int
n 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 :: forall t.
Num t =>
[Envelope_Segment t] -> ([t], [t], [Envelope_Curve t])
pack_envelope_segments [Envelope_Segment t]
s =
    case [Envelope_Segment t]
s of
      [] -> 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 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 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 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c} {d} {e}. (a, b, c, d, e) -> d
l [Envelope_Segment t]
s,forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {d} {e}. Num a => (a, b, a, d, e) -> a
t [Envelope_Segment t]
s,forall a b. (a -> b) -> [a] -> [b]
map 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 :: forall n. (Eq n, Num n) => Envelope n -> Bool
envelope_is_normal = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem n
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (Num a, Ord a) => Envelope a -> Envelope a
envelope_normalise Envelope a
e =
    let s :: [Envelope_Segment a]
s = 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 forall a. Ord a => a -> a -> Bool
<= a
t0
        s' :: [Envelope_Segment a]
s' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = 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 -> forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c forall a. Maybe a
Nothing forall a. Maybe a
Nothing a
os
         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 :: forall t. (Ord t, Floating t) => Envelope t -> t -> t
envelope_at Envelope t
e t
t =
    case 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) = forall t. Num t => Envelope t -> Int -> Envelope_Segment t
envelope_segment Envelope t
e Int
n
                    d :: t
d = t
t1 forall a. Num a => a -> a -> a
- t
t0
                    t' :: t
t' = (t
t forall a. Num a => a -> a -> a
- t
t0) forall a. Fractional a => a -> a -> a
/ t
d
                    f :: Interpolation_f t
f = forall t.
(Ord t, Floating t) =>
Envelope_Curve t -> Interpolation_f t
env_curve_interpolation_f Envelope_Curve t
c
                in if t
d 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 :: forall t.
(Ord t, Floating t, Enum t) =>
Int -> Envelope t -> [(t, t)]
envelope_render Int
n Envelope t
e =
    let d :: t
d = forall n. Num n => Envelope n -> n
envelope_duration Envelope t
e
        k :: t
k = t
d forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
- t
1)
        t :: [t]
t = [t
0,t
k .. t
d]
    in forall a b. [a] -> [b] -> [(a, b)]
zip [t]
t (forall a b. (a -> b) -> [a] -> [b]
map (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 :: forall t. (Ord t, Floating t, Enum t) => Int -> Envelope t -> [t]
envelope_table Int
n = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Envelope a -> [Envelope_Curve a]
envelope_curves Envelope a
e =
    let c :: [Envelope_Curve a]
c = forall a. Envelope a -> [Envelope_Curve a]
env_curves Envelope a
e
        n :: Int
n = forall i n. Integral i => Envelope n -> i
envelope_n_segments Envelope a
e
    in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Envelope_Curve a]
c
       then forall a. Int -> a -> [a]
replicate Int
n forall a. Envelope_Curve a
EnvLin
       else forall a. Int -> [a] -> [a]
take Int
n (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]
> let t = [0.1,0.02,0.4,1.1]
> let c = [EnvLin,EnvExp,EnvNum (-6),EnvSin]
> let e = Envelope l t c Nothing Nothing 0
> let 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]
> envelope_sc3_array e == Just r
-}
envelope_sc3_array :: Num a => Envelope a -> Maybe [a]
envelope_sc3_array :: forall a. Num a => 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t
        n' :: a
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        rn' :: a
rn' = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. a -> Maybe a -> a
fromMaybe (-Int
99) Maybe Int
rn)
        ln' :: a
ln' = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. a -> Maybe a -> a
fromMaybe (-Int
99) Maybe Int
ln)
        c :: [Envelope_Curve a]
c = 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,forall a. Num a => Envelope_Curve a -> a
env_curve_shape Envelope_Curve a
k,forall a. Num a => Envelope_Curve a -> a
env_curve_value Envelope_Curve a
k]
    in case [a]
l of
         a
l0:[a]
l' -> forall a. a -> Maybe a
Just (a
l0 forall a. a -> [a] -> [a]
: a
n' forall a. a -> [a] -> [a]
: a
rn' forall a. a -> [a] -> [a]
: a
ln' forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall {a}. Num a => a -> a -> Envelope_Curve a -> [a]
f [a]
l' [a]
t [Envelope_Curve a]
c))
         [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 :: forall a. Num a => 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t
        n' :: a
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        c :: [Envelope_Curve a]
c = 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,forall a. Num a => Envelope_Curve a -> a
env_curve_shape Envelope_Curve a
k,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' -> forall a. a -> Maybe a
Just (a
os forall a. a -> [a] -> [a]
: a
l0 forall a. a -> [a] -> [a]
: a
n' forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
t forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall {a}. Num a => a -> a -> Envelope_Curve a -> [a]
f [a]
l' [a]
t [Envelope_Curve a]
c))
         [a]
_ -> forall a. Maybe a
Nothing

-- | 'True' if 'env_release_node' is not 'Nothing'.
env_is_sustained :: Envelope a -> Bool
env_is_sustained :: forall a. Envelope a -> Bool
env_is_sustained = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. 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 l0 :: a
l0 = forall a. [a] -> a
head [a]
l
        l' :: [a]
l' = a
l0 forall a. a -> [a] -> [a]
: [a]
l
        t' :: [a]
t' = a
d forall a. a -> [a] -> [a]
: [a]
t
        c' :: [Envelope_Curve a]
c' = forall a. Envelope_Curve a
EnvLin forall a. a -> [a] -> [a]
: [Envelope_Curve a]
c
        rn' :: Maybe Int
rn' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
rn
        ln' :: Maybe Int
ln' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
ln
    in 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 :: forall a.
Fractional a =>
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 = 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 forall a. a -> [a] -> [a]
: [a]
l forall a. [a] -> [a] -> [a]
++ [a
0]
                        t' :: [a]
t' = a
z forall a. Num a => a -> a -> a
* a
tc forall a. a -> [a] -> [a]
: [a]
t forall a. [a] -> [a] -> [a]
++ [a
1] -- inf (but drawings are poor)
                        c' :: [Envelope_Curve a]
c' = Envelope_Curve a
cc forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
n (forall a. [a] -> [a]
cycle [Envelope_Curve a]
c) forall a. [a] -> [a] -> [a]
++ [forall a. Envelope_Curve a
EnvLin]
                        rn' :: Maybe Int
rn' = forall a. a -> Maybe a
Just (Int
n forall a. Num a => a -> a -> a
+ Int
1)
                    in 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' (forall a. a -> Maybe a
Just Int
0) a
os
         Just Int
i -> let l' :: [a]
l' = a
0 forall a. a -> [a] -> [a]
: [a]
l
                       t' :: [a]
t' = a
z forall a. Num a => a -> a -> a
* a
tc forall a. a -> [a] -> [a]
: [a]
t
                       c' :: [Envelope_Curve a]
c' = Envelope_Curve a
cc forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
n (forall a. [a] -> [a]
cycle [Envelope_Curve a]
c)
                       rn' :: Maybe Int
rn' = forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
1)
                   in  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' (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 :: forall a. Fractional a => Envelope a -> Envelope a
env_circle_0 = forall a.
Fractional a =>
a -> a -> Envelope_Curve a -> Envelope a -> Envelope a
env_circle_z a
1 a
0 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 :: forall t.
Num t =>
(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 forall a. Num a => a -> a -> a
* (t
1 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 forall a. Num a => a -> a -> a
+ t
x1,t
1)
             ,(t
1,t -> t -> t
gte_f t
skew t
1)]
    in forall n.
Num n =>
[(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n
envCoord [(t, t)]
bp t
dur t
amp 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 :: forall n.
Num n =>
[(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n
envCoord [(n, n)]
xy n
dur n
amp Envelope_Curve n
c = forall n. Num n => [(n, n, Envelope_Curve n)] -> Envelope n
envXyc (forall a b. (a -> b) -> [a] -> [b]
map (\(n
x,n
y) -> (n
x forall a. Num a => a -> a -> a
* n
dur,n
y 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 :: forall n.
(Num n, Ord n) =>
[(n, n)] -> Envelope_Curve n -> Envelope n
envPairs [(n, n)]
xy = forall n.
Num n =>
[(n, n)] -> n -> n -> Envelope_Curve n -> Envelope n
envCoord (forall b a. Ord b => (a -> b) -> [a] -> [a]
Base.sort_on forall a b. (a, b) -> a
fst [(n, n)]
xy) n
1 n
1

-- | Percussive envelope, with attack, release, level and curve inputs.
envPerc_c :: Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envPerc_c :: forall a. Num a => 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 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing a
0

-- | Percussive envelope, with attack and release inputs.
envPerc :: Num a => a -> a -> Envelope a
envPerc :: forall a. Num a => a -> a -> Envelope a
envPerc a
atk a
rls =
    let cn :: Envelope_Curve a
cn = forall a. a -> Envelope_Curve a
EnvNum (-a
4)
    in 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
-- > 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 :: forall a. Fractional a => a -> a -> Envelope a
envTriangle a
dur a
lvl =
    let c :: [Envelope_Curve a]
c = forall a. Int -> a -> [a]
replicate Int
2 forall a. Envelope_Curve a
EnvLin
        d :: [a]
d = forall a. Int -> a -> [a]
replicate Int
2 (a
dur forall a. Fractional a => a -> a -> a
/ a
2)
    in forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a
0,a
lvl,a
0] [a]
d forall {a}. [Envelope_Curve a]
c forall a. Maybe a
Nothing forall a. Maybe a
Nothing a
0

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

-- | Parameters for Linen envelopes.
data Linen a =
  Linen
  {forall a. Linen a -> a
linen_attackTime :: a
  ,forall a. Linen a -> a
linen_sustainTime :: a
  ,forall a. Linen a -> a
linen_releaseTime :: a
  ,forall a. Linen a -> a
linen_level :: a
  ,forall 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 :: forall t. Fractional t => Linen t
linen_def = let c :: Envelope_Curve a
c = forall a. Envelope_Curve a
EnvLin in forall a. a -> a -> a -> a -> Envelope_Curve_3 a -> Linen a
Linen t
0.01 t
1 t
1 t
1 (forall a. Envelope_Curve a
c,forall a. Envelope_Curve a
c,forall a. Envelope_Curve a
c)

-- | Record ('Linen') variant of 'envLinen'.
envLinen_r :: Num a => Linen a -> Envelope a
envLinen_r :: forall a. Num a => 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 forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c forall a. Maybe a
Nothing 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 :: 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
c = forall a. Num a => Linen a -> Envelope a
envLinen_r (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 :: forall a. Num a => 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 = (forall a. Envelope_Curve a
EnvLin,forall a. Envelope_Curve a
EnvLin,forall a. Envelope_Curve a
EnvLin)
    in forall a.
Num a =>
a -> a -> a -> a -> Envelope_Curve_3 a -> Envelope a
envLinen_c a
aT a
sT a
rT a
lv 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
  {forall a. Adsr a -> a
adsr_attackTime :: a
  ,forall a. Adsr a -> a
adsr_decayTime :: a
  ,forall a. Adsr a -> a
adsr_sustainLevel :: a
  ,forall a. Adsr a -> a
adsr_releaseTime :: a
  ,forall a. Adsr a -> a
adsr_peakLevel :: a
  ,forall a. Adsr a -> Envelope_Curve_3 a
adsr_curve :: Envelope_Curve_3 a
  ,forall a. Adsr a -> a
adsr_bias :: a}

-- | Sc3 defaults for Adsr.
adsr_def :: Fractional n => Adsr n
adsr_def :: forall n. Fractional n => Adsr n
adsr_def = let c :: Envelope_Curve n
c = forall a. a -> Envelope_Curve a
EnvNum (-n
4) in 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 :: 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
pL Envelope_Curve a
c a
b = forall a. Num a => Adsr a -> Envelope a
envAdsr_r (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 :: forall a. Num a => a -> a -> a -> a -> Envelope a
envAdsr_def a
aT a
dT a
sL a
rT = 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 (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 :: forall a. Num a => 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+ a
b) [a
0,a
pL,a
pLforall 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 forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c (forall a. a -> Maybe a
Just Int
2) forall a. Maybe a
Nothing a
0

-- | Parameters for Roland type Adssr envelopes.
data Adssr a =
  Adssr
  {forall a. Adssr a -> a
adssr_attackTime :: a
  ,forall a. Adssr a -> a
adssr_attackLevel :: a
  ,forall a. Adssr a -> a
adssr_decayTime :: a
  ,forall a. Adssr a -> a
adssr_decayLevel :: a
  ,forall a. Adssr a -> a
adssr_slopeTime :: a
  ,forall a. Adssr a -> a
adssr_sustainLevel :: a
  ,forall a. Adssr a -> a
adssr_releaseTime :: a
  ,forall a. Adssr a -> Envelope_Curve_4 a
adssr_curve :: Envelope_Curve_4 a
  ,forall 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 :: forall a.
Num a =>
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 = forall a. Num a => Adssr a -> Envelope a
envAdssr_r (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 :: forall a. Num a => 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 = forall a b. (a -> b) -> [a] -> [b]
map (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 forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c (forall a. a -> Maybe a
Just Int
3) forall a. Maybe a
Nothing a
0

-- | Parameters for Asr envelopes.
data Asr a =
  Asr
  {forall a. Asr a -> a
asr_attackTime :: a
  ,forall a. Asr a -> a
asr_sustainLevel :: a
  ,forall a. Asr a -> a
asr_releaseTime :: a
  ,forall 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 :: forall t. Fractional t => Asr t
asr_def = let c :: Envelope_Curve t
c = forall a. a -> Envelope_Curve a
EnvNum (-t
4) in 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 :: forall a. Num a => a -> a -> a -> Envelope_Curve_2 a -> Envelope a
envAsr_c a
aT a
sL a
rT Envelope_Curve_2 a
c = forall a. Num a => Asr a -> Envelope a
envAsr_r (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 :: forall a. Num a => a -> a -> a -> Envelope_Curve a -> Envelope a
envAsr a
aT a
sL a
rT Envelope_Curve a
c = 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 :: forall a. Num a => 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 forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
l [a]
t [Envelope_Curve a]
c' (forall a. a -> Maybe a
Just Int
1) forall a. Maybe a
Nothing a
0

-- | All segments are horizontal lines.
envStep :: Num a => [a] -> [a] -> Maybe Int -> Maybe Int -> Envelope a
envStep :: forall a.
Num a =>
[a] -> [a] -> Maybe Int -> Maybe Int -> Envelope a
envStep [a]
levels [a]
times Maybe Int
releaseNode Maybe Int
loopNode =
    if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
levels forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
times
    then forall a. HasCallStack => String -> a
error String
"envStep: levels and times must have same size"
    else let levels' :: [a]
levels' = forall a. [a] -> a
head [a]
levels forall a. a -> [a] -> [a]
: [a]
levels
         in forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [a]
levels' [a]
times [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 :: forall n. Num n => [(n, n, Envelope_Curve n)] -> Envelope n
envXyc [(n, n, Envelope_Curve n)]
xyc =
  let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(n, n, Envelope_Curve n)]
xyc
      ([n]
times,[n]
levels,[Envelope_Curve n]
curves) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(n, n, Envelope_Curve n)]
xyc
      offset :: n
offset = [n]
times forall a. [a] -> Int -> a
!! Int
0
  in forall a.
[a]
-> [a]
-> [Envelope_Curve a]
-> Maybe Int
-> Maybe Int
-> a
-> Envelope a
Envelope [n]
levels (forall n. Num n => [n] -> [n]
Base.d_dx' [n]
times) (forall a. Int -> [a] -> [a]
take (Int
n forall a. Num a => a -> a -> a
- Int
1) [Envelope_Curve n]
curves) forall a. Maybe a
Nothing 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 :: forall n.
(Num n, Ord n) =>
[(n, n, Envelope_Curve n)] -> Envelope n
envXyc_sort = forall n. Num n => [(n, n, Envelope_Curve n)] -> Envelope n
envXyc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
Base.sort_on (\(n
x,n
_,Envelope_Curve n
_) -> n
x)