module Csound.Catalog.Wave.WoodwindAlg(
    WoodwindSpec(..), RangeSpec(..), HarmSpec(..), AmpSpec(..), WaveSpec,
    fromSpec, byFreq,
    woodwind
) where

import Data.List (transpose, intersperse)
import Control.Monad
import Control.Monad.Trans.State

import Csound.Base hiding (fromSpec, sustain, select)

----------------------------------------------------------------
-- Deterministic random numbers

newtype Rnd a = Rnd { Rnd a -> State D a
unRnd :: State D a }

instance Functor Rnd where
    fmap :: (a -> b) -> Rnd a -> Rnd b
fmap a -> b
f (Rnd State D a
a) = State D b -> Rnd b
forall a. State D a -> Rnd a
Rnd (State D b -> Rnd b) -> State D b -> Rnd b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> State D a -> State D b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f State D a
a

instance Applicative Rnd where
    pure :: a -> Rnd a
pure = a -> Rnd a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: Rnd (a -> b) -> Rnd a -> Rnd b
(<*>) = Rnd (a -> b) -> Rnd a -> Rnd b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Rnd where
    return :: a -> Rnd a
return = State D a -> Rnd a
forall a. State D a -> Rnd a
Rnd (State D a -> Rnd a) -> (a -> State D a) -> a -> Rnd a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State D a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Rnd State D a
a) >>= :: Rnd a -> (a -> Rnd b) -> Rnd b
>>= a -> Rnd b
f = State D b -> Rnd b
forall a. State D a -> Rnd a
Rnd (State D b -> Rnd b) -> State D b -> Rnd b
forall a b. (a -> b) -> a -> b
$ State D a
a State D a -> (a -> State D b) -> State D b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rnd b -> State D b
forall a. Rnd a -> State D a
unRnd (Rnd b -> State D b) -> (a -> Rnd b) -> a -> State D b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rnd b
f

evalRnd :: Rnd a -> D -> a
evalRnd :: Rnd a -> D -> a
evalRnd = State D a -> D -> a
forall s a. State s a -> s -> a
evalState (State D a -> D -> a) -> (Rnd a -> State D a) -> Rnd a -> D -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rnd a -> State D a
forall a. Rnd a -> State D a
unRnd

rndNext :: Rnd ()
rndNext :: Rnd ()
rndNext = State D () -> Rnd ()
forall a. State D a -> Rnd a
Rnd (State D () -> Rnd ()) -> State D () -> Rnd ()
forall a b. (a -> b) -> a -> b
$ (D -> D) -> State D ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((D -> D) -> State D ()) -> (D -> D) -> State D ()
forall a b. (a -> b) -> a -> b
$ D -> D
forall a. SigOrD a => a -> a
frac' (D -> D) -> (D -> D) -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> D -> D
forall a. Num a => a -> a -> a
* D
105.947)

rndGet :: Rnd D
rndGet :: Rnd D
rndGet = State D D -> Rnd D
forall a. State D a -> Rnd a
Rnd (State D D -> Rnd D) -> State D D -> Rnd D
forall a b. (a -> b) -> a -> b
$ State D D
forall (m :: * -> *) s. Monad m => StateT s m s
get

rndWithin :: (D, D) -> Rnd D
rndWithin :: (D, D) -> Rnd D
rndWithin (D
imin, D
imax) = do
    D
iseed <- Rnd D
rndGet
    Rnd ()
rndNext
    D -> Rnd D
forall (m :: * -> *) a. Monad m => a -> m a
return (D -> Rnd D) -> D -> Rnd D
forall a b. (a -> b) -> a -> b
$ D
imin D -> D -> D
forall a. Num a => a -> a -> a
+ (D
imax D -> D -> D
forall a. Num a => a -> a -> a
- D
imin) D -> D -> D
forall a. Num a => a -> a -> a
* D
iseed

----------------------------------------------------------------
-- tools

