module Synthesizer.Modifiers.Envelopes
  where

import Synthesizer.Structure (Length, Sample, SamplingRate,
                              SoundEvent (SoundEvent))

type Step          = Double
type AttackLength  = Double
type DecayLength   = Double
type SustainLevel  = Double
type ReleaseLength = Double
type TotalLength   = Length

data Envelope = Envelope {
    Envelope -> AttackLength
attackLength  :: AttackLength, -- ^ The time it takes a note to rise to its highest volume (in seconds)
    Envelope -> AttackLength
decayLength   :: DecayLength,  -- ^ The time it takes a note to falls to the sustain level (in seconds)
    Envelope -> AttackLength
sustainLevel  :: SustainLevel, -- ^ The percentage of the maximum volume which the decay length will fall to (between 0 and 1)
    Envelope -> AttackLength
releaseLength :: ReleaseLength -- ^ The time it takes a note to completely fall from the sustain level to silent (in seconds)
} deriving (Int -> Envelope -> ShowS
[Envelope] -> ShowS
Envelope -> String
(Int -> Envelope -> ShowS)
-> (Envelope -> String) -> ([Envelope] -> ShowS) -> Show Envelope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Envelope] -> ShowS
$cshowList :: [Envelope] -> ShowS
show :: Envelope -> String
$cshow :: Envelope -> String
showsPrec :: Int -> Envelope -> ShowS
$cshowsPrec :: Int -> Envelope -> ShowS
Show)

-- | Apply an envelope to a SoundEvent. This creates a new SoundEvent with changed properties
applyEnvelope :: Envelope -> SoundEvent -> SoundEvent
applyEnvelope :: Envelope -> SoundEvent -> SoundEvent
applyEnvelope Envelope
envelope SoundEvent
soundEvent = AttackLength
-> AttackLength -> (Int -> [AttackLength]) -> SoundEvent
SoundEvent AttackLength
startTime AttackLength
newEventLength Int -> [AttackLength]
newSamples
    where
        SoundEvent AttackLength
startTime AttackLength
eventLength Int -> [AttackLength]
samples = SoundEvent
soundEvent
        (Envelope AttackLength
attackLength AttackLength
decayLength AttackLength
sustainLevel AttackLength
releaseLength) = Envelope
envelope
        newEventLength :: AttackLength
newEventLength = AttackLength
eventLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
+ AttackLength
releaseLength
        newSamples :: SamplingRate -> [Sample]
        newSamples :: Int -> [AttackLength]
newSamples Int
samplingRate = [AttackLength]
appliedSamples [AttackLength] -> [AttackLength] -> [AttackLength]
forall a. [a] -> [a] -> [a]
++ [AttackLength]
releaseSamples
            where
                -- Samples
                appliedSamples :: [AttackLength]
appliedSamples = (AttackLength -> AttackLength -> AttackLength)
-> [AttackLength] -> [AttackLength] -> [AttackLength]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
(*) [AttackLength]
envelopeSteps [AttackLength]
input
                input :: [AttackLength]
input = Int -> [AttackLength]
samples Int
samplingRate

                -- ReleaseSamples - release needs the sound after the original samples
                releaseSamples :: [AttackLength]
releaseSamples =  (AttackLength -> AttackLength -> AttackLength)
-> [AttackLength] -> [AttackLength] -> [AttackLength]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
(*) [AttackLength]
releaseSteps [AttackLength]
releaseInput
                releaseInput :: [AttackLength]
releaseInput = Int -> [AttackLength] -> [AttackLength]
forall a. Int -> [a] -> [a]
drop ([AttackLength] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AttackLength]
envelopeSteps) [AttackLength]
input
                releaseSteps :: [AttackLength]
releaseSteps = [AttackLength]
rd

                -- The envelope steps
                envelopeSteps :: [Double]
                envelopeSteps :: [AttackLength]
envelopeSteps = [AttackLength]
ad [AttackLength] -> [AttackLength] -> [AttackLength]
forall a. [a] -> [a] -> [a]
++ [AttackLength]
dd [AttackLength] -> [AttackLength] -> [AttackLength]
forall a. [a] -> [a] -> [a]
++ [AttackLength]
sd

                sr :: Double
                sr :: AttackLength
sr = Int -> AttackLength
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
samplingRate

                -- Calculate the attack steps based on attack length
                ad :: [Step] -- [0.0, ..., 1.0]
                ad :: [AttackLength]
ad = AttackLength -> AttackLength -> [AttackLength]
getAttackSteps AttackLength
attackLength AttackLength
sr

                -- Calculate the decay steps based on decay length
                dd :: [Step] -- [1.0, .., sustainLevel]
                dd :: [AttackLength]
