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

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

import qualified Safe {- safe -}

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
  | -- | Note: not implemented at Sc3
    EnvWelch
  | 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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> Envelope_Curve a -> ShowS
showsPrec :: Int -> Envelope_Curve a -> ShowS
$cshow :: forall a. Show a => Envelope_Curve a -> String
show :: Envelope_Curve a -> String
$cshowList :: forall a. Show a => [Envelope_Curve a] -> ShowS
showList :: [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 -> Interpolation_f t
forall t. Interpolation_f t
Interpolate.step
    Envelope_Curve t
EnvLin -> Interpolation_f t
forall t. Num t => Interpolation_f t
Interpolate.linear
    Envelope_Curve t
EnvExp -> Interpolation_f t
forall t. Floating t => Interpolation_f t
Interpolate.exponential
    Envelope_Curve t
EnvSin -> Interpolation_f t
forall t. Floating t => Interpolation_f t
Interpolate.sine
    Envelope_Curve t
EnvWelch -> Interpolation_f t
forall t. (Ord t, Floating t) => Interpolation_f t
Interpolate.welch
    EnvNum t
n -> t -> Interpolation_f t
forall t. (Ord t, Floating t) => t -> Interpolation_f t
Interpolate.curve t
n
    Envelope_Curve t
EnvSqr -> Interpolation_f t
forall t. Floating t => Interpolation_f t
Interpolate.squared
    Envelope_Curve t
EnvCub -> Interpolation_f t
forall t. Floating t => Interpolation_f t
Interpolate.cubed
    Envelope_Curve t
EnvHold -> Interpolation_f t
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 -> 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
  { 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
(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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> Envelope a -> ShowS
showsPrec :: Int -> Envelope a -> ShowS
$cshow :: forall a. Show a => Envelope a -> String
show :: Envelope a -> String
$cshowList :: forall a. Show a => [Envelope a] -> ShowS
showList :: [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 [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_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 = (a -> b) -> Envelope a -> Envelope b
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 = [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 :: forall n. Num n => Envelope n -> n
envelope_duration = [n] -> n
forall a. Num a => [a] -> a
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 :: forall i n. Integral i => 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 :: forall a. (Ord a, Num a) => 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 :: forall t. Num t => 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. HasCallStack => [a] -> Int -> a
!! Int
i
      x1 :: t
x1 = [t]
l [t] -> Int -> t
forall a. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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 = 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 :: 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
    [] -> 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 :: forall n. (Eq n, Num n) => 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 :: forall a. (Num a, Ord a) => 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 :: forall t. (Ord t, Floating t) => 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 :: forall t.
(Ord t, Floating t, Enum t) =>
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 :: forall t. (Ord t, Floating t, Enum t) => 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 :: forall a. 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 a. [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. HasCallStack => [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.0,1.0,-99.0,-99.0,1.0,0.1,1.0,0.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]
>>> envelope_sc3_array (Envelope l t c Nothing Nothing 0)
Just [0.0,4.0,-99.0,-99.0,0.6,0.1,1.0,0.0,0.3,2.0e-2,2.0,0.0,1.0,0.4,5.0,-6.0,0.0,1.1,3.0,0.0]
-}
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 = [a] -> Int
forall a. [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.

>>> 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
>>> envelope_sc3_ienvgen_array e
Just [0.0,0.0,4.0,1.62,0.1,1.0,0.0,0.6,2.0e-2,2.0,0.0,0.3,0.4,5.0,-6.0,1.0,1.1,3.0,0.0,0.0]
-}
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 = [a] -> Int
forall a. [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 a. Num 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 :: forall a. 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 :: 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 = String -> [a] -> a
forall a. HasCallStack => String -> [a] -> a
Safe.headNote String
"env_delay" [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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 :: 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 = [a] -> Int
forall a. [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. HasCallStack => [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. HasCallStack => [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 :: forall a. Fractional a => 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 :: 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 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.0,2.0,-99.0,-99.0,1.0,0.25,1.0,0.0,0.0,0.75,1.0,0.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 = [(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.

>>> env_levels (envPairs [(0, 1), (3, 1.4), (2.1, 0.5)] EnvSin)
[1.0,0.5,1.4]
-}
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 = [(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]
Base.sort_on (n, n) -> n
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 [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 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 = 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
>>> envelope_sc3_array e
Just [0.0,2.0,-99.0,-99.0,0.1,0.5,1.0,0.0,0.0,0.5,1.0,0.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 = 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.

>>> envelope_sc3_array (envSine 0 0.1)
Just [0.0,2.0,-99.0,-99.0,0.1,0.0,3.0,0.0,0.0,0.0,3.0,0.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 = 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
  { 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 = 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 :: 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 [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 :: 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 = 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.

>>> let e = envLinen 0 1 0 1
>>> let s = envelope_segments e
>>> let p = pack_envelope_segments s
>>> p == (env_levels e,env_times e,env_curves e)
True
-}
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 = (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
  { 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 = 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 :: 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 = 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 :: forall a. Num a => 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 :: 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 = (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
pL a -> 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
  { 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 = 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 :: 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 = (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
  { 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 = 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 :: 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 = 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.

>>> envelope_sc3_array (envAsr 3 0.1 2 EnvSin)
Just [0.0,2.0,1.0,-99.0,0.1,3.0,3.0,0.0,0.0,2.0,3.0,0.0]
-}
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 = 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 :: 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 [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 :: forall a.
Num a =>
[a] -> [a] -> Maybe Int -> Maybe Int -> Envelope a
envStep [a]
levels [a]
times Maybe Int
releaseNode Maybe Int
loopNode =
  if [a] -> Int
forall a. [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 a. [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' = String -> [a] -> a
forall a. HasCallStack => String -> [a] -> a
Safe.headNote String
"envStep" [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.

>>> env_levels (envXyc [(0, 1, EnvSin), (2.1, 0.5, EnvLin), (3, 1.4, EnvLin)])
[1.0,0.5,1.4]
-}
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 = [(n, n, Envelope_Curve n)] -> Int
forall a. [a] -> 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. HasCallStack => [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.

>>> env_levels (envXyc_sort [(0, 1, EnvSin), (3, 1.4, EnvLin), (2.1, 0.5, EnvLin)])
[1.0,0.5,1.4]
-}
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 = [(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]
Base.sort_on (\(n
x, n
_, Envelope_Curve n
_) -> n
x)