-- | Envelopes
module Csound.Air.Envelope (
    leg, xeg,
    -- * Relative duration
    onIdur, lindur, expdur, linendur,
    onDur, lindurBy, expdurBy, linendurBy,    
    -- * Looping envelopes   
    lpshold, loopseg, loopxseg, lpsholdBy, loopsegBy, loopxsegBy,
    holdSeq, linSeq, expSeq,
    linloop, exploop, sah, stepSeq, 
    constSeq, triSeq, sqrSeq, sawSeq, isawSeq, xsawSeq, ixsawSeq, isqrSeq, xtriSeq,
    adsrSeq, xadsrSeq, adsrSeq_, xadsrSeq_,  

    -- * Faders
    fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades

) where

import Data.List(intersperse)

import Csound.Typed
import Csound.Typed.Opcode hiding (lpshold, loopseg, loopxseg)
import qualified Csound.Typed.Opcode as C(lpshold, loopseg, loopxseg)
import Csound.Air.Wave
import Csound.Tab(lins, exps, gp)
import Csound.Air.Wave(oscBy)
import Csound.Air.Filter(slide)

-- | Linear adsr envelope generator with release
--
-- > leg attack decay sustain release
leg :: D -> D -> D -> D -> Sig
leg = madsr

-- | Exponential adsr envelope generator with release
--
-- > xeg attack decay sustain release
xeg :: D -> D -> D -> D -> Sig
xeg a d s r = mxadsr a d (s + 0.00001) r

-- | Makes time intervals relative to the note's duration. So that:
--
-- > onIdur [a, t1, b, t2, c]
--
-- becomes: 
--
-- > [a, t1 * idur, b, t2 * idur, c]
onIdur :: [D] -> [D]
onIdur = onDur idur

-- | Makes time intervals relative to the note's duration. So that:
--
-- > onDur dt [a, t1, b, t2, c]
--
-- becomes: 
--
-- > [a, t1 * dt, b, t2 * dt, c]
onDur :: D -> [D] -> [D]
onDur dur xs = case xs of
    a:b:as -> a : b * dur : onDur dur as
    _ -> xs

-- | The opcode 'Csound.Opcode.linseg' with time intervals 
-- relative to the total duration of the note.
lindur :: [D] -> Sig
lindur = linseg . onIdur

-- | The opcode 'Csound.Opcode.expseg' with time intervals 
-- relative to the total duration of the note.
expdur :: [D] -> Sig
expdur = expseg . onIdur

-- | The opcode 'Csound.Opcode.linseg' with time intervals 
-- relative to the total duration of the note given by the user.
lindurBy :: D -> [D] -> Sig
lindurBy dt = linseg . onDur dt

-- | The opcode 'Csound.Opcode.expseg' with time intervals 
-- relative to the total duration of the note given by the user.
expdurBy :: D -> [D] -> Sig
expdurBy dt = expseg . onDur dt

-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of idur.
--
-- > linendur asig rise decay
linendur :: Sig -> D -> D -> Sig
linendur = linendurBy idur

-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of
-- the first argument.
--
-- > linendurBy dt asig rise decay
linendurBy :: D -> Sig -> D -> D -> Sig
linendurBy dt asig ris dec = linen asig (ris * dt) dt (dec * dt)

        
-- | Fades in with the given attack time.
fadeIn :: D -> Sig
fadeIn att = linseg [0, att, 1]

-- | Fades out with the given attack time.
fadeOut :: D -> Sig
fadeOut dec = linsegr [1] dec 0
        
-- | Fades in by exponent with the given attack time.
expFadeIn :: D -> Sig
expFadeIn att = expseg [0.0001, att, 1]

-- | Fades out by exponent with the given attack time.
expFadeOut :: D -> Sig
expFadeOut dec = expsegr [1] dec 0.0001

-- | A combination of fade in and fade out.
--
-- > fades attackDuration decayDuration
fades :: D -> D -> Sig
fades att dec = fadeIn att * fadeOut dec

-- | A combination of exponential fade in and fade out.
--
-- > expFades attackDuration decayDuration
expFades :: D -> D -> Sig
expFades att dec = expFadeIn att * expFadeOut dec

-- The step sequencer. It takes the weights of constant steps and the frequency of repetition.
-- It outputs the piecewise constant function with given values. Values are equally spaced
-- and repeated with given rate.
stepSeq :: [Sig] -> Sig -> Sig
stepSeq as = lpshold (intersperseEnd 1 [1] as)