randiPct :: D -> D -> Sig -> Rnd Sig
randiPct :: D -> D -> Sig -> Rnd Sig
randiPct D
pct D
cps Sig
asig = do
    D
iseed <- (D, D) -> Rnd D
rndWithin (D
0, D
1)
    Sig -> Rnd Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> Rnd Sig) -> Sig -> Rnd Sig
forall a b. (a -> b) -> a -> b
$ Sig
asig Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ (Sig -> Sig -> SE Sig
randi (D -> Sig
sig D
pct) (D -> Sig
sig D
cps) SE Sig -> D -> Sig
`withSeed` D
iseed))

minDt :: D -> D -> D
minDt :: D -> D -> D
minDt D
n D
x = D -> D -> D
forall a. (IfB a, OrdB a) => a -> a -> a
maxB D
x (D
n D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
getControlRate)

----------------------------------------------------------------
-- algorithm parameters

-- | Winds algorithm specification.
data WoodwindSpec = WoodwindSpec
    { WoodwindSpec -> (D, D, D) -> D -> ([(Sig, Tab)], D)
woodwindRange         :: (D, D, D) -> D -> ([(Sig, Tab)], D)
    , WoodwindSpec -> (D, D, D) -> D
woodwindVibratoDur    :: (D, D, D) -> D
    , WoodwindSpec -> ((D, D), (D, D), (D, D), (D, D))
woodwindFreqDeviation :: ((D, D), (D, D), (D, D), (D, D)) }

-- | Harmonics per pitch range.
data RangeSpec = RangeSpec
    { RangeSpec -> D
rangeFreq     :: D
    , RangeSpec -> D
rangeNorm     :: D
    , RangeSpec -> [HarmSpec]
rangeHarms    :: [HarmSpec] }

-- | The harmonics.
data HarmSpec = HarmSpec
    { HarmSpec -> AmpSpec
harmAmp   :: AmpSpec
    , HarmSpec -> WaveSpec
harmWave  :: WaveSpec }

-- | Envelopes for linseg
data AmpSpec = AmpSpec
    { AmpSpec -> [D]
ampAttack     :: [D]
    , AmpSpec -> [D]
ampSustain    :: [D]
    , AmpSpec -> [D]
ampDecay      :: [D] }

-- | Not scaled sine harmonics.
type WaveSpec = [Double]

----------------------------------------------------------------
-- The algorithm

-- | An emulation of the woodwindinstruments. Parameters
--
-- > woodwind spec seed vibDepth attack sustain decay brightnessLevel cps =
--
--
-- * spec - a specification of the algorithm
--
-- * seed - a seed for the random signals/numbers. It's in (0, 1)
--
-- * vibDepth -  Amount of the vibrato. It's in [-1, 1]
--
-- * attack - duration of the attack
--
-- * sustain - duration of the sustain
--
-- * decay - duration of the decay
--
-- * brightnessLevel - Controls the frequency of the low-pass filter. It's in (0, 1)
woodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> D -> Sig
woodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> D -> Sig
woodwind WoodwindSpec
spec D
seedVal D
vibPercent D
attack D
sustain D
decay D
brightnessLevel D
cps =
    Rnd Sig -> D -> Sig
forall a. Rnd a -> D -> a
evalRnd (WoodwindSpec -> D -> D -> D -> D -> D -> D -> Rnd Sig
rndWoodwind WoodwindSpec
spec D
vibPercent D
attack D
sustain D
decay D
brightnessLevel D
cps) D
seedVal

rndWoodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> Rnd Sig
rndWoodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> Rnd Sig
rndWoodwind WoodwindSpec
spec D
vibCoeff D
attack D
sustain D
decay D
brightnessLevel D
cps = do
    D
iphase  <- (D, D) -> Rnd D
rndWithin (D
0, D
1)
    (D, D, D)
durs    <- Rnd (D, D, D)
initDurations
    Sig