dd = AttackLength -> AttackLength -> AttackLength -> [AttackLength]
getDecaySteps AttackLength
decayLength AttackLength
sustainLevel AttackLength
sr

                -- Calculate the sustain steps based on sustain level
                sd :: [Step] --  [sustainLevel]
                sd :: [AttackLength]
sd = AttackLength
-> AttackLength
-> AttackLength
-> AttackLength
-> AttackLength
-> [AttackLength]
getSustainSteps AttackLength
sustainLevel AttackLength
eventLength AttackLength
attackLength AttackLength
decayLength AttackLength
sr

                -- TODO: the release stepper could start above the sustain level if attack and decay are longer than the eventLength
                -- Calculate the release steps based on release length
                rd :: [Step] -- [sustainLevel, ..., 0.0]
                rd :: [AttackLength]
rd = AttackLength -> AttackLength -> AttackLength -> [AttackLength]
getReleaseSteps AttackLength
sustainLevel AttackLength
releaseLength AttackLength
sr


type SamplingRateConverted = Double

-- | Calculate the attack steps based on attack length
getAttackSteps :: AttackLength -> SamplingRateConverted -> [Step]
getAttackSteps :: AttackLength -> AttackLength -> [AttackLength]
getAttackSteps AttackLength
attackLength AttackLength
samplingRate = [AttackLength
0.0, AttackLength
step .. AttackLength
1.0]
  where
    step :: AttackLength
step = AttackLength
1.0 AttackLength -> AttackLength -> AttackLength
forall a. Fractional a => a -> a -> a
/ (AttackLength
attackLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
* AttackLength
samplingRate)

-- | Calculate the decay steps based on decay length
getDecaySteps :: DecayLength -> SustainLevel -> SamplingRateConverted -> [Step]
getDecaySteps :: AttackLength -> AttackLength -> AttackLength -> [AttackLength]
getDecaySteps AttackLength
0 AttackLength
sustainLevel AttackLength
samplingRate = []
-- special case where sustain level would never decrease and steps would be infinite
getDecaySteps AttackLength
decayLength AttackLength
1 AttackLength
samplingRate = Int -> AttackLength -> [AttackLength]
forall a. Int -> a -> [a]
replicate (AttackLength -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (AttackLength
decayLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
* AttackLength
samplingRate)) AttackLength
1
getDecaySteps AttackLength
decayLength AttackLength
sustainLevel AttackLength
samplingRate = [AttackLength] -> [AttackLength]
forall a. [a] -> [a]
tail [AttackLength
1.0, (AttackLength
1.0 AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
- AttackLength
step) .. AttackLength
sustainLevel]
  where
    step :: AttackLength
step = (AttackLength
1.0 AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
- AttackLength
sustainLevel) AttackLength -> AttackLength -> AttackLength
forall a. Fractional a => a -> a -> a
/ (AttackLength
decayLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
* AttackLength
samplingRate)

-- | Calculate the sustain steps based on sustain level
getSustainSteps :: SustainLevel -> TotalLength -> AttackLength -> DecayLength -> SamplingRateConverted -> [Step]
getSustainSteps :: AttackLength
-> AttackLength
-> AttackLength
-> AttackLength
-> AttackLength
-> [AttackLength]
getSustainSteps AttackLength
sustainLevel AttackLength
eventLength AttackLength
attackLength AttackLength
decayLength AttackLength
samplingRate = Int -> AttackLength -> [AttackLength]
forall a. Int -> a -> [a]
replicate (AttackLength -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (AttackLength
sustainLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
* AttackLength
samplingRate)) AttackLength
sustainLevel
  where
    sustainLength :: AttackLength
sustainLength = AttackLength
eventLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
- AttackLength
attackLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
- AttackLength
decayLength

-- | Calculate the release steps based on the release length and the sustain level
getReleaseSteps :: SustainLevel -> ReleaseLength -> SamplingRateConverted -> [Step]
getReleaseSteps :: AttackLength -> AttackLength -> AttackLength -> [AttackLength]
getReleaseSteps AttackLength
sustainLevel AttackLength
0 AttackLength
samplingRate = []
getReleaseSteps AttackLength
sustainLevel AttackLength
releaseLength AttackLength
samplingRate  = [AttackLength] -> [AttackLength]
forall a. [a] -> [a]
tail [AttackLength
sustainLevel, (AttackLength
sustainLevel AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
- AttackLength
step) .. AttackLength
0.0]
  where
    step :: AttackLength
step = AttackLength
1 AttackLength -> AttackLength -> AttackLength
forall a. Fractional a => a -> a -> a
/ (AttackLength
releaseLength AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
* AttackLength
samplingRate) AttackLength -> AttackLength -> AttackLength
forall a. Num a => a -> a -> a
* AttackLength
sustainLevel