-- | A gallery of sound processors (effects).
module Csound.Catalog.Effect(
    nightChorus, nightReverb,
    vibroDelay, delayLine, bassEnhancment, declick,
    sweepFilter, loopSweepFilter,
    -- * Presets
    bayAtNight, vestigeOfTime
) where

import Control.Monad

import Csound.Base hiding (dur, filt, del)

-- | A signal goes throgh the chain of varible delays.
-- Delay time is affected by vibrato.
--
-- > aout = vibroDelay n delayBufferSize vibDepth vibRate asig
--
-- * @n@ -- number of delay lines
--
-- * @delayBufSize@ -- buffer size for the delay lines (it should be greater
-- than absolute maximum of the depth of the vibrato)
--
-- * @vibDepth@ -- the amplitude of the delay line time vibrato
--
-- * @vibRate@ -- the frequency of the delay lie time vibrato
vibroDelay :: Int -> D -> Sig -> Sig -> Sig -> Sig
vibroDelay :: Int -> D -> Sig -> Sig -> Sig -> Sig
vibroDelay Int
order D
delayBufSize Sig
vibDepth Sig
vibRate Sig
asig = Sig -> Sig -> Sig
balance Sig
aout Sig
asig
    where aout :: Sig
aout = [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> [Sig] -> [Sig]
forall a. Int -> [a] -> [a]
take Int
order ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> Sig -> [Sig]
forall a. (a -> a) -> a -> [a]
iterate Sig -> Sig
del Sig
asig
          del :: Sig -> Sig
del Sig
x = Sig -> Sig -> D -> Sig
vdelay Sig
x (Sig
vibDepth Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
uosc Sig
vibRate) D
delayBufSize

-- | Chorus effect, borrowed from http://www.jlpublishing.com/Csound.htm
-- I made some of its parameters accesible trhough score
-- delay in milliseconds (by John Lato in Csound)
--
-- > nightChorus idlym iscale asig
--
-- * idlym  -- delay in milliseconds
--
-- * iscale -- amplitude of the vibrato on delay time (in milliseconds).
nightChorus :: D -> D -> Sig -> Sig
nightChorus :: D -> D -> Sig -> Sig
nightChorus D
idlym D
iscale Sig
asig = Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
aout
    where
        phi :: Sig -> D -> Sig
phi Sig
cps D
maxDel = Sig -> Sig -> D -> Sig
vdelay3 Sig
asig (D -> Sig
sig (D
idlym D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
5) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ D -> Sig
sig (D
idlym D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
iscale) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
osc Sig
cps) D
maxDel
        aout :: Sig
aout = [Sig] -> Sig
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> D -> Sig) -> [Sig] -> [D] -> [Sig]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Sig -> D -> Sig
phi
            [Sig
1, Sig
0.995, Sig
1.05, Sig
1]
            [D
900, D
700, D
700, D
900]

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-- | Reverb
--
-- A bunch of delay lines FDN reverb, with feedback matrix based upon
-- physical modeling scattering junction of 8 lossless waveguides
-- of equal characteristic impedance. Based on Julius O. Smith III,
-- \"A New Approach to Digital Reverberation using Closed Waveguide
-- Networks,\" Proceedings of the International Computer Music
-- Conference 1985, p. 47-53 (also available as a seperate
-- publication from CCRMA), as well as some more recent papers by
-- Smith and others.
--
-- Coded by Sean Costello, October 1999 (in Csound)
--
-- > nightReverb n igain ipitchmod itone cps
--
--  * @n@               -- a number of delay lines (typical value is 8)
--
--  * @igain@           -- gain of reverb. adjust empirically
--                      for desired reverb time. 0.6 gives
--                      a good small \"live\" room sound, 0.8
--                      a small hall, 0.9 a large hall,
--                      0.99 an enormous stone cavern.
--
--  * @ipitchmod@      -- amount of random pitch modulation
--                     for the delay lines. 1 is the \"normal\"
--                     amount, but this may be too high for
--                     held pitches such as piano tones.
--                     adjust to taste.
--
--  * @itone@           -- cutoff frequency of lowpass filters
--                       in feedback loops of delay lines,
--                       in hz. lower cutoff frequencies results
--                       in a sound with more high-frequency
--                       damping.
--
nightReverb :: Int -> D -> D -> D -> Sig -> SE (Sig, Sig)
nightReverb :: Int -> D -> D -> D -> Sig -> SE (Sig, Sig)
nightReverb Int
n D
igain D
ipitchmod D
itone Sig
asig = do
    [Ref Sig]