kfreq   <- D -> Sig -> Rnd Sig
woodwindVibrato (WoodwindSpec -> (D, D, D) -> D
woodwindVibratoDur WoodwindSpec
spec (D, D, D)
durs) (Sig -> Rnd Sig) -> Rnd Sig -> Rnd Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (((D, D), (D, D), (D, D), (D, D)) -> (D, D, D) -> Sig -> Rnd Sig
freqDeviation (WoodwindSpec -> ((D, D), (D, D), (D, D), (D, D))
woodwindFreqDeviation WoodwindSpec
spec) (D, D, D)
durs (Sig -> Rnd Sig) -> Sig -> Rnd Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
cps)

    let ([(Sig, Tab)]
harms1, D
inorm) = WoodwindSpec -> (D, D, D) -> D -> ([(Sig, Tab)], D)
woodwindRange WoodwindSpec
spec (D, D, D)
durs D
cps
    [(Sig, Tab)]
harms2 <- ((Sig, Tab) -> Rnd (Sig, Tab)) -> [(Sig, Tab)] -> Rnd [(Sig, Tab)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (D -> (Sig, Tab) -> Rnd (Sig, Tab)
ampVarOnHarm D
0.02) [(Sig, Tab)]
harms1
    Sig -> Rnd Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> Rnd Sig) -> Sig -> Rnd Sig
forall a b. (a -> b) -> a -> b
$ (D, D, D) -> D -> Sig -> Sig
brightness (D, D, D)
durs D
brightnessLevel (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [(Sig, Tab)] -> D -> D -> Sig -> Sig
sumHarms [(Sig, Tab)]
harms2 D
inorm D
iphase Sig
kfreq
    where
        initDurations :: Rnd (D, D, D)
        initDurations :: Rnd (D, D, D)
initDurations = do
            D
iattack <- (D, D) -> Rnd D
rndWithin (D
attack D -> D -> D
forall a. Num a => a -> a -> a
* D
0.9, D
attack D -> D -> D
forall a. Num a => a -> a -> a
* D
1.1)
            D
idecay  <- (D, D) -> Rnd D
rndWithin (D
decay  D -> D -> D
forall a. Num a => a -> a -> a
* D
0.9, D
decay  D -> D -> D
forall a. Num a => a -> a -> a
* D
1.1)
            (D, D, D) -> Rnd (D, D, D)
forall (m :: * -> *) a. Monad m => a -> m a
return (D -> D -> D
minDt D
6 D
iattack, D -> D -> D
minDt D
5 D
sustain, D -> D -> D
minDt D
6 D
idecay)

        woodwindVibrato :: D -> Sig -> Rnd Sig
        woodwindVibrato :: D -> Sig -> Rnd Sig
woodwindVibrato D
xdur Sig
asig = do
            let ivibdepth :: D
ivibdepth = D -> D
forall a. Num a => a -> a
abs (D
vibCoeff D -> D -> D
forall a. Num a => a -> a -> a
* D
cps)
            Sig
kvibdepth <- D -> D -> Sig -> Rnd Sig
randiPct D
0.1 D
5 (Sig -> Rnd Sig) -> Sig -> Rnd Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
ivibdepth Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [D] -> Sig
linseg [D
0.1, D
0.8 D -> D -> D
forall a. Num a => a -> a -> a
* D
xdur, D
1, D
0.2 D -> D -> D
forall a. Num a => a -> a -> a
* D
xdur, D
0.7]
            ~ [D
ivibr1, D
ivibr2, D
ivibr3] <- ((D, D) -> Rnd D) -> [(D, D)] -> Rnd [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (D, D) -> Rnd D
rndWithin ([(D, D)] -> Rnd [D]) -> [(D, D)] -> Rnd [D]
forall a b. (a -> b) -> a -> b
$ Int -> (D, D) -> [(D, D)]
forall a. Int -> a -> [a]
replicate Int
3 (D
0, D
1)
            Sig
kvibrate <- D -> D -> Sig -> Rnd Sig
randiPct D
0.1 D
5 (Sig -> Rnd Sig) -> Sig -> Rnd Sig
forall a b. (a -> b) -> a -> b
$
                BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D -> Sig
sig D
vibCoeff Sig -> Sig -> BoolSig
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* Sig
0)
                    -- if vibrato is positive it gets faster
                    ([D] -> Sig
linseg [D
2.5 D -> D -> D
forall a. Num a => a -> a -> a
+ D
ivibr1, D
xdur, D
4.5 D -> D -> D
forall a. Num a => a -> a -> a
+ D
ivibr2])
                    -- if vibrato is negative it gets slower
                    ([D] -> Sig
linseg [D
3.5 D -> D -> D
forall a. Num a => a -> a -> a
+ D
ivibr1, D
0.1, D
4.5 D -> D -> D
forall a. Num a => a -> a -> a
+ D
ivibr2, D
xdur D -> D -> D
forall a. Num a => a -> a -> a
- D
0.1, D
2.5 D -> D -> D
forall a. Num a => a -> a -> a
+ D
ivibr3])
            Sig -> Rnd Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> Rnd Sig) -> Sig -> Rnd Sig