-- | Sample and hold cyclic signal. It takes the list of
--
-- > [a, dta, b, dtb, c, dtc, ...]
--
-- the a, b, c, ... are values of the constant segments
--
-- the dta, dtb, dtc, are durations in seconds of constant segments.
--
-- The period of the repetition equals to the sum of all durations.
sah :: [Sig] -> Sig
sah as = stepSeq as (1 / period)
    where 
        period = sumDts as

        sumDts xs = case xs of
            a : dt : rest -> dt + sumDts rest
            _ -> 0

-- | It's just like @linseg@ but it loops over the envelope.
linloop :: [Sig] -> Sig
linloop = genLoop loopseg . (++ [0])

-- | It's just like @expseg@ but it loops over the envelope.
exploop :: [Sig] -> Sig
exploop = genLoop loopxseg . (++ [0])

genLoop :: ([Sig] -> Sig -> Sig) -> [Sig] -> Sig
genLoop f as = f (tfmList as) (1 / len)
    where
        tfmList xs = case xs of
            [] -> []
            [a] -> [a]
            a:b:rest -> a : (b/len) : tfmList rest

        len = go as
            where
                go xs = case xs of
                    []  -> 0
                    [a] -> 0
                    a:b:rest -> b + go rest

-- | Sample and hold sequence. It outputs the looping sequence of constan elements.
constSeq :: [Sig] -> Sig -> Sig
constSeq = genSeq stepSeq id 

-- | Step sequencer with unipolar triangle.
triSeq :: [Sig] -> Sig -> Sig
triSeq as cps = genSeq loopseg triList as (2 * cps)

-- | Step sequencer with unipolar square.
sqrSeq :: [Sig] -> Sig -> Sig
sqrSeq = genSeq stepSeq (intersperseEnd 0 [0])

-- | Step sequencer with unipolar sawtooth.
sawSeq :: [Sig] -> Sig -> Sig
sawSeq = genSeq loopseg sawList

-- | Step sequencer with unipolar inveted square.
isqrSeq :: [Sig] -> Sig -> Sig
isqrSeq = genSeq stepSeq ((0 : ) . intersperseEnd 0 [])

-- | Step sequencer with unipolar inveted sawtooth.
isawSeq :: [Sig] -> Sig -> Sig
isawSeq = genSeq loopseg isawList

-- | Step sequencer with unipolar exponential sawtooth.
xsawSeq :: [Sig] -> Sig -> Sig
xsawSeq = genSeq loopxseg sawList

-- | Step sequencer with unipolar inverted exponential sawtooth.
ixsawSeq :: [Sig] -> Sig -> Sig
ixsawSeq = genSeq loopxseg isawList

-- | Step sequencer with unipolar exponential triangle.
xtriSeq :: [Sig] -> Sig -> Sig
xtriSeq as cps = genSeq loopxseg triList as (2 * cps)

sawList xs = case xs of
    []  -> []           
    a:rest -> a : 1 : 0 : 0 : sawList rest
        
isawList xs = case xs of
    []  -> []           
    a:rest -> 0 : 1 : a : 0 : isawList rest

triList xs = case xs of
    [] -> [0, 0]
    a:rest -> 0 : 1 : a : 1 : triList rest 

------------------------------------------------------------------

genSeq :: ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq mkSeq go as cps = mkSeq (go as) (cps / len)
    where len = sig $ int $ length as

intersperseEnd :: a -> [a] -> [a] -> [a]
intersperseEnd val end xs = case xs of
    [] -> end
    [a] -> a : end
    a:as -> a : val : intersperseEnd val end as 

------------------------------------------------------------------

smooth :: Sig -> Sig
smooth = slide 0.001

-- | Looping sample and hold envelope. The first argument is the list of pairs:
--
-- > [a, durA, b, durB, c, durc, ...]
--
-- It's a list of values and durations. The durations are relative
-- to the period of repetition. The period is specified with the second argument.
-- The second argument is the frequency of repetition measured in Hz.
-- 
-- > lpshold valDurs frequency
lpshold :: [Sig] -> Sig -> Sig
lpshold as cps = smooth $ C.lpshold cps 0 0 as

-- | Looping linear segments envelope. The first argument is the list of pairs:
--
-- > [a, durA, b, durB, c, durc, ...]
--
-- It's a list of values and durations. The durations are relative
-- to the period of repetition. The period is specified with the second argument.
-- The second argument is the frequency of repetition measured in Hz.
-- 
-- > loopseg valDurs frequency
loopseg :: [Sig] -> Sig -> Sig
loopseg as cps = smooth $ C.loopseg cps 0 0 as