afiltRefs   <- (Sig -> SE (Ref Sig)) -> [Sig] -> SE [Ref Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newRef ([Sig] -> SE [Ref Sig]) -> [Sig] -> SE [Ref Sig]
forall a b. (a -> b) -> a -> b
$ Int -> Sig -> [Sig]
forall a. Int -> a -> [a]
replicate Int
n Sig
0
    [Sig]
afilts1     <- (Ref Sig -> SE Sig) -> [Ref Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef [Ref Sig]
afiltRefs
    let apj :: Sig
apj     = (Sig
2 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Int -> Sig
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [Sig] -> Sig
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Sig]
afilts1
    [Sig]
adels       <- [SE Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([SE Sig] -> SE [Sig]) -> [SE Sig] -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ (D -> Sig -> Sig -> SE Sig) -> [D] -> [Sig] -> [Sig] -> [SE Sig]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (Sig -> D -> Sig -> Sig -> SE Sig
del Sig
apj) [D]
idels [Sig]
ks [Sig]
afilts1
    (Ref Sig -> Sig -> SE ()) -> [Ref Sig] -> [Sig] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Ref Sig
ref Sig
x -> Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
ref (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
filt Sig
x) [Ref Sig]
afiltRefs [Sig]
adels
    [Sig]
afilts2     <- (Ref Sig -> SE Sig) -> [Ref Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef [Ref Sig]
afiltRefs
    (Sig, Sig) -> SE (Sig, Sig)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> [Sig]
forall a. [a] -> [a]
odds [Sig]
afilts2, [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> [Sig]
forall a. [a] -> [a]
evens [Sig]
afilts2)
    where
        idels :: [D]
idels = [D] -> [D]
forall a. HasCallStack => [a] -> [a]
cycle ([D] -> [D]) -> [D] -> [D]
forall a b. (a -> b) -> a -> b
$ (D -> D) -> [D] -> [D]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
getSampleRate) [D
2473, D
2767, D
3217, D
3557, D
3907, D
4127, D
2143, D
1933]
        ks :: [Sig]
ks    = [Sig] -> [Sig]
forall a. HasCallStack => [a] -> [a]
cycle ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig -> D -> Sig) -> [Sig] -> [Sig] -> [D] -> [Sig]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Sig
a Sig
b D
c -> Sig -> Sig -> SE Sig
randi Sig
a Sig
b SE Sig -> D -> Sig
`withSeed` D
c)
            [Sig
0.001, Sig
0.0011, Sig
0.0017, Sig
0.0006, Sig
0.001, Sig
0.0011, Sig
0.0017, Sig
0.0006]
            [Sig
3.1,   Sig
3.5,    Sig
1.11,   Sig
3.973,  Sig
2.341, Sig
1.897,  Sig
0.891,  Sig
3.221]
            [D
0.06,  D
0.9,    D
0.7,    D
0.3,    D
0.63,  D
0.7,    D
0.9,    D
0.44]

        del :: Sig -> D -> Sig -> Sig -> SE Sig
del Sig
apj D
idel Sig
k Sig
afilt = do
            Sig
_ <- D -> SE Sig
delayr D
1
            Sig
adel1 <- Sig -> SE Sig
deltapi (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
idel Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
k Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
ipitchmod
            Sig -> SE ()
delayw (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig
asig  Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
apj Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
afilt
            Sig -> SE Sig
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
adel1

        filt :: Sig -> Sig
filt Sig
adel = Sig -> Sig -> Sig
tone (Sig
adel Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
igain) (D -> Sig
sig D
itone)

-- | Enhances all frequencies below the give frequency by the given coefficient.
-- Original signal is added to the filtered signal with low-pass filter and scaled.
--
-- > bassEnhancment centerFrequency coefficient asig
bassEnhancment :: D -> D -> Sig -> Sig
bassEnhancment :: D -> D -> Sig -> Sig
bassEnhancment D
cfq D
k Sig
asig = D -> Sig
sig D
k Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig -> Sig
butlp Sig
asig (D -> Sig
sig D
cfq) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
asig

-- | A chain of delay lines.
--
-- > delayLine n k dt asig
--
-- A signal (@asig@) is passed through the chain of fixed time delays (A @dt@ is the delay time
-- @n@ is a number of filters, k - is scale of the signals that is passed through each delay line).
delayLine :: Int -> D -> D -> Sig -> (Sig, Sig)
delayLine :: Int -> D -> D -> Sig -> (Sig, Sig)
delayLine Int
n D
k D
dt Sig
asig = ([Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
asig Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: [Sig] -> [Sig]
forall a. [a] -> [a]
odds [Sig]
asigs, [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
asig Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: [Sig] -> [Sig]
forall a. [a] -> [a]
evens [Sig]
asigs)
    where phi :: Sig -> Sig
phi Sig
x = D -> Sig -> Sig
delaySig D
dt (Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
k)
          asigs :: [Sig]
asigs = Int -> [Sig] -> [Sig]
forall a. Int -> [a] -> [a]
take Int
n ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> Sig -> [Sig]
forall a. (a -> a) -> a -> [a]
iterate Sig -> Sig
phi (D -> Sig -> Sig
delaySig D
dt Sig
asig)

-- | Adds a very short fade in to remove the click at the beggining of the note.
declick :: Sig -> Sig
declick :: Sig -> Sig
declick = (D -> Sig
fadeIn D
0.01 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* )

-- | Sweep band pass filter (center frequency ramps from one value to another)
--
-- > sweepFilter dur startCps endCps bandWidth asignal
sweepFilter :: D -> D -> D -> Sig -> Sig -> Sig
sweepFilter :: D -> D -> D -> Sig -> Sig -> Sig
sweepFilter D
dur D
start D
end Sig
bandWidth = Sig -> Sig -> Sig -> Sig
bp Sig
centerFreq Sig
bandWidth
    where centerFreq :: Sig
centerFreq = [D] -> Sig
linseg [D
start, D
dur, D
end]

-- | Sweep band pass filter in loops (center frequency ramps from one value to another and back)
--
-- > sweepFilter dur startCps endCps bandWidth asignal
loopSweepFilter :: D -> D -> D -> Sig -> Sig -> Sig
loopSweepFilter :: D -> D -> D -> Sig -> Sig -> Sig
loopSweepFilter D
dur D
start D
end Sig
bandWidth = Sig -> Sig -> Sig -> Sig
bp Sig
centerFreq Sig
bandWidth
    where centerFreq :: Sig
centerFreq = [Sig] -> Sig -> Sig
loopseg [D -> Sig
sig D
start, Sig
1, D -> Sig
sig D
end, Sig
1, D -> Sig
sig D
start] (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig D
dur)

-- | The effect that was used in the piece \"Bay at night\".
bayAtNight :: Sig -> SE (Sig, Sig)
bayAtNight :: Sig -> SE (Sig, Sig)
bayAtNight
    = (Sig -> Sig) -> SE (Sig, Sig) -> SE (Sig, Sig)
forall {f :: * -> *} {t} {b}.
Functor f =>
(t -> b) -> f (t, t) -> f (b, b)
mapOut (D -> D -> Sig -> Sig
bassEnhancment D
100 D
1.5)
    (SE (Sig, Sig) -> SE (Sig, Sig))
-> (Sig -> SE (Sig, Sig)) -> Sig -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D -> D -> D -> Sig -> SE (Sig, Sig)
nightReverb Int
8 D
0.98 D
0.8 D
20000
    (Sig -> SE (Sig, Sig)) -> (Sig -> Sig) -> Sig -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D -> Sig -> Sig
nightChorus D
2 D
30
    where mapOut :: (t -> b) -> f (t, t) -> f (b, b)
mapOut t -> b
f = ((t, t) -> (b, b)) -> f (t, t) -> f (b, b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(t
a, t
b) -> (t -> b
f t
a, t -> b
f t
b))

-- | The effect that was used in the piece \"Vestige of time\".
vestigeOfTime :: Sig -> (Sig, Sig)
vestigeOfTime :: Sig -> (Sig, Sig)
vestigeOfTime
    = (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
mapOut ((Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.3) (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Sig
x -> Sig -> Sig -> Sig -> Sig
reverb2 Sig
x Sig
2 Sig
0.2))
    ((Sig, Sig) -> (Sig, Sig))
-> (Sig -> (Sig, Sig)) -> Sig -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D -> D -> Sig -> (Sig, Sig)
delayLine Int
6 D
1.2 D
0.9
    where mapOut :: (t -> b) -> (t, t) -> (b, b)
mapOut t -> b
f (t
a, t
b) = (t -> b
f t
a, t -> b
f t
b)