forall a b. (a -> b) -> a -> b
$ Sig
asig Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
kvibdepth Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
osc Sig
kvibrate

        freqDeviation :: ((D, D), (D, D), (D, D), (D, D)) -> (D, D, D) -> Sig -> Rnd Sig
        freqDeviation :: ((D, D), (D, D), (D, D), (D, D)) -> (D, D, D) -> Sig -> Rnd Sig
freqDeviation ((D, D)
f1, (D, D)
f2, (D, D)
f3, (D, D)
f4) (D
iattack, D
isustain, D
idecay) Sig
asig = do
            ~ [D
fdev1, D
fdev2, D
fdev3, D
fdev4] <- ((D, D) -> Rnd D) -> [(D, D)] -> Rnd [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (D, D) -> Rnd D
rndWithin [(D, D)
f1, (D, D)
f2, (D, D)
f3, (D, D)
f4]
            Sig -> Rnd Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> Rnd Sig) -> Sig -> Rnd Sig
forall a b. (a -> b) -> a -> b
$ Sig
asig Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ [D] -> Sig
linseg [D
fdev1, D
iattack, D
fdev2, D
isustain, D
fdev3, D
idecay, D
fdev4])

        ampVar :: D -> Sig -> Rnd Sig
        ampVar :: D -> Sig -> Rnd Sig
ampVar D
pct = D -> D -> Sig -> Rnd Sig
randiPct D
pct D
10

        ampVarOnHarm :: D -> (Sig, Tab) -> Rnd (Sig, Tab)
        ampVarOnHarm :: D -> (Sig, Tab) -> Rnd (Sig, Tab)
ampVarOnHarm D
perct (Sig
amp, Tab
wt) = (Sig -> (Sig, Tab)) -> Rnd Sig -> Rnd (Sig, Tab)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Sig
x -> (Sig
x, Tab
wt)) (Rnd Sig -> Rnd (Sig, Tab)) -> Rnd Sig -> Rnd (Sig, Tab)
forall a b. (a -> b) -> a -> b
$ D -> Sig -> Rnd Sig
ampVar D
perct Sig
amp

        sumHarms :: [(Sig, Tab)] -> D -> D -> Sig -> Sig
        sumHarms :: [(Sig, Tab)] -> D -> D -> Sig -> Sig
sumHarms [(Sig, Tab)]
hs D
norm D
iphase Sig
kfreq = ( Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig D
norm) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$
            ((Sig, Tab) -> Sig) -> [(Sig, Tab)] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Sig
amp, Tab
wt) -> Sig -> Sig -> Tab -> Sig
oscili Sig
amp Sig
kfreq Tab
wt Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
iphase) [(Sig, Tab)]
hs

        brightness :: (D, D, D) -> D -> Sig -> Sig
        brightness :: (D, D, D) -> D -> Sig -> Sig
brightness (D
iattack, D
isustain, D
idecay) D
level Sig
asig = Sig -> Sig -> Sig
balance (Sig -> Sig -> Sig
tone Sig
asig Sig
env) Sig
asig
            where ifiltcut :: D
ifiltcut = D -> Tab -> D
forall a. SigOrD a => a -> Tab -> a
tablei (D
9 D -> D -> D
forall a. Num a => a -> a -> a
* D
level) (Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ WaveSpec -> Tab
doubles [Double
40, Double
40, Double
80, Double
160, Double
320, Double
640, Double
1280, Double
2560, Double
5120, Double
10240, Double
10240])
                  env :: Sig
env = [D] -> Sig
linseg [D
0, D
iattack, D
ifiltcut, D
isustain, D
ifiltcut, D
idecay, D
0]

----------------------------------------------------------------
-- Converting specification to signals

fromSpec :: [RangeSpec] -> (D, D, D) -> D -> ([(Sig, Tab)], D)
fromSpec :: [RangeSpec] -> (D, D, D) -> D -> ([(Sig, Tab)], D)
fromSpec [RangeSpec]
specs (D, D, D)
durs D
ifreq = ([(Sig, Tab)]
hs, D
inorm)
    where
        inorm :: D
inorm = D -> [(D, D)] -> D
forall a. Tuple a => D -> [(D, a)] -> a
byFreq D
ifreq ([(D, D)] -> D) -> [(D, D)] -> D
forall a b. (a -> b) -> a -> b
$ (RangeSpec -> (D, D)) -> [RangeSpec] -> [(D, D)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RangeSpec
x -> (RangeSpec -> D
rangeFreq RangeSpec
x, RangeSpec -> D
rangeNorm RangeSpec
x)) [RangeSpec]
specs
        hs :: [(Sig, Tab)]