-- | Looping exponential segments envelope. The first argument is the list of pairs:
--
-- > [a, durA, b, durB, c, durc, ...]
--
-- It's a list of values and durations. The durations are relative
-- to the period of repetition. The period is specified with the second argument.
-- The second argument is the frequency of repetition measured in Hz.
-- 
-- > loopxseg valDurs frequency
loopxseg :: [Sig] -> Sig -> Sig
loopxseg as cps = smooth $ C.loopxseg cps 0 0 as

-- | It's like lpshold but we can specify the phase of repetition (phase belongs to [0, 1]).
lpsholdBy :: D -> [Sig] -> Sig -> Sig
lpsholdBy phase as cps = smooth $ C.lpshold cps 0 phase  as

-- | It's like loopseg but we can specify the phase of repetition (phase belongs to [0, 1]).
loopsegBy :: D -> [Sig] -> Sig -> Sig
loopsegBy phase as cps = smooth $ C.loopseg cps 0 phase  as

-- | It's like loopxseg but we can specify the phase of repetition (phase belongs to [0, 1]).
loopxsegBy :: D -> [Sig] -> Sig -> Sig
loopxsegBy phase as cps = smooth $ C.loopxseg cps 0 phase  as

-- | The looping ADSR envelope.
--
-- > xadsrSeq attack decay sustain release weights frequency
--
-- The sum of attack, decay, sustain and release time durations 
-- should be equal to one.
adsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
adsrSeq a d s r = linSeq (adsrList a d s r)

-- | The looping exponential ADSR envelope. there is a fifth segment
-- at the end of the envelope during which the envelope equals to zero.
--
-- > xadsrSeq attack decay sustain release weights frequency
--
-- The sum of attack, decay, sustain and release time durations 
-- should be equal to one.
xadsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
xadsrSeq a d s r = expSeq (adsrList a d s r)

-- | The looping ADSR envelope with the rest at the end.
--
-- > adsrSeq attack decay sustain release rest weights frequency
--
-- The sum of attack, decay, sustain, release and rest time durations 
-- should be equal to one.
adsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
adsrSeq_ a d s r rest = linSeq (adsrList_ a d s r rest)

-- | The looping exponential ADSR envelope. there is a fifth segment
-- at the end of the envelope during which the envelope equals to zero.
--
-- > xadsrSeq_ attack decay sustain release rest weights frequency
--
-- The sum of attack, decay, sustain, release and rest time durations 
-- should be equal to one.
xadsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
xadsrSeq_ a d s r rest = expSeq (adsrList_ a d s r rest)

adsrList :: Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList a d s r = [0, a, 1, d, s, 1 - (a + d + r), s, r, 0]

adsrList_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList_ a d s r rest = [0, a, 1, d, s, 1 - (a + d + r + rest), s, r, 0, rest, 0]

-- | The looping sequence of constant segments.
--
-- > linSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps
--
-- The first argument is the list that specifies the shape of the looping wave.
-- It's the alternating values and durations of transition from one value to another.
-- The durations are relative to the period. So that lists
--
-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]
--
-- produce the same results. The second list is the list of scales for subsequent periods.
-- Every value in the period is scaled with values from the second list.
-- The last argument is the rate of repetition (Hz).
holdSeq :: [Sig] -> [Sig] -> Sig -> Sig
holdSeq = genSegSeq lpshold

-- | The looping sequence of linear segments.
--
-- > linSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps
--
-- The first argument is the list that specifies the shape of the looping wave.
-- It's the alternating values and durations of transition from one value to another.
-- The durations are relative to the period. So that lists
--
-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]
--
-- produce the same results. The second list is the list of scales for subsequent periods.
-- Every value in the period is scaled with values from the second list.
-- The last argument is the rate of repetition (Hz).
linSeq :: [Sig] -> [Sig] -> Sig -> Sig
linSeq = genSegSeq loopseg

-- | The looping sequence of exponential segments.
--
-- > expSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps
--
-- The first argument is the list that specifies the shape of the looping wave.
-- It's the alternating values and durations of transition from one value to another.
-- The durations are relative to the period. So that lists
--
-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]
--
-- produce the same results. The second list is the list of scales for subsequent periods.
-- Every value in the period is scaled with values from the second list.
-- The last argument is the rate of repetition (Hz).
expSeq :: [Sig] -> [Sig] -> Sig -> Sig
expSeq = genSegSeq loopxseg

genSegSeq :: ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig
genSegSeq mkSeg shape weights cps = mkSeg (groupSegs $ fmap (scaleVals shape) weights) (cps / len)
    where 
        len = sig $ int $ length weights
        scaleVals xs k = case xs of
            [] -> []
            [a] -> [a * k]
            a:da:rest -> (a * k) : da : scaleVals rest k    

        groupSegs :: [[Sig]] -> [Sig]
        groupSegs as = concat $ intersperse [0] as