{-# Language FlexibleContexts #-}
-- | Effects
module Csound.Air.Fx(    
    -- * Reverbs
    reverbsc1, rever1, rever2, reverTime,
    smallRoom, smallHall, largeHall, magicCave,
    smallRoom2, smallHall2, largeHall2, magicCave2,

    room, chamber, hall, cave,

    -- ** Impulse Responce convolution reverbs
    --
    -- | Be careful with volumes. Some IRs can require scaling with really small coefficients like 0.01.
    -- 
    monoIR, stereoIR, stereoIR2, pmonoIR, pstereoIR, pstereoIR2, 
    monoIR', stereoIR', stereoIR2',
    ZConvSpec(..), zconv, zconv',

    -- * Delays
    MaxDelayTime, DelayTime, Feedback, Balance,
    echo, fvdelay, fvdelays, funDelays, tabDelay,
    PingPongSpec(..), pingPong, pingPong', csdPingPong,

    -- * Distortion
    distortion,

    -- * Chorus
    DepthSig, RateSig, WidthSig, ToneSig,
    chorus,
    -- solinaChorus, testSolinaChorus,

    -- * Flanger
    flange,

    -- * Phase
    phase1, harmPhase, powerPhase,

    -- * Effects with unit parameters
    -- | Implemented by Iain McCurdy's Csound code.

    DriveSig, SensitivitySig, BaseCps, Resonance, TimeSig, BitsReductionSig, FoldoverSig,
    TremWaveSig, RatioSig, FftSize,

    fxDistort, stChorus2, fxPhaser, 
    fxFlanger, analogDelay, fxEcho, fxFilter, 
    fxWhite, fxPink, equalizer, eq4, eq7,
    fxGain, 

    fxAnalogDelay, fxDistortion, fxFollower, fxReverse, fxLoFi, fxChorus2, fxAutoPan, fxTrem, fxPitchShifter, fxFreqShifter, {- , 
    fxRingModulator, , -}
    fxCompress,

    -- Eq
    audaciousEq,

    -- * Misc
    trackerSplice, pitchShifterDelay

) where

import Data.Boolean
import Data.Default

import Csound.Typed
import Csound.Tab(sines4, startEnds, setSize, elins, newTab, tabSizeSecondsPower2, tablewa, sec2rel)
import Csound.Typed.Opcode
import Csound.SigSpace
import Csound.Tab

import Csound.Air.Wave(Lfo, unipolar, oscBy, utri, white, pink)
import Csound.Air.Filter
import Csound.Typed.Plugins hiding(pitchShifterDelay,
    fxAnalogDelay, fxDistortion, fxEnvelopeFollower, fxFlanger, fxFreqShifter, fxLoFi, 
    fxPanTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2)

import qualified Csound.Typed.Plugins as P(pitchShifterDelay,
    fxAnalogDelay, fxDistortion, fxEnvelopeFollower, fxFlanger, fxFreqShifter, fxLoFi, 
    fxPanTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2, fxPingPong)

-- | Mono version of the cool reverberation opcode reverbsc.
--
-- > reverbsc1 asig feedbackLevel cutOffFreq
reverbsc1 :: Sig -> Feedback -> ToneSig -> Sig
reverbsc1 x k co = 0.5 * (a + b)
    where (a, b) = ar2 $ reverbsc x x k co


---------------------------------------------------------------------------
-- Reverbs

-- | Reverb with given time.
reverTime :: DelayTime -> Sig -> Sig
reverTime dt a =  nreverb a dt 0.3 

-- | Mono reverb (based on reverbsc)
--
-- > rever1 feedback asig
rever1 :: Feedback -> Sig -> (Sig, Sig)
rever1 fbk a = reverbsc a a fbk 12000

-- | Mono reverb (based on reverbsc)
--
-- > rever2 feedback (asigLeft, asigRight)
rever2 :: Feedback -> Sig2 -> Sig2
rever2 fbk (a1, a2) = (a1 + wa1, a2 + wa2)
    where (wa1, wa2) = reverbsc a1 a2 fbk 12000

-- | Mono reverb for small room.
smallRoom :: Sig -> (Sig, Sig)
smallRoom = rever1 0.6

-- | Mono reverb for small hall.
smallHall :: Sig -> (Sig, Sig)
smallHall = rever1 0.8

-- | Mono reverb for large hall.
largeHall :: Sig -> (Sig, Sig)
largeHall = rever1 0.9

-- | The magic cave reverb (mono).
magicCave :: Sig -> (Sig, Sig)
magicCave = rever1 0.99

-- | Stereo reverb for small room.
smallRoom2 :: Sig2 -> Sig2
smallRoom2 = rever2 0.6

-- | Stereo reverb for small hall.
smallHall2 :: Sig2 -> Sig2
smallHall2 = rever2 0.8

-- | Stereo reverb for large hall.
largeHall2 :: Sig2 -> Sig2
largeHall2 = rever2 0.9

-- | The magic cave reverb (stereo).
magicCave2 :: Sig2 -> Sig2
magicCave2 = rever2 0.99

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

-- | An alias for 
--
-- > let room dryWet asig = mixAt dryWet smallRoom2 asig
room :: MixAt Sig2 Sig2 a => Sig -> a -> AtOut Sig2 Sig2 a
room mx ain = mixAt mx smallRoom2 ain

-- | An alias for 
--
-- > let room dryWet asig = mixAt dryWet smallHall2 asig
chamber :: MixAt Sig2 Sig2 a => Sig -> a -> AtOut Sig2 Sig2 a
chamber mx ain = mixAt mx smallHall2 ain

-- | An alias for 
--
-- > let room dryWet asig = mixAt dryWet largeHall2 asig
hall :: MixAt Sig2 Sig2 a => Sig -> a -> AtOut Sig2 Sig2 a
hall mx ain = mixAt mx largeHall2 ain

-- | An alias for 
--
-- > let room dryWet asig = mixAt dryWet magicCave2 asig
cave :: MixAt Sig2 Sig2 a => Sig -> a -> AtOut Sig2 Sig2 a
cave mx ain = mixAt mx magicCave2 ain

---------------------------------------------------------------------------------
-- IR reverbs

-- | Fast zero delay convolution with impulse response that is contained in mono-audio file.
--
-- > monoIR irFile ain
monoIR :: FilePath -> Sig -> Sig
monoIR = monoIR' def

-- | Fast zero delay convolution with impulse response that is contained in mono-audio file.
-- We can specify aux parameters for convolution algorithm (see @zconv'@).
--
-- > monoIR' spec irFile ain
monoIR' :: ZConvSpec -> FilePath -> Sig -> Sig
monoIR' spec fileName ain = zconv' spec (wavLeft fileName) ain

-- | Fast zero delay convolution with impulse response that is contained in stereo-audio file.
--
-- > stereoIR irFile ain
stereoIR :: FilePath -> Sig2 -> Sig2
stereoIR = stereoIR' def

-- | Fast zero delay convolution with impulse response that is contained in stereo-audio file.
-- We can specify aux parameters for convolution algorithm (see @zconv'@).
--
-- > stereoIR' spec irFile ain
stereoIR' :: ZConvSpec -> FilePath -> Sig2 -> Sig2
stereoIR' spec fileName (ainL, ainR) = (zconv' spec (wavLeft fileName) ainL, zconv' spec (wavRight fileName) ainR)

-- | If IR is encoded in a couple of mono files.
stereoIR2 :: (FilePath, FilePath) -> Sig2 -> Sig2
stereoIR2 = stereoIR2' def

-- | If IR is encoded in a couple of mono files.
stereoIR2' :: ZConvSpec -> (FilePath, FilePath) -> Sig2 -> Sig2
stereoIR2' spec (file1, file2) (ainL, ainR) = (monoIR' spec file1 ainL, monoIR' spec file2 ainR)

-- | Precise mono IR with pconvolve (requires a lot of CPU).
pmonoIR :: FilePath -> Sig -> Sig
pmonoIR fileName ain = pconvolve ain (text fileName)

-- | Precise stereo IR with pconvolve (requires a lot of CPU).
pstereoIR :: FilePath -> Sig2 -> Sig2
pstereoIR fileName (ainL, ainR) = pconvolve ((ainL + ainR) * 0.5) (text fileName)

pstereoIR2 :: (FilePath, FilePath) -> Sig2 -> Sig2
pstereoIR2 (file1, file2) (ainL, ainR) = (pmonoIR file1 ainL, pmonoIR file2 ainR)
    

---------------------------------------------------------------------------------
-- Delays

-- | The maximum delay time.
type MaxDelayTime = D

-- | The delaya time
type DelayTime = Sig

-- | Feedback for delay
type Feedback = Sig

-- | Dry/Wet mix value (ranges from 0 to 1). The 0 is all dry. The 1 is all wet.
type Balance = Sig

-- | The simplest delay with feedback. Arguments are: delay length and decay ratio.
--
-- > echo delayLength ratio
echo :: MaxDelayTime -> Feedback -> Sig -> Sig
echo len fb x = x + flanger x (sig len) fb `withD` (len + 0.005)

-- | Delay with feedback. 
--
-- > fdelay maxDelayLength delayLength feedback balance
fvdelay :: MaxDelayTime -> DelayTime -> Feedback -> Sig -> Sig
fvdelay len dt fb a = a + flanger a dt fb `withD` len

-- | Multitap delay. Arguments are: max delay length, list of pairs @(delayLength, decayRatio)@,
-- balance of mixed signal with processed signal.
--
-- > fdelay maxDelayLength  delays balance asig
fvdelays :: MaxDelayTime -> [(DelayTime, Feedback)] -> Balance -> Sig -> SE Sig
fvdelays len dtArgs mx a = funDelays len (zip dts fs) mx a
    where 
        (dts, fbks) = unzip dtArgs
        fs = map (*) fbks


-- | Generic multitap delay. It's just like @fvdelays@ but instead of constant feedbackLevel 
-- it expects a function for processing a delayed signal on the tap.
--
-- > fdelay maxDelayLength  delays balance asig
funDelays :: MaxDelayTime -> [(DelayTime, Sig -> Sig)] -> Balance -> Sig -> SE Sig
funDelays len dtArgs mx a = do
    _ <- delayr len
    aDels <- mapM deltap3 dts
    delayw $ a + sum (zipWith ($) fs aDels)
    return $ a + mx * sum aDels 
    where (dts, fs) = unzip dtArgs

-- | Delay for functions that use some table (as a buffer). As granular synth or mincer.
--
-- > tabDelay fn maxDelayTime delayTime feedback balance asig
tabDelay :: (Tab -> Sig -> SE Sig) -> MaxDelayTime -> DelayTime -> Feedback -> Balance -> Sig -> SE Sig
tabDelay go maxLength delTim  kfeed kbalance asig = do
    buf <- newTab tabLen    
    ptrRef <- newRef (0 :: Sig)
    aresRef <- newRef (0 :: Sig)  
    ptr <- readRef ptrRef
    when1 (ptr >=* sig tabLen) $ do
        writeRef ptrRef 0
    ptr <- readRef ptrRef 

    let kphs = (ptr / sig tabLen) - (delTim/(sig $ tabLen / getSampleRate))
    awet <-go buf (wrap kphs 0 1)
    writeRef aresRef $ asig + kfeed * awet
    ares <- readRef aresRef
    writeRef ptrRef =<< tablewa buf ares 0
    return $ (1 - kbalance) * asig + kbalance * awet
    where
        tabLen = tabSizeSecondsPower2 maxLength

-- | Aux parameters for ping pong delay. 
-- They are maximum delay time, low pass filter center frequency and Pan width.
-- The defaults are @(5 sec, 3500, 0.3)@.
data PingPongSpec = PingPongSpec {
        pingPongMaxTime :: MaxDelayTime,
        pingPongDamp    :: Sig,
        pingPongWidth   :: Sig    
    }

instance Default PingPongSpec where
    def = PingPongSpec {
            pingPongMaxTime = 5,
            pingPongDamp    = 3500,
            pingPongWidth   = 0.6 
        }

-- | Ping-pong delay. 
--
-- > pingPong delayTime feedback mixLevel
pingPong :: DelayTime -> Feedback -> Balance -> Sig2 -> Sig2
pingPong delTime feedback mixLevel (ainL, ainR) = pingPong' def delTime feedback mixLevel (ainL, ainR)

-- | Ping-pong delay with miscellaneous arguments. 
--
-- > pingPong' spec delayTime feedback mixLevel
pingPong' :: PingPongSpec -> DelayTime -> Feedback -> Balance -> Sig2 -> Sig2    
pingPong' (PingPongSpec maxTime damp width) delTime feedback mixLevel (ainL, ainR) = 
    csdPingPong maxTime delTime damp feedback width mixLevel (ainL, ainR)

-- | Ping-pong delay defined in csound style. All arguments are present (nothing is hidden).
-- 
-- > csdPingPong maxTime delTime damp feedback width mixLevel (ainL, ainR)
csdPingPong :: MaxDelayTime -> DelayTime -> Sig -> Feedback -> Sig -> Balance -> Sig2 -> Sig2
csdPingPong maxTime delTime damp feedback width mixLevel (ainL, ainR) = P.fxPingPong maxTime mixLevel width damp delTime feedback (ainL, ainR)

-- fxPingPong iMaxDelTime kmix kwidth ktone ktime kfeedback (ainL, ainR) = ...

{- substituted with Csound UDO implementation
csdPingPong :: MaxDelayTime -> DelayTime -> Sig -> Feedback -> Sig -> Balance -> Sig2 -> SE Sig2
csdPingPong maxTime delTime damp feedback width mixLevel (ainL, ainR) = do
    afirst <- offsetDelay ainL   
    atapL  <- channelDelay afirst
    atapR  <- channelDelay ainR
    return $ mixControl $ widthControl afirst (atapL, atapR)
    where
        offsetDelay ain = do
            abuf <- delayr maxTime
            afirst <- deltap3 delTime
            let afirst1 = tone afirst damp
            delayw ain
            return afirst1

        channelDelay ain = do
            abuf <- delayr (2 * maxTime)
            atap <- deltap3 (2 * delTime)
            let atap1 = tone atap damp
            delayw (ain + atap1 * feedback)
            return atap1

        widthControl afirst (atapL, atapR) = (afirst + atapL + (1 - width) * atapR, atapR + (1 - width) * atapL)

        mixControl (atapL ,atapR) = (cfd mixLevel ainL atapL, cfd mixLevel ainR atapR)
-}

type DepthSig = Sig
type RateSig  = Sig
type WidthSig  = Sig
type ToneSig  = Sig

-- Distortion

-- | Distortion. 
--
-- > distort distLevel asig
distortion :: Sig -> Sig -> Sig
distortion pre asig = distort1 asig pre 0.5 0 0 `withD` 1

-- Chorus

-- | Chorus.
--
-- > chorus depth rate balance asig
chorus :: DepthSig -> RateSig -> Balance -> Sig -> SE Sig
chorus depth rate mx asig = do
    _ <- delayr 1.2
    adelSig <- deltap3 (0.03 * depth * oscBy fn (3 * rate) + 0.01)
    delayw asig
    return $ ntrpol asig adelSig mx
    where fn = sines4 [(0.5, 1, 180, 1)] -- U-shape parabola

-- Flanger

-- | Flanger. Lfo depth ranges in 0 to 1.
--
-- flanger lfo feedback balance asig
flange :: Lfo -> Feedback -> Balance -> Sig -> Sig
flange alfo fbk mx asig = ntrpol asig (flanger asig ulfo fbk) mx
    where ulfo = 0.0001 + 0.02 * unipolar alfo

-- Phaser

-- | First order phaser.
phase1 :: Sig -> Lfo -> Feedback -> Balance -> Sig -> Sig
phase1 ord alfo fbk mx asig = ntrpol asig (phaser1 asig (20 + unipolar alfo) ord fbk) mx  

-- | Second order phaser. Sweeping gaps in the timbre are placed harmonicaly
harmPhase :: Sig -> Lfo -> Sig -> Sig -> Feedback -> Balance -> Sig -> Sig
harmPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 1 sep fbk) mx

-- | Second order phaser. Sweeping gaps in the timbre are placed by powers of the base frequency.
powerPhase :: Sig -> Lfo -> Sig -> Sig -> Feedback -> Balance -> Sig -> Sig
powerPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 2 sep fbk) mx


-----------------------------------------------------------------
-- new effects

expScale :: Sig -> (Sig, Sig) -> Sig -> Sig
expScale steep (min, max) a = scale (expcurve a steep) max min

logScale :: Sig -> (Sig, Sig) -> Sig -> Sig
logScale steep (min, max) a = scale (logcurve a steep) max min

dryWetMix :: Sig -> (Sig, Sig)
dryWetMix kmix = (kDry, kWet) 
    where
        iWet = setSize 1024 $ elins [0, 1, 1]
        iDry = setSize 1024 $ elins [1, 1, 0]
        kWet = kr $ table kmix iWet `withD` 1
        kDry = kr $ table kmix iDry `withD` 1

fxWet :: (Num a, SigSpace a) => Sig -> a -> a -> a
fxWet mix ain aout = mul dry ain + mul wet aout
    where (dry, wet) = dryWetMix mix

-- Distortion 

-- | Distortion
--
-- > fxDistort level drive tone sigIn
fxDistort :: Feedback -> Sig -> ToneSig -> Sig -> Sig
fxDistort klevel kdrive ktone ain = aout * (scale klevel 0.8 0) * kGainComp1
    where
        aout = blp kLPF $ distort1 ain kpregain kpostgain 0 0

        drive = expScale 8 (0.01, 0.4) kdrive
        kGainComp1 = logScale 700 (5,1) ktone

        kpregain = 100 * drive
        kpostgain = 0.5 * ((1 - drive) * 0.4 + 0.6)

        kLPF = logScale 700 (200, 12000) ktone

-- Stereo chorus

-- | Stereo chorus.
--
-- > stChorus2 mix rate depth width sigIn
stChorus2 :: Balance -> RateSig -> DepthSig -> WidthSig -> Sig2 -> Sig2
stChorus2 kmix krate' kdepth kwidth (al, ar) = fxWet kmix (al, ar) (aoutL, aoutR)
    where 
        krate = expScale 20 (0.001, 7) krate'
        ilfoshape = setSize 131072 $ sines4 [(1, 0.5, 0, 0.5)]
        kporttime = linseg  [0, 0.001, 0.02]
        kChoDepth = interp $ portk  (kdepth*0.01) kporttime
        amodL = osciliktp   krate ilfoshape 0
        amodR = osciliktp   krate ilfoshape (kwidth*0.5)
        vdel mod x = vdelay x (mod * kChoDepth * 1000) (1.2 * 1000)
        aChoL = vdel amodL al
        aChoR = vdel amodR ar
        aoutL = 0.6 * (aChoL + al)
        aoutR = 0.6 * (aChoR + ar)

-- Analog delay

-- | Analog delay.
--
-- > analogDelay mix feedback time tone sigIn
analogDelay :: Balance -> Feedback -> DelayTime -> ToneSig -> Sig -> Sig
analogDelay kmix kfback ktime  ktone ain = P.fxAnalogDelay kmix kfback ktime  ktone ain

-- Filter

-- | Filter effect (a pair of butterworth low and high pass filters).
--
-- > fxFilter lowPassfFreq highPassFreq gain 
fxFilter :: Sig -> Sig -> Sig -> Sig -> Sig
fxFilter kLPF' kHPF' kgain' ain = mul kgain $ app (blp kLPF) $ app (bhp kHPF) $ ain 
    where 
        app f = f . f
        kLPF = scaleFreq kLPF' 
        kHPF = scaleFreq kHPF' 
        kgain = scale kgain' 20 0
        scaleFreq x = expScale 4 (20, 20000) x

-- Equalizer

-- | Equalizer
--
-- > equalizer gainsAndFrequencies gain sigIn
equalizer :: [(Sig, Sig)] -> Sig -> Sig -> Sig
equalizer fs gain ain0 = case fs of
    []   -> ain
    x:[] -> g 0 x ain
    x:y:[] -> mean [g 1 x ain, g 2 y ain]
    x:xs -> mean $ (g 1 x ain : ) $ (fmap (\y -> g 0 y ain) (init xs)) ++ [g 2 (last xs) ain]
    where
        iQ = 1
        iEQcurve = skipNorm $ setSize 4096 $ startEnds [1/64,4096,7.9,64]
        iGainCurve = skipNorm $ setSize 4096 $ startEnds [0.5,4096,3,4]
        g ty (gain, freq) asig = pareq  asig freq (table gain iEQcurve `withD` 1) iQ `withD` ty
        kgain = table gain iGainCurve `withD` 1
        ain = kgain * ain0

-- | Equalizer with frequencies: 100, 200, 400, 800, 1600, 3200, 6400
eq7 :: [Sig] -> Sig -> Sig -> Sig
eq7 gs = equalizer (zip gs $ fmap (100 * ) [1, 2, 4, 8, 16, 32, 64])

-- | Equalizer with frequencies: 100, 400, 1600, 6400
eq4 :: [Sig] -> Sig -> Sig -> Sig
eq4 gs = equalizer (zip gs $ fmap (100 * ) [1, 4, 16, 64])

-- | Gain
--
-- > fxGain gain sigIn
fxGain :: SigSpace a => Sig -> a -> a
fxGain = mul

-- Noise

-- | Adds filtered white noize to the signal
--
-- > fxWhite lfoFreq depth sigIn
fxWhite :: Sig -> Sig -> Sig -> SE Sig
fxWhite freq depth ain = do
    noise <- white
    return $ ain + 0.5 * depth * blp cps noise
    where cps = expScale 4 (20, 20000) freq

-- | Adds filtered pink noize to the signal
--
-- > fxWhite lfoFreq depth sigIn
fxPink :: Sig -> Sig -> Sig -> SE Sig
fxPink freq depth ain = do
    noise <- pink
    return $ ain + 0.5 * depth * blp cps noise
    where cps = expScale 4 (20, 20000) freq

-- Echo

-- | Simplified delay
--
-- > fxEcho maxDelayLength delTime feedback sigIn
fxEcho :: D -> Sig -> Sig -> Sig -> Sig
fxEcho maxLen ktime fback = fvdelay (5 * maxLen) (sig maxLen * 0.95 * kTime) fback
    where
        kporttime = linseg [0,0.001,0.1]
        kTime = portk   ktime  (kporttime*3)

-- | Instrument plays an input signal in different modes. 
-- The segments of signal can be played back and forth. 
-- 
-- > trackerSplice maxLength segLength mode
-- 
-- * @maxLength@ -- the maximum length of the played segment (in seconds)
--
-- * @segLength@ -- the segment length in seconds
--
-- * @mode@ -- mode of the playing. If it's 1 - only a part of the sample is plyaed and
--   it's played forward. The portion of the signal starts from the current playback point.
--   It lasts for segLength. If it's 2 - the segment is played in reverse. 
--   Other values produce the normal input signal.
--
-- Original author: Rory Walsh
--
-- Example:
--
-- > main = dac $ do    
-- >    let ev ch1 ch2 dt = fmap (\x -> (x, dt)) $ mconcat [
-- >          fmap (const 1.5) $ charOn ch1 
-- >        , fmap (const 2.5) $ charOn ch2 
-- >        , fmap (const 0) $ charOff ch1 <> charOff ch2]
-- > 
-- >    (k, dt) <- stepper (0, 0.1) $ ev 'q' 'w' 0.1 <> ev 'a' 's' 0.2 <> ev 'z' 'x' 0.4
-- >    mul 1.3 $ trackerSplice 0.8 dt (int' k) $ fst $ loopWav 1 "drumLoop.wav"
trackerSplice :: D -> Sig -> Sig -> Sig -> SE Sig
trackerSplice maxLength segLengthSeconds kmode asig = do
    setksmps 1
    kindxRef <- newRef (0 :: Sig)
    ksampRef <- newRef (1 :: D)
    aoutRef  <- newRef (0 :: Sig)

    buf <- newTab (tabSizeSecondsPower2 maxLength)
    let segLength = segLengthSeconds * sig getSampleRate
        andx = phasor (sig $ getSampleRate / ftlen buf)
        andx1 = delay andx 1
    tabw asig (andx * sig (ftlen buf)) buf
    ksamp <- readRef ksampRef
    let apos = samphold (andx1 * sig (ftlen buf)) (sig ksamp)

    whens [
        (kmode >=* 1 &&* kmode `lessThan` 2, do             
                kindx <- readRef kindxRef                             
                writeRef kindxRef $ ifB (kindx >* segLength) 0 (kindx + 1)                
                kindx <- readRef kindxRef
                when1 (kindx + apos >* sig (ftlen buf)) $ do
                    writeRef kindxRef $ (-segLength)

                kindx <- readRef kindxRef

                writeRef aoutRef $ table (apos + kindx) buf `withDs` [0, 1]
                writeRef ksampRef 0
        ), (kmode >=* 2 &&* kmode `lessThan` 3, do              
                kindx <- readRef kindxRef
                writeRef kindxRef $ ifB ((kindx+apos) <=* 0) (sig (ftlen buf) - apos) (kindx-1)
                kindx <- readRef kindxRef
                writeRef aoutRef $ table (apos+kindx) buf `withDs` [0, 1]
                writeRef ksampRef 0   
        )] (do
                writeRef ksampRef 1
                writeRef aoutRef asig)

    aout <-readRef aoutRef
    return aout



-- | Mean value.
mean :: Fractional a => [a] -> a
mean xs = sum xs / (fromIntegral $ length xs)

---------------------------------------------------
-- rename the arguments and comment

-- | PitchShifterDelay
-- 
-- A pitch shifter effect that employs delay lines
-- 
-- > pitchShifterDelay maxDelayTime delayTime (feedback1, feedback2) transposeRatio ain
--
-- Arguments
--
-- * @maxDelayTime @ --  maximum delay time (kdlt should not exceed this value)
--
-- * @transposeRatio @ --  pitch transposition (in semitones)
--
-- * @delayTime      @ --  delay time employed by the pitch shifter effect (should be within the range ksmps/sr and imaxdlt) 
--
-- * @feedback1      @ --  feedback using method 1 (output from delay taps are fed back directly into their own buffers before enveloping and mixing)
--
-- * @feedback2      @ --  feedback using method 2 (enveloped and mixed output from both taps is fed back into both buffers)-- 
--
-- * @ain            @ --  input audio to be pitch shifted
pitchShifterDelay :: MaxDelayTime -> (Feedback, Feedback) -> DelayTime -> Sig -> Sig -> Sig
pitchShifterDelay maxDelayTime (fb1, fb2) dlt ratio ain = P.pitchShifterDelay maxDelayTime (fb1, fb2) dlt ratio ain

-- | Delay line with low-pass filter in the feedback chain.
-- The filter adds natural decay to the echoes.
--
-- > fxAnalogDelay mixRatio delayTime feedback toneRatio ain
--
-- Note that the center frequency of the filter is measured in normalized units (form 0  to 1).
fxAnalogDelay :: Balance -> DelayTime -> Feedback -> ToneSig -> Sig -> Sig
fxAnalogDelay kmix kdelay kfback ktone ain = P.fxAnalogDelay kmix kdelay kfback ktone ain

type DriveSig = Sig

-- | Distortion unit with low-pass filter.
--
-- > fxDistortion driveLevel toneRatio ain
--
-- Note that the center frequency of the filter is measured in normalized units (form 0  to 1).
fxDistortion :: DriveSig -> ToneSig -> Sig -> Sig
fxDistortion kdrive ktone ain = P.fxDistortion 1 kdrive ktone ain

type SensitivitySig = Sig
type BaseCps = Sig
type Resonance = Sig

-- | Envelope follower. 
--
-- > fxFollower sensitivity baseFrequencyRatio resonance ain
--
-- Arguments:
--
-- * @sensitivity        @ --  sensitivity of the envelope follower (suggested range: 0 to 1)
--
-- * @baseFrequencyRatio @ --  base frequency of the filter before modulation by the input dynamics (range: 0 to 1)
--
-- ; @resonance          @ --  resonance of the lowpass filter (suggested range: 0 to 1)
fxFollower :: SensitivitySig -> BaseCps -> Resonance -> Sig -> Sig
fxFollower ksens kbaseFreq kreson = P.fxEnvelopeFollower ksens kbaseFreq (0.99 * kreson)

type TimeSig = Sig

-- | An effect that reverses an audio stream in chunks
--
-- > fxReverse time
--
-- @time@ -- the size of the chunck in seconds.
fxReverse :: TimeSig -> Sig -> Sig
fxReverse ktime = P.fxReverse ktime

-- | A flanger effect following the typical design of a so called 'stomp box'
-- 
-- >  fxFlanger rate depth delayTime feedback ain = 
--
-- Arguments
--
-- * @rate      @ --  rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
--
-- * @depth     @ --  depth of the lfo of the effect (range 0 to 1)
--
-- * @delayTime @ --  static delay offset of the flanging effect (range 0 to 1)
--
-- * @feedback  @ --  feedback and therefore intensity of the effect (range 0 to 1)
--
-- * @ain       @ --  input audio to which the flanging effect will be applied
fxFlanger :: RateSig -> DepthSig -> DelayTime -> Feedback -> Sig -> Sig
fxFlanger krate kdepth kdelay kfback ain = P.fxFlanger krate kdepth kdelay kfback ain

-- | Phaser
--
-- An phase shifting effect that mimics the design of a so called 'stomp box'
-- 
-- > fxPhaser rate depth freq fback ain
-- 
-- Arguments:
-- 
-- * @rate  @ --  rate of lfo of the effect (range 0 to 1)
--
-- * @depth @ --  depth of lfo of the effect (range 0 to 1)
--
-- * @freq  @ --  centre frequency of the phase shifting effect in octaves (suggested range 6 to 11)
--
-- * @fback @ --  feedback and therefore intensity of the effect (range 0 to 1)  
--
-- * @ain   @ --  input audio to be pitch shifted
fxPhaser :: RateSig -> DepthSig -> BaseCps -> Feedback -> Sig -> Sig
fxPhaser krate kdepth cps kfback ain = P.fxPhaser krate kdepth (6 + 5 * cps) kfback ain

type BitsReductionSig = Sig
type FoldoverSig = Sig

-- | LoFi
-- 
-- 'Low Fidelity' distorting effects of bit reduction and downsampling (foldover)
-- 
-- > fxLoFi  bits fold ain = ...
-- 
-- Arguments
-- 
-- * @bits  @ --  bit depth reduction (range 0 to 1)
--
-- * @fold  @ --  amount of foldover (range 0 to 1)    
--
-- * @ain   @ --  input audio to have low fidelity distortion effects applied
fxLoFi :: BitsReductionSig -> FoldoverSig -> Sig -> Sig
fxLoFi kbits kfold ain = P.fxLoFi (0.6 * kbits) kfold ain

-- | Stereo Chorus
-- 
-- A stereo chorus effect
-- 
-- > fxChorus2 rate depth width (ainLeft, ainRight)
-- 
-- Arguments
-- 
-- * @rate  @ --  rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
--
-- * @depth @ --  depth of the lfo of the effect (range 0 to 1)
--
-- * @width @ --  width of stereo widening (range 0 to 1)
--
-- * @ainX  @ --  input stereo signal
fxChorus2 :: RateSig -> DepthSig -> WidthSig -> Sig2 -> Sig2
fxChorus2 krate kdepth kwidth ain = P.fxChorus2 krate kdepth kwidth ain

type TremWaveSig = Sig

-- | Auto pan
-- 
-- > fxAutoPan wave rate depth ain
-- 
-- ; Arguments:
-- 
-- * @wave  @ --  waveform used by the lfo (0=sine 1=triangle 2=square)
--
-- * @rate  @ --  rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
--
-- * @depth @ --  depth of the lfo of the effect (range 0 to 1)
--
-- * @mode  @ --  mode of the effect (0=auto-panning 1=tremolo)
--
-- * @ain   @ --  input stereo audio
fxAutoPan :: TremWaveSig -> DepthSig -> RateSig -> Sig2 -> Sig2
fxAutoPan tremWave kdepth krate = P.fxPanTrem kdepth krate 0 tremWave

-- | Tremolo
-- 
-- tremolo effect
-- 
-- > fxTrem wave rate depth ain
-- 
-- ; Arguments:
-- 
-- * @wave  @ --  waveform used by the lfo (0=sine 1=triangle 2=square)
--
-- * @rate  @ --  rate control of the lfo of the effect *NOT IN HERTZ* (range 0 to 1)
--
-- * @depth @ --  depth of the lfo of the effect (range 0 to 1)
--
-- * @mode  @ --  mode of the effect (0=auto-panning 1=tremolo)
--
-- * @ain   @ --  input stereo audio
fxTrem :: TremWaveSig -> DepthSig -> RateSig -> Sig2 -> Sig2
fxTrem tremWave kdepth krate = P.fxPanTrem kdepth krate 1 tremWave

type RatioSig = Sig
type FftSize  = D

-- | PitchShifter
-- 
--  A pitch shifter effect based on FFT technology
-- 
-- > fxPitchShifter  fftSize mixRatio transposeRatio feedback ain
-- 
-- Arguments
-- 
-- * @fftSize  @ -- size for FFT analysis (good values 1024, 512, 256, 2048), the higher values introduce latency but lower values are less accurate.
--
-- * @mix      @ --  dry / wet mix of the output signal (range 0 to 1)
--
-- * @transpose@ -- pitch ratio
--
-- * @feedback @ --  control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1) 
--
-- * @ain      @ --  input audio to be pitch shifted
fxPitchShifter :: FftSize -> Balance -> RatioSig -> Feedback -> Sig -> Sig
fxPitchShifter ifftSize kmix ratio kfback = P.fxPitchShifter ifftSize kmix ratio kfback

-- | FreqShifter
-- ; ----------------
-- ; A frequency shifter effect using the hilbert filter
-- ;
-- ; aout  FreqShifter  adry,kmix,kfreq,kmult,kfback
-- ;
-- ; Performance
-- ; -----------
-- ; adry   --  input audio to be frequency shifted
-- ; kmix   --  dry / wet mix of the output signal (range 0 to 1)
-- ; kfreq  --  frequency of frequency shifter effect (suggested range -1000 to 1000)
-- ; kmult  --  multiplier of frequency value for fine tuning control (suggested range -1 to 1)
-- ; kfback --  control of the amount of output signal fed back into the input of the effect (suggested range 0 to 1)
fxFreqShifter :: Balance -> Sig -> Sig -> Feedback -> Sig -> Sig
fxFreqShifter kmix freq kmul kfback = P.fxFreqShifter kmix freq kmul kfback


-- | Compressor. All arguments are relative (range in 0 to 1).
--
-- > fxCompress thresh (loknee, hiknee) ratio (att, rel) gain ain
fxCompress :: Sig -> (Sig, Sig) -> Sig -> (Sig, Sig) -> Sig -> Sig -> Sig
fxCompress thresh (loknee, hiknee) ratio (att, rel) gain  x = gain' * compress x x thresh' loknee' hiknee' ratio' att' rel' 0.05
    where 
        gain' = ampdb $ onLin (-36, 36) gain
        thresh' = onLin (0, 120) thresh
        att' = onExp (0, 1) att
        rel' = onExp (0, 1) rel
        ratio' = onExp (1, 30000) ratio
        loknee' = onLin (0, 120) loknee
        hiknee' = onLin (0, 120) hiknee

        onLin (min, max) val = min + val * (max - min)
        onExp (min, max) val = scale (expcurve val 4) max min