hs    = ([HarmSpec] -> (Sig, Tab)) -> [[HarmSpec]] -> [(Sig, Tab)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> [(D, (Sig, Tab))] -> (Sig, Tab)
forall a. Tuple a => D -> [(D, a)] -> a
byFreq D
ifreq ([(D, (Sig, Tab))] -> (Sig, Tab))
-> ([HarmSpec] -> [(D, (Sig, Tab))]) -> [HarmSpec] -> (Sig, Tab)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [D] -> [(Sig, Tab)] -> [(D, (Sig, Tab))]
forall a b. [a] -> [b] -> [(a, b)]
zip [D]
freqs ([(Sig, Tab)] -> [(D, (Sig, Tab))])
-> ([HarmSpec] -> [(Sig, Tab)]) -> [HarmSpec] -> [(D, (Sig, Tab))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HarmSpec -> (Sig, Tab)) -> [HarmSpec] -> [(Sig, Tab)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((D, D, D) -> HarmSpec -> (Sig, Tab)
fromHarmSpec (D, D, D)
durs)) ([[HarmSpec]] -> [(Sig, Tab)]) -> [[HarmSpec]] -> [(Sig, Tab)]
forall a b. (a -> b) -> a -> b
$ [[HarmSpec]] -> [[HarmSpec]]
forall a. [[a]] -> [[a]]
transpose ([[HarmSpec]] -> [[HarmSpec]]) -> [[HarmSpec]] -> [[HarmSpec]]
forall a b. (a -> b) -> a -> b
$ (RangeSpec -> [HarmSpec]) -> [RangeSpec] -> [[HarmSpec]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RangeSpec -> [HarmSpec]
rangeHarms [RangeSpec]
specs

        freqs :: [D]
freqs = (RangeSpec -> D) -> [RangeSpec] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RangeSpec -> D
rangeFreq [RangeSpec]
specs

byFreq :: Tuple a => D -> [(D, a)] -> a
byFreq :: D -> [(D, a)] -> a
byFreq D
ifreq [(D, a)]
as = [(BoolSig, a)] -> a -> a
forall b. Tuple b => [(BoolSig, b)] -> b -> b
guardedTuple (((D, a) -> (BoolSig, a)) -> [(D, a)] -> [(BoolSig, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(D
cps, a
val) -> (D -> Sig
sig D
ifreq Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D -> Sig
sig D
cps, a
val)) ([(D, a)] -> [(BoolSig, a)]) -> [(D, a)] -> [(BoolSig, a)]
forall a b. (a -> b) -> a -> b
$ [(D, a)] -> [(D, a)]
forall a. [a] -> [a]
init [(D, a)]
as) ((D, a) -> a
forall a b. (a, b) -> b
snd ((D, a) -> a) -> (D, a) -> a
forall a b. (a -> b) -> a -> b
$ [(D, a)] -> (D, a)
forall a. [a] -> a
last [(D, a)]
as)


fromHarmSpec :: (D, D, D) -> HarmSpec -> (Sig, Tab)
fromHarmSpec :: (D, D, D) -> HarmSpec -> (Sig, Tab)
fromHarmSpec (D, D, D)
durs HarmSpec
spec = ((D, D, D) -> AmpSpec -> Sig
fromAmpSpec (D, D, D)
durs (AmpSpec -> Sig) -> AmpSpec -> Sig
forall a b. (a -> b) -> a -> b
$ HarmSpec -> AmpSpec
harmAmp HarmSpec
spec, WaveSpec -> Tab
fromWaveSpec (WaveSpec -> Tab) -> WaveSpec -> Tab
forall a b. (a -> b) -> a -> b
$ HarmSpec -> WaveSpec
harmWave HarmSpec
spec)

fromAmpSpec :: (D, D, D) -> AmpSpec -> Sig
fromAmpSpec :: (D, D, D) -> AmpSpec -> Sig
fromAmpSpec (D
attack, D
sustain, D
decay) AmpSpec
spec = [D] -> Sig
linseg ([D] -> Sig) -> [D] -> Sig
forall a b. (a -> b) -> a -> b
$ [D]
att [D] -> [D] -> [D]
forall a. [a] -> [a] -> [a]
++ ([D] -> [D]
forall a. [a] -> [a]
tail [D]
sus) [D] -> [D] -> [D]
forall a. [a] -> [a] -> [a]
++ ([D] -> [D]
forall a. [a] -> [a]
tail [D]
dec)
    where phi :: a -> (AmpSpec -> [a]) -> [a]
phi a
dt AmpSpec -> [a]
select = a -> [a] -> [a]
forall a. a -> [a] -> [a]
intersperse (a
dt a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ AmpSpec -> [a]
select AmpSpec
spec)) (AmpSpec -> [a]
select AmpSpec
spec)
          att :: [D]
att = D -> (AmpSpec -> [D]) -> [D]
forall a. Fractional a => a -> (AmpSpec -> [a]) -> [a]
phi D
attack  AmpSpec -> [D]
ampAttack
          sus :: [D]
sus = D -> (AmpSpec -> [D]) -> [D]
forall a. Fractional a => a -> (AmpSpec -> [a]) -> [a]
phi D
sustain AmpSpec -> [D]
ampSustain
          dec :: [D]
dec = D -> (AmpSpec -> [D]) -> [D]
forall a. Fractional a => a -> (AmpSpec -> [a]) -> [a]
phi D
decay   AmpSpec -> [D]
ampDecay

fromWaveSpec :: WaveSpec -> Tab
fromWaveSpec :: WaveSpec -> Tab
fromWaveSpec = Tab -> Tab
skipNorm (Tab -> Tab) -> (WaveSpec -> Tab) -> WaveSpec -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaveSpec -> Tab
sines