{-# Language FlexibleContexts #-}
-- | Patterns
module Csound.Air.Misc(
    mean, vibrate, randomPitch, chorusPitch, resons, resonsBy, modes, dryWet,
    once, onceBy, several, fromMono,
    -- * List functions
    odds, evens,
    -- * Random functions
    rndPan, rndPan2, rndVol, gaussVol,
    -- * Choose signals
    selector,
    -- * Saving to file
    writeHifi,

    -- * Arpeggios
    arpeggi, arpBy,

    -- * GUI
    lpJoy,

    -- * Effects
    delaySig, delay1k,

    -- * Wave shaper
    wshaper, genSaturator, saturator, mildSaturator, hardSaturator, hardSaturator2,

    -- * Function composition
    funSeq, funPar,

    -- * Metronome
    ticks, nticks,
    ticks2, nticks2,
    ticks3, nticks3,
    ticks4, nticks4,

    -- * Drone
    testDrone, testDrone2, testDrone3, testDrone4,

    -- * Attack detection
    attackTrig,
    attackTrigSig,

    -- * Ambient guitar FX
    ambiEnv
) where

import Data.Boolean
import Data.Default

import Csound.Typed
import Csound.Typed.Opcode hiding (metro)
import Csound.Control.Gui
import Csound.Control.Evt
import Csound.Control.Instr
import Csound.Tab
import Csound.Air.Wave
import Csound.Air.Patch
import Csound.Air.Envelope
import Csound.Air.Filter
import Csound.IO(writeSndBy)
import Csound.Options(setRates)
import Csound.Typed.Plugins(delay1k)

--------------------------------------------------------------------------
-- patterns

-- | Selects odd elements from the list.
odds :: [a] -> [a]
odds :: [a] -> [a]
odds [a]
as = ((Bool, a) -> a) -> [(Bool, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, a) -> a
forall a b. (a, b) -> b
snd ([(Bool, a)] -> [a]) -> [(Bool, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ ((Bool, a) -> Bool) -> [(Bool, a)] -> [(Bool, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, a) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, a)] -> [(Bool, a)]) -> [(Bool, a)] -> [(Bool, a)]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [a] -> [(Bool, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Bool] -> [Bool]
forall a. [a] -> [a]
cycle [Bool
True, Bool
False]) [a]
as

-- | Selects even elements from the list.
evens :: [a] -> [a]
evens :: [a] -> [a]
evens [a]
as
    | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
as   = []
    | Bool
otherwise = [a] -> [a]
forall a. [a] -> [a]
odds ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
tail [a]
as

-- | Reads table once during the note length.
once :: Tab -> Sig
once :: Tab -> Sig
once = D -> Tab -> Sig
onceBy D
idur

-- | Reads table once during a given period of time.
onceBy :: D -> Tab -> Sig
onceBy :: D -> Tab -> Sig
onceBy D
dt Tab
tb = Sig -> Sig
kr (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Tab -> Sig -> Sig
oscBy Tab
tb (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig D
dt)

-- | Reads table several times during the note length.
several :: Tab -> Sig -> Sig
several :: Tab -> Sig -> Sig
several Tab
tb Sig
rate = Sig -> Sig
kr (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Tab -> Sig
oscil3 Sig
1 (Sig
rate Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig D
idur) Tab
tb

-- | Mean value.
mean :: Fractional a => [a] -> a
mean :: [a] -> a
mean [a]
xs = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
xs a -> a -> a
forall a. Fractional a => a -> a -> a
/ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)

-- | Adds vibrato to the sound unit. Sound units is a function that takes in a frequency.
vibrate :: Sig -> Sig -> (Sig -> a) -> (Sig -> a)
vibrate :: Sig -> Sig -> (Sig -> a) -> Sig -> a
vibrate Sig
vibDepth Sig
vibRate Sig -> a
f Sig
cps = Sig -> a
f (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
kvib))
    where kvib :: Sig
kvib = Sig
vibDepth Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
kr (Sig -> Sig
osc Sig
vibRate)

-- | Adds a random vibrato to the sound unit. Sound units is a function that takes in a frequency.
randomPitch :: Sig -> Sig -> (Sig -> a) -> (Sig -> SE a)
randomPitch :: Sig -> Sig -> (Sig -> a) -> Sig -> SE a
randomPitch Sig
randAmp Sig
randCps Sig -> a
f Sig
cps = (Sig -> a) -> SE Sig -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sig -> a
go (SE Sig -> SE a) -> SE Sig -> SE a
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> SE Sig
randh (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
randAmp) Sig
randCps
    where go :: Sig -> a
go Sig
krand = Sig -> a
f (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
krand)

-- | Chorus takes a number of copies, chorus width and wave shape.
chorusPitch :: Int -> Sig -> (Sig -> Sig) -> Sig -> Sig
chorusPitch :: Int -> Sig -> (Sig -> Sig) -> Sig -> Sig
chorusPitch Int
n Sig
wid = [Sig] -> (Sig -> Sig) -> Sig -> Sig
phi [Sig]
dts
    where
        phi :: [Sig] -> (Sig -> Sig) -> Sig -> Sig
        phi :: [Sig] -> (Sig -> Sig) -> Sig -> Sig
phi [Sig]
ks Sig -> Sig
f = \Sig
cps -> [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> [Sig] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig
f (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
cps)) [Sig]
ks

        dts :: [Sig]
dts = (Int -> Sig) -> [Int] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> - Sig
wid Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Int -> Sig
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt) [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

        dt :: Sig
dt = Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
wid Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Int -> Sig
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n


-- | Applies a resonator to the signals. A resonator is
-- a list of band pass filters. A list contains the parameters for the filters:
--
-- > [(centerFrequency, bandWidth)]
resons :: [(Sig, Sig)] -> Sig -> Sig
resons :: [(Sig, Sig)] -> Sig -> Sig
resons = (Sig -> Sig -> Sig -> Sig) -> [(Sig, Sig)] -> Sig -> Sig
forall cps bw.
(cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig
resonsBy Sig -> Sig -> Sig -> Sig
bp

-- | A resonator with user defined band pass filter.
-- Warning: a filter takes in a center frequency, band width and the signal.
-- The signal comes last (this order is not standard in the Csound but it's more
-- convinient to use with Haskell).
resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig
resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig
resonsBy cps -> bw -> Sig -> Sig
flt [(cps, bw)]
ps Sig
asig = [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ ((cps, bw) -> Sig) -> [(cps, bw)] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (( (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
asig) ((Sig -> Sig) -> Sig)
-> ((cps, bw) -> Sig -> Sig) -> (cps, bw) -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cps -> bw -> Sig -> Sig) -> (cps, bw) -> Sig -> Sig
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry cps -> bw -> Sig -> Sig
flt) [(cps, bw)]
ps

-- | Mixes dry and wet signals.
--
-- > dryWet ratio effect asig
--
-- * @ratio@ - of dry signal to wet
--
-- * @effect@ - means to wet the signal
--
-- * @asig@ -- processed signal
dryWet :: Sig -> (Sig -> Sig) -> Sig -> Sig
dryWet :: Sig -> (Sig -> Sig) -> Sig -> Sig
dryWet Sig
k Sig -> Sig
ef Sig
asig = Sig
k Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* 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
k) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
ef Sig
asig


-- | Chain of mass-spring-damping filters.
--
-- > modes params baseCps exciter
--
-- * params - a list of pairs @(resonantFrequencyRatio, filterQuality)@
--
-- * @baseCps@ - base frequency of the resonator
--
-- * exciter - an impulse that starts a resonator.
modes :: [(Sig, Sig)] -> Sig -> Sig -> Sig
modes :: [(Sig, Sig)] -> Sig -> Sig -> Sig
modes = (Sig -> Sig -> Sig -> Sig) -> [(Sig, Sig)] -> Sig -> Sig -> Sig
forall a.
(Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig
relResonsBy (\Sig
cf Sig
q Sig
asig -> Sig -> Sig -> Sig -> Sig
mode Sig
asig Sig
cf Sig
q)

relResonsBy :: (Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig
relResonsBy :: (Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig
relResonsBy Sig -> a -> Sig -> Sig
resonator [(Sig, a)]
ms Sig
baseCps Sig
apulse = (Sig -> Sig
forall a. Fractional a => a -> a
recip Sig
normFactor Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ ((Sig, a) -> Sig) -> [(Sig, a)] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Sig
cf, a
q) -> Sig -> a -> Sig -> Sig
harm Sig
cf a
q Sig
apulse) [(Sig, a)]
ms
    where
        -- limit modal frequency to prevent explosions by
        -- skipping if the maximum value is exceeded (with a little headroom)
        gate :: Sig -> Sig
        gate :: Sig -> Sig
gate Sig
cps = BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D -> Sig
sig D
getSampleRate Sig -> Sig -> BoolSig
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* Sig
forall a. Floating a => a
pi Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps) Sig
1 Sig
0

        normFactor :: Sig
normFactor = [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ ((Sig, a) -> Sig) -> [(Sig, a)] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig
gate (Sig -> Sig) -> ((Sig, a) -> Sig) -> (Sig, a) -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
baseCps) (Sig -> Sig) -> ((Sig, a) -> Sig) -> (Sig, a) -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, a) -> Sig
forall a b. (a, b) -> a
fst) [(Sig, a)]
ms

                                    -- an ugly hack to make filter stable for forbidden values)
        harm :: Sig -> a -> Sig -> Sig
harm Sig
cf a
q Sig
x = Sig
g Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> a -> Sig -> Sig
resonator (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
g Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
g Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps) a
q Sig
x
            where cps :: Sig
cps = Sig
cf Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
baseCps
                  g :: Sig
g   = Sig -> Sig
gate Sig
cps

-- | Doubles the mono signal to get the stereo signal.
fromMono :: Sig -> (Sig, Sig)
fromMono :: Sig -> (Sig, Sig)
fromMono Sig
a = (Sig
a, Sig
a)


-- | Random panning
rndPan2 :: Sig2 -> SE Sig2
rndPan2 :: (Sig, Sig) -> SE (Sig, Sig)
rndPan2 (Sig
a, Sig
b) = Sig -> SE (Sig, Sig)
rndPan (Sig -> SE (Sig, Sig)) -> Sig -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean [Sig
a, Sig
b]

-- | Random panning
rndPan :: Sig -> SE Sig2
rndPan :: Sig -> SE (Sig, Sig)
rndPan Sig
a = do
    (D -> (Sig, Sig)) -> SE D -> SE (Sig, Sig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> (Sig, Sig)
pan2 Sig
a (Sig -> (Sig, Sig)) -> (D -> Sig) -> D -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig) (D -> SE D
forall a. SigOrD a => a -> SE a
rnd (D
1 :: D))

-- | Random volume (with gauss distribution)
--
-- > gaussVol radiusOfDistribution
gaussVol :: SigSpace a => D -> a -> SE a
gaussVol :: D -> a -> SE a
gaussVol D
k a
a = do
    D
level <- (Sig -> D) -> SE Sig -> SE D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sig -> D
ir (SE Sig -> SE D) -> SE Sig -> SE D
forall a b. (a -> b) -> a -> b
$ Sig -> SE Sig
gauss (D -> Sig
sig D
k)
    a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
level D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) a
a

-- | Random volume
--
-- > gaussVol (minVolume, maxVolume)
rndVol :: SigSpace a => (D, D) -> a -> SE a
rndVol :: (D, D) -> a -> SE a
rndVol (D
kMin, D
kMax) a
a = do
    D
level <- D -> SE D
forall a. SigOrD a => a -> SE a
rnd (D
1 :: D)
    a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
kMin D -> D -> D
forall a. Num a => a -> a -> a
+ (D
kMax D -> D -> D
forall a. Num a => a -> a -> a
- D
kMin) D -> D -> D
forall a. Num a => a -> a -> a
* D
level) a
a

-- | Hi-fi output for stereo signals. Saves the stereo signal to file.
-- The length of the file is defined in seconds.
--
-- > writeHifi fileLength fileName asig
writeHifi :: D -> String -> SE Sig2 -> IO ()
writeHifi :: D -> String -> SE (Sig, Sig) -> IO ()
writeHifi D
n String
fileName SE (Sig, Sig)
a = Options -> String -> SE (Sig, Sig) -> IO ()
forall a. RenderCsd a => Options -> String -> a -> IO ()
writeSndBy (Int -> Int -> Options
setRates Int
48000 Int
10) String
fileName (SE (Sig, Sig) -> IO ()) -> SE (Sig, Sig) -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Sig, Sig) -> (Sig, Sig)) -> SE (Sig, Sig) -> SE (Sig, Sig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> (Sig, Sig) -> (Sig, Sig)
forall a. Sigs a => D -> a -> a
setDur (D -> (Sig, Sig) -> (Sig, Sig)) -> D -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ D
n) SE (Sig, Sig)
a


-- | It picks a signal from the list by integer index.
-- The original value is taken from the head of the list (the first element).
selector :: (Num a, SigSpace a) => [a] -> Sig -> a
selector :: [a] -> Sig -> a
selector [a]
as Sig
k = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (Int -> a -> a) -> [Int] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> a
forall a. SigSpace a => Int -> a -> a
choice [Int
0..] [a]
as
    where choice :: Int -> a -> a
choice Int
n a
a = Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul (Sig -> D -> Sig
port (BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D -> Sig
sig (Int -> D
int Int
n) Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
k) Sig
1 Sig
0) D
0.02) a
a

-- | Creates running arpeggios.
--
-- > arpeggiBy ampWeights pitches instrument cps
--
-- It plays an instrument with fast sequence of notes. We can specify
-- the pitches and amplitude weights of the notes as well as frequency of repetition.
arpeggi :: SigSpace a => [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a
arpeggi :: [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a
arpeggi = ([Sig] -> Sig -> Sig)
-> ([Sig] -> Sig -> Sig)
-> [Sig]
-> [Sig]
-> (Sig -> a)
-> Sig
-> a
forall a.
SigSpace a =>
([Sig] -> Sig -> Sig)
-> ([Sig] -> Sig -> Sig)
-> [Sig]
-> [Sig]
-> (Sig -> a)
-> Sig
-> a
arpBy [Sig] -> Sig -> Sig
triSeq [Sig] -> Sig -> Sig
sqrSeq

-- | Creates running arpeggios.
--
-- > arpeggiBy ampWave pitchwave ampWeights pitches instrument cps
--
-- It plays an instrument with fast sequence of notes. We can specify amplitude envelope wave, pitch envelope wave,
-- the pitches and amplitude weights of the notes as well as frequency of repetition.
arpBy :: SigSpace a => ([Sig] -> Sig -> Sig) -> ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a
arpBy :: ([Sig] -> Sig -> Sig)
-> ([Sig] -> Sig -> Sig)
-> [Sig]
-> [Sig]
-> (Sig -> a)
-> Sig
-> a
arpBy [Sig] -> Sig -> Sig
ampWave [Sig] -> Sig -> Sig
cpsWave [Sig]
amps [Sig]
cpss Sig -> a
wave Sig
dt = Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul ([Sig] -> Sig -> Sig
ampWave [Sig]
amps Sig
dt) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Sig -> a
wave (Sig -> a) -> Sig -> a
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig -> Sig
cpsWave [Sig]
cpss Sig
dt

-- | Low-pass filter pictured as joystick.
-- Ox is for center frequency and Oy is for resonance.
lpJoy :: Source (Sig -> Sig)
lpJoy :: Source (Sig -> Sig)
lpJoy = ((Sig, Sig) -> Sig -> Sig)
-> Source (Sig, Sig) -> Source (Sig -> Sig)
forall a b. (a -> b) -> Source a -> Source b
lift1 (\(Sig
cps, Sig
res) -> Sig -> Sig -> Sig -> Sig
mlp Sig
cps Sig
res) (Source (Sig, Sig) -> Source (Sig -> Sig))
-> Source (Sig, Sig) -> Source (Sig -> Sig)
forall a b. (a -> b) -> a -> b
$ ValSpan -> ValSpan -> (Double, Double) -> Source (Sig, Sig)
joy (Double -> Double -> ValSpan
expSpan Double
100 Double
17000) (Double -> Double -> ValSpan
linSpan Double
0.05 Double
0.95) (Double
1400, Double
0.5)


-- | Chains all functions in the list.
funSeq :: [a -> a] -> a -> a
funSeq :: [a -> a] -> a -> a
funSeq = ((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> [a -> a] -> a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) a -> a
forall a. a -> a
id

-- | Applies all functions in the list to the given input
-- and summs them up.
funPar :: Num a => [a -> a] -> a -> a
funPar :: [a -> a] -> a -> a
funPar [a -> a]
fs a
a = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ ((a -> a) -> a) -> [a -> a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
a) [a -> a]
fs

-- | Delay a signal by certain number of seconds
-- There is a subtle difference between the function and the function @delaySnd@.
-- The @delaySig@ is for delaying a signal on a micro level (the delay time have to be small)
-- It's implemented with delay buffer in the csound. But @delaySnd@ is for delaying
-- on macro level (the delay time can be big). It's implemented with scores and invocation
-- of hidden instruments.
--
-- > delaySig numOfSamples asig
delaySig :: D -> Sig -> Sig
delaySig :: D -> Sig -> Sig
delaySig D
nsamples Sig
asig = Sig -> D -> Sig
delay Sig
asig D
nsamples


-----------------------------------------------------
-- metronome

-- It contains a small copy of Csouns.Catalog.Tr808. Just enough to implement a metronome.

data TrSpec = TrSpec {
      TrSpec -> D
trDur     :: D
    , TrSpec -> D
trTune    :: D
    , TrSpec -> D
trCps     :: D
    , TrSpec -> Maybe D
trRnd     :: Maybe D
    }

rndAmp :: Sig -> SE Sig
rndAmp :: Sig -> SE Sig
rndAmp Sig
a = do
    D
k <- D -> SE D
forall a. SigOrD a => a -> SE a
birnd D
0.09
    Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ D -> Sig
sig D
k)

rndVal :: D -> D -> D -> SE D
rndVal :: D -> D -> D -> SE D
rndVal D
total D
amount D
x = do
    D
k <- D -> SE D
forall a. SigOrD a => a -> SE a
birnd D
amount
    D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return (D -> SE D) -> D -> SE D
forall a b. (a -> b) -> a -> b
$ D
x  D -> D -> D
forall a. Num a => a -> a -> a
+ D
k D -> D -> D
forall a. Num a => a -> a -> a
* D
total

rndDur, rndCps, rndTune :: D -> D -> SE D

rndDur :: D -> D -> SE D
rndDur D
amt D
x = D -> D -> D -> SE D
rndVal D
x D
amt D
x
rndCps :: D -> D -> SE D
rndCps D
amt D
x = D -> D -> D -> SE D
rndVal D
x (D
amt D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
10) D
x
rndTune :: D -> D -> SE D
rndTune D
amt D
x = D -> D -> D -> SE D
rndVal D
0.7 D
amt D
x

rndSpec ::TrSpec -> SE TrSpec
rndSpec :: TrSpec -> SE TrSpec
rndSpec TrSpec
spec = do
    D
dur'  <- SE D
rndDur'
    D
tune <- SE D
rndTune'
    D
cps  <- SE D
rndCps'
    TrSpec -> SE TrSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (TrSpec -> SE TrSpec) -> TrSpec -> SE TrSpec
forall a b. (a -> b) -> a -> b
$ TrSpec
spec
        { trDur :: D
trDur  = D
dur'
        , trTune :: D
trTune = D
tune
        , trCps :: D
trCps  = D
cps }
    where
        rndDur' :: SE D
rndDur'  = ((D -> SE D) -> (D -> D -> SE D) -> Maybe D -> D -> SE D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return D -> D -> SE D
rndDur (Maybe D -> D -> SE D) -> Maybe D -> D -> SE D
forall a b. (a -> b) -> a -> b
$ (TrSpec -> Maybe D
trRnd TrSpec
spec)) (D -> SE D) -> D -> SE D
forall a b. (a -> b) -> a -> b
$ TrSpec -> D
trDur TrSpec
spec
        rndTune' :: SE D
rndTune' = ((D -> SE D) -> (D -> D -> SE D) -> Maybe D -> D -> SE D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return D -> D -> SE D
rndTune (Maybe D -> D -> SE D) -> Maybe D -> D -> SE D
forall a b. (a -> b) -> a -> b
$ (TrSpec -> Maybe D
trRnd TrSpec
spec)) (D -> SE D) -> D -> SE D
forall a b. (a -> b) -> a -> b
$ TrSpec -> D
trTune TrSpec
spec
        rndCps' :: SE D
rndCps'  = ((D -> SE D) -> (D -> D -> SE D) -> Maybe D -> D -> SE D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return D -> D -> SE D
rndCps (Maybe D -> D -> SE D) -> Maybe D -> D -> SE D
forall a b. (a -> b) -> a -> b
$ (TrSpec -> Maybe D
trRnd TrSpec
spec)) (D -> SE D) -> D -> SE D
forall a b. (a -> b) -> a -> b
$ TrSpec -> D
trCps TrSpec
spec


addDur' :: D -> Sig -> SE Sig
addDur' :: D -> Sig -> SE Sig
addDur' D
dt Sig
x = D -> SE ()
xtratim D
dt SE () -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
x

addDur :: Sig -> SE Sig
addDur :: Sig -> SE Sig
addDur = D -> Sig -> SE Sig
addDur' D
0.1

getAccent :: Int -> [D]
getAccent :: Int -> [D]
getAccent Int
n = D
1 D -> [D] -> [D]
forall a. a -> [a] -> [a]
: Int -> D -> [D]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) D
0.5

-- | Metronome with a chain of accents.
-- A typical 7/8 for example:
--
-- > dac $ nticks [3, 2, 2] (135 * 2)
nticks :: [Int] -> Sig -> Sig
nticks :: [Int] -> Sig -> Sig
nticks = (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig
nticks' TrSpec -> SE Sig
rimShot'

nticks2 :: [Int] -> Sig -> Sig
nticks2 :: [Int] -> Sig -> Sig
nticks2 = (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig
nticks' TrSpec -> SE Sig
claves'

nticks3 :: [Int] -> Sig -> Sig
nticks3 :: [Int] -> Sig -> Sig
nticks3 = (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig
nticks' TrSpec -> SE Sig
maraca'

nticks4 :: [Int] -> Sig -> Sig
nticks4 :: [Int] -> Sig -> Sig
nticks4 = (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig
nticks' TrSpec -> SE Sig
highConga'

nticks' :: (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig
nticks' :: (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig
nticks' TrSpec -> SE Sig
drum [Int]
ns = (TrSpec -> SE Sig) -> (Tick -> Evt D) -> Sig -> Sig
genTicks TrSpec -> SE Sig
drum ([D] -> Tick -> Evt D
forall a b. (Tuple a, Arg a) => [a] -> Evt b -> Evt a
cycleE ([D] -> Tick -> Evt D) -> [D] -> Tick -> Evt D
forall a b. (a -> b) -> a -> b
$ [Int]
ns [Int] -> (Int -> [D]) -> [D]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [D]
getAccent)

-- | Metronome.
--
-- > ticks n bpm
ticks :: Int -> Sig -> Sig
ticks :: Int -> Sig -> Sig
ticks = (TrSpec -> SE Sig) -> Int -> Sig -> Sig
ticks' TrSpec -> SE Sig
rimShot'

ticks2 :: Int -> Sig -> Sig
ticks2 :: Int -> Sig -> Sig
ticks2 = (TrSpec -> SE Sig) -> Int -> Sig -> Sig
ticks' TrSpec -> SE Sig
claves'

ticks3 :: Int -> Sig -> Sig
ticks3 :: Int -> Sig -> Sig
ticks3 = (TrSpec -> SE Sig) -> Int -> Sig -> Sig
ticks' TrSpec -> SE Sig
maraca'

ticks4 :: Int -> Sig -> Sig
ticks4 :: Int -> Sig -> Sig
ticks4 = (TrSpec -> SE Sig) -> Int -> Sig -> Sig
ticks' TrSpec -> SE Sig
highConga'

ticks' :: (TrSpec -> SE Sig) -> Int -> Sig -> Sig
ticks' :: (TrSpec -> SE Sig) -> Int -> Sig -> Sig
ticks' TrSpec -> SE Sig
drum Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1    = (TrSpec -> SE Sig) -> (Tick -> Evt D) -> Sig -> Sig
genTicks TrSpec -> SE Sig
drum (D -> Tick -> Evt D
forall a. D -> Evt a -> Evt D
devt D
0.5)
    | Bool
otherwise = (TrSpec -> SE Sig) -> (Tick -> Evt D) -> Sig -> Sig
genTicks TrSpec -> SE Sig
drum ([D] -> Tick -> Evt D
forall a b. (Tuple a, Arg a) => [a] -> Evt b -> Evt a
cycleE ([D] -> Tick -> Evt D) -> [D] -> Tick -> Evt D
forall a b. (a -> b) -> a -> b
$ Int -> [D]
getAccent Int
n)

genTicks :: (TrSpec -> SE Sig) -> (Tick -> Evt D) -> Sig -> Sig
genTicks :: (TrSpec -> SE Sig) -> (Tick -> Evt D) -> Sig -> Sig
genTicks TrSpec -> SE Sig
drum Tick -> Evt D
f Sig
x = Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
3 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> Sig
mlp Sig
4000 Sig
0.1 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$
    (D -> SE Sig) -> Evt (Sco D) -> Sig
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched (\D
amp -> Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> Sig
sig D
amp) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ TrSpec -> SE Sig
drum (D -> D -> D -> Maybe D -> TrSpec
TrSpec (D
amp D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) D
0 (D
1200 D -> D -> D
forall a. Num a => a -> a -> a
* (D
amp D -> D -> D
forall a. Num a => a -> a -> a
+ D
0.5)) (D -> Maybe D
forall a. a -> Maybe a
Just D
0.05))) (Evt (Sco D) -> Sig) -> Evt (Sco D) -> Sig
forall a b. (a -> b) -> a -> b
$
    Sig -> Evt D -> Evt (Sco D)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
0.5 (Evt D -> Evt (Sco D)) -> Evt D -> Evt (Sco D)
forall a b. (a -> b) -> a -> b
$ Tick -> Evt D
f (Tick -> Evt D) -> Tick -> Evt D
forall a b. (a -> b) -> a -> b
$ Sig -> Tick
metro (Sig
x Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
60)

rimShot' :: TrSpec -> SE Sig
rimShot' :: TrSpec -> SE Sig
rimShot' TrSpec
spec = TrSpec -> SE Sig
pureRimShot' (TrSpec -> SE Sig) -> SE TrSpec -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TrSpec -> SE TrSpec
rndSpec TrSpec
spec

-- cps = 1700
pureRimShot' :: TrSpec -> SE Sig
pureRimShot' :: TrSpec -> SE Sig
pureRimShot' TrSpec
spec = Sig -> SE Sig
rndAmp (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sig -> SE Sig
addDur (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.8 (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ SE Sig
aring SE Sig -> SE Sig -> SE Sig
forall a. Num a => a -> a -> a
+ SE Sig
anoise)
    where
        dur' :: D
dur'     = TrSpec -> D
trDur  TrSpec
spec
        tune :: D
tune    = TrSpec -> D
trTune TrSpec
spec
        cps :: D
cps     = TrSpec -> D
trCps  TrSpec
spec

        fullDur :: D
fullDur = D
0.027 D -> D -> D
forall a. Num a => a -> a -> a
* D
dur'

        -- ring
        aenv1 :: Sig
aenv1 = [D] -> Sig
expsega [D
1,D
fullDur,D
0.001]
        ifrq1 :: Sig
ifrq1 = D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
cps D -> D -> D
forall a. Num a => a -> a -> a
* D -> D
forall a. SigOrD a => a -> a
octave D
tune
        aring :: SE Sig
aring = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
aenv1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.001)) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at (Sig -> Sig -> Sig -> Sig
bbp Sig
ifrq1 (Sig
ifrq1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
8)) (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b. (a -> b) -> a -> b
$ Tab -> Sig -> SE Sig
rndOscBy Tab
tabTR808RimShot Sig
ifrq1

        -- noise
        aenv2 :: Sig
aenv2 = [D] -> Sig
expsega [D
1, D
0.002, D
0.8, D
0.005, D
0.5, D
fullDurD -> D -> D
forall a. Num a => a -> a -> a
-D
0.002D -> D -> D
forall a. Num a => a -> a -> a
-D
0.005, D
0.0001]
        kcf :: Sig
kcf   = [D] -> D -> D -> Sig
expsegr [D
4000, D
fullDur, D
20] D
fullDur D
20
        anoise :: SE Sig
anoise = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
aenv2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.001) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> Sig
blp Sig
kcf) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> SE Sig
noise Sig
1 Sig
0

        tabTR808RimShot :: Tab
tabTR808RimShot = Int -> Tab -> Tab
setSize Int
1024 (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
sines [Double
0.971,Double
0.269,Double
0.041,Double
0.054,Double
0.011,Double
0.013,Double
0.08,Double
0.0065,Double
0.005,Double
0.004,Double
0.003,Double
0.003,Double
0.002,Double
0.002,Double
0.002,Double
0.002,Double
0.002,Double
0.001,Double
0.001,Double
0.001,Double
0.001,Double
0.001,Double
0.002,Double
0.001,Double
0.001]

claves' :: TrSpec -> SE Sig
claves' :: TrSpec -> SE Sig
claves' TrSpec
spec = Sig -> SE Sig
rndAmp (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sig -> SE Sig
addDur (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE Sig
asig
    where
        dur' :: D
dur'     = TrSpec -> D
trDur  TrSpec
spec
        tune :: D
tune    = TrSpec -> D
trTune TrSpec
spec
        cps :: D
cps     = TrSpec -> D
trCps  TrSpec
spec

        ifrq :: D
ifrq = D
cps D -> D -> D
forall a. Num a => a -> a -> a
* D -> D
forall a. SigOrD a => a -> a
octave D
tune
        dt :: D
dt   = D
0.045 D -> D -> D
forall a. Num a => a -> a -> a
* D
dur'
        aenv :: Sig
aenv = [D] -> Sig
expsega  [D
1, D
dt, D
0.001]
        afmod :: Sig
afmod = [D] -> Sig
expsega [D
3,D
0.00005,D
1]
        asig :: SE Sig
asig = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (- Sig
0.4 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
aenvSig -> Sig -> Sig
forall a. Num a => a -> a -> a
-Sig
0.001)) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> SE Sig
rndOsc (D -> Sig
sig D
ifrq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
afmod)

highConga' :: TrSpec -> SE Sig
highConga' :: TrSpec -> SE Sig
highConga' = D -> TrSpec -> SE Sig
genConga D
0.22

genConga :: D -> TrSpec -> SE Sig
genConga :: D -> TrSpec -> SE Sig
genConga D
dt TrSpec
spec = Sig -> SE Sig
rndAmp (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sig -> SE Sig
addDur (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE Sig
asig
    where
        dur' :: D
dur'     = TrSpec -> D
trDur  TrSpec
spec
        tune :: D
tune    = TrSpec -> D
trTune TrSpec
spec
        cps :: D
cps     = TrSpec -> D
trCps  TrSpec
spec

        ifrq :: D
ifrq = D
cps D -> D -> D
forall a. Num a => a -> a -> a
* D -> D
forall a. SigOrD a => a -> a
octave D
tune
        fullDur :: D
fullDur = D
dt D -> D -> D
forall a. Num a => a -> a -> a
* D
dur'
        aenv :: Sig
aenv = [D] -> Sig
transeg [D
0.7,D
1D -> D -> D
forall a. Fractional a => a -> a -> a
/D
ifrq,D
1,D
1,D
fullDur,-D
6,D
0.001]
        afmod :: Sig
afmod = [D] -> Sig
expsega [D
3,D
0.25D -> D -> D
forall a. Fractional a => a -> a -> a
/D
ifrq,D
1]
        asig :: SE Sig
asig = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (-Sig
0.25 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
aenv) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> SE Sig
rndOsc (D -> Sig
sig D
ifrq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
afmod)

maraca' ::  TrSpec -> SE Sig
maraca' :: TrSpec -> SE Sig
maraca' TrSpec
spec = Sig -> SE Sig
rndAmp (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sig -> SE Sig
addDur (Sig -> SE Sig) -> SE Sig -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE Sig
anoise
    where
        dur' :: D
dur'    = TrSpec -> D
trDur  TrSpec
spec
        tune :: D
tune    = TrSpec -> D
trTune TrSpec
spec

        otune :: Sig
otune   = D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D -> D
forall a. SigOrD a => a -> a
octave D
tune
        iHPF :: Sig
iHPF    = Sig -> Sig -> Sig -> Sig
limit (Sig
6000 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
otune) Sig
20 (D -> Sig
sig D
getSampleRate Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2)
        iLPF :: Sig
iLPF    = Sig -> Sig -> Sig -> Sig
limit (Sig
12000 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
otune) Sig
20 (D -> Sig
sig D
getSampleRate Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
3)
        aenv :: Sig
aenv    = [D] -> Sig
expsega [D
0.4,D
0.014D -> D -> D
forall a. Num a => a -> a -> a
* D
dur',D
1,D
0.01 D -> D -> D
forall a. Num a => a -> a -> a
* D
dur', D
0.05, D
0.05 D -> D -> D
forall a. Num a => a -> a -> a
* D
dur', D
0.001]
        anoise :: SE Sig
anoise  = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
aenv (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> Sig
blp Sig
iLPF (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig
bhp Sig
iHPF) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> SE Sig
noise Sig
0.75 Sig
0

-------------------------------------------
-- drones (copied from csound-catalog)

testDrone, testDrone2, testDrone3, testDrone4 :: D -> SE Sig2

testDrone :: D -> SE (Sig, Sig)
testDrone  D
cps = Patch (Sig, Sig) -> (D, D) -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => Patch a -> (D, D) -> SE a
atNote (Patch (Sig, Sig) -> Patch (Sig, Sig)
forall b. (SigSpace b, Sigs b) => Patch b -> Patch b
deepPad Patch (Sig, Sig)
razorPad) (D
0.8, D
cps)
  where
    razorPad :: Patch (Sig, Sig)
razorPad = RazorPad -> Patch (Sig, Sig)
razorPad' RazorPad
forall a. Default a => a
def
    razorPad' :: RazorPad -> Patch (Sig, Sig)
razorPad' (RazorPad Sig
speed) = Sig -> Patch (Sig, Sig) -> Patch (Sig, Sig)
withLargeHall' Sig
0.35 (Patch (Sig, Sig) -> Patch (Sig, Sig))
-> Patch (Sig, Sig) -> Patch (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ ((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig)
forall a. Instr D a -> Patch a
polySynt (((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig))
-> ((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig -> (Sig, Sig)) -> SE Sig -> AtOut Sig (Sig, Sig) (SE Sig)
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at Sig -> (Sig, Sig)
fromMono (SE Sig -> SE (Sig, Sig))
-> ((D, D) -> SE Sig) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.6 (SE Sig -> SE Sig) -> ((D, D) -> SE Sig) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Sig, Sig) -> SE Sig)
-> (D, D) -> SE (CpsInstrOut ((Sig, Sig) -> SE Sig))
forall a. CpsInstr a => a -> (D, D) -> SE (CpsInstrOut a)
onCps ((Sig -> Sig -> SE Sig) -> (Sig, Sig) -> SE Sig
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Sig -> Sig -> SE Sig) -> (Sig, Sig) -> SE Sig)
-> (Sig -> Sig -> SE Sig) -> (Sig, Sig) -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> SE Sig
impRazorPad Sig
speed)

testDrone2 :: D -> SE (Sig, Sig)
testDrone2 D
cps = Patch (Sig, Sig) -> (D, D) -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => Patch a -> (D, D) -> SE a
atNote (Patch (Sig, Sig) -> Patch (Sig, Sig)
forall b. (SigSpace b, Sigs b) => Patch b -> Patch b
deepPad Patch (Sig, Sig)
nightPad) (D
0.8, D
cps)
  where
    nightPad :: Patch (Sig, Sig)
nightPad   = Patch (Sig, Sig) -> Patch (Sig, Sig)
withLargeHall (Patch (Sig, Sig) -> Patch (Sig, Sig))
-> Patch (Sig, Sig) -> Patch (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ ((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig)
forall a. Instr D a -> Patch a
polySynt (((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig))
-> ((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> SE (Sig, Sig) -> SE (Sig, Sig)
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.48 (SE (Sig, Sig) -> SE (Sig, Sig))
-> ((D, D) -> SE (Sig, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> (Sig, Sig)) -> SE Sig -> AtOut Sig (Sig, Sig) (SE Sig)
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at Sig -> (Sig, Sig)
fromMono (SE Sig -> SE (Sig, Sig))
-> ((D, D) -> SE Sig) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> (D, D) -> SE (CpsInstrOut (Sig -> Sig))
forall a. CpsInstr a => a -> (D, D) -> SE (CpsInstrOut a)
onCps (Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> Sig
fadeOut D
1) (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig -> Sig
impNightPad D
0.5)

testDrone3 :: D -> SE (Sig, Sig)
testDrone3 D
cps = Patch (Sig, Sig) -> (D, D) -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => Patch a -> (D, D) -> SE a
atNote (Patch (Sig, Sig) -> Patch (Sig, Sig)
forall b. (SigSpace b, Sigs b) => Patch b -> Patch b
deepPad Patch (Sig, Sig)
caveOvertonePad) (D
0.8, D
cps)
  where
    caveOvertonePad :: Patch (Sig, Sig)
caveOvertonePad =  [GenFxSpec (Sig, Sig)] -> Patch (Sig, Sig) -> Patch (Sig, Sig)
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain (Sig -> ((Sig, Sig) -> (Sig, Sig)) -> [GenFxSpec (Sig, Sig)]
forall a. Sig -> (a -> a) -> [GenFxSpec a]
fx1 Sig
0.2 ((Sig, Sig) -> (Sig, Sig)
magicCave2 ((Sig, Sig) -> (Sig, Sig))
-> ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> (Sig, Sig) -> (Sig, Sig)
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.8)) (Patch (Sig, Sig) -> Patch (Sig, Sig))
-> Patch (Sig, Sig) -> Patch (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ ((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig)
forall a. Instr D a -> Patch a
polySynt (D, D) -> SE (Sig, Sig)
overtoneInstr

testDrone4 :: D -> SE (Sig, Sig)
testDrone4 D
cps = Patch (Sig, Sig) -> (D, D) -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => Patch a -> (D, D) -> SE a
atNote (Patch (Sig, Sig) -> Patch (Sig, Sig)
forall b. (SigSpace b, Sigs b) => Patch b -> Patch b
deepPad Patch (Sig, Sig)
pwEnsemble) (D
0.8, D
cps)
  where
    pwEnsemble :: Patch (Sig, Sig)
pwEnsemble = Patch (Sig, Sig) -> Patch (Sig, Sig)
withSmallHall (Patch (Sig, Sig) -> Patch (Sig, Sig))
-> Patch (Sig, Sig) -> Patch (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ ((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig)
forall a. Instr D a -> Patch a
polySynt (((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig))
-> ((D, D) -> SE (Sig, Sig)) -> Patch (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig -> (Sig, Sig)) -> SE Sig -> AtOut Sig (Sig, Sig) (SE Sig)
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at Sig -> (Sig, Sig)
fromMono (SE Sig -> SE (Sig, Sig))
-> ((D, D) -> SE Sig) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.55 (SE Sig -> SE Sig) -> ((D, D) -> SE Sig) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> SE Sig) -> (D, D) -> SE (CpsInstrOut (Sig -> SE Sig))
forall a. CpsInstr a => a -> (D, D) -> SE (CpsInstrOut a)
onCps Sig -> SE Sig
impPwEnsemble


data RazorPad = RazorPad Sig

instance Default RazorPad where
    def :: RazorPad
def = Sig -> RazorPad
RazorPad Sig
0.5

overtoneInstr :: CsdNote D -> SE Sig2
overtoneInstr :: (D, D) -> SE (Sig, Sig)
overtoneInstr = Sig -> SE (Sig, Sig) -> SE (Sig, Sig)
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.65 (SE (Sig, Sig) -> SE (Sig, Sig))
-> ((D, D) -> SE (Sig, Sig)) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> (Sig, Sig)) -> SE Sig -> AtOut Sig (Sig, Sig) (SE Sig)
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at Sig -> (Sig, Sig)
fromMono (SE Sig -> SE (Sig, Sig))
-> ((D, D) -> SE Sig) -> (D, D) -> SE (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> (Sig -> Sig) -> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b c. MixAt a b c => Sig -> (a -> b) -> c -> AtOut a b c
mixAt Sig
0.25 (Sig -> Sig -> Sig -> Sig
mlp Sig
1500 Sig
0.1) (SE Sig -> SE Sig) -> ((D, D) -> SE Sig) -> (D, D) -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> (D, D) -> SE (CpsInstrOut (D -> Sig))
forall a. CpsInstr a => a -> (D, D) -> SE (CpsInstrOut a)
onCps (\D
cps -> Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> D -> Sig
fades D
0.25 D
1.2) (Int -> Sig -> D -> Sig
tibetan Int
11 Sig
0.012 D
cps) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> D -> Sig
fades D
0.25 D
1) (Int -> Sig -> D -> Sig
tibetan Int
13 Sig
0.015 (D
cps D -> D -> D
forall a. Num a => a -> a -> a
* D
0.5)))


-- implem

impPwEnsemble :: Sig -> SE Sig
impPwEnsemble :: Sig -> SE Sig
impPwEnsemble Sig
x = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.3 (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at (Sig -> Sig -> Sig -> Sig
mlp (Sig
3500 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
2) Sig
0.1) (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> D -> D -> D -> Sig
leg D
0.5 D
0 D
1 D
1) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ [SE Sig] -> SE Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
    [ Sig -> Sig -> Sig -> Sig -> SE Sig
f Sig
0.2 Sig
0.11 Sig
2 (Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
forall a. SigOrD a => a -> a
cent (-Sig
6))
    , Sig -> Sig -> Sig -> Sig -> SE Sig
f Sig
0.8 (-Sig
0.1) Sig
1.8 (Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
forall a. SigOrD a => a -> a
cent Sig
6)
    , Sig -> Sig -> Sig -> Sig -> SE Sig
f Sig
0.2 Sig
0.11 Sig
2 (Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.5) ]
    where f :: Sig -> Sig -> Sig -> Sig -> SE Sig
f Sig
a Sig
b Sig
c = Sig -> Sig -> SE Sig
rndPw (Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
b Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
tri Sig
c)

-- | Tibetan chant. It's a chorus of many sinusoids.
--
-- > tibetan n off cps
--
-- * n - the number of sinusoids (the best is 9)
--
-- * off - frequency step of the harmonics ~ (0.01, 0.03)
--
-- * cps - the frequency of the note
tibetan :: Int -> Sig -> D -> Sig
tibetan :: Int -> Sig -> D -> Sig
tibetan Int
n Sig
off D
cps = Int -> Sig -> (Sig -> Sig) -> Sig -> Sig
chorusPitch Int
n (Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
off Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Int -> Sig
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Tab -> Sig -> Sig
oscBy Tab
wave) (D -> Sig
sig D
cps)
    where wave :: Tab
wave = BoolD -> Tab -> Tab -> Tab
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D
cps D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
230) (Int -> Tab
waveBy Int
5) (BoolD -> Tab -> Tab -> Tab
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D
cps D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
350) (Int -> Tab
waveBy Int
3) (Int -> Tab
waveBy Int
1))
          waveBy :: Int -> Tab
waveBy Int
x = [Double] -> Tab
sines ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ [Double
0.3, Double
0, Double
0, Double
0] [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
x Double
0.1

impRazorPad :: Sig -> Sig -> Sig -> SE Sig
impRazorPad :: Sig -> Sig -> Sig -> SE Sig
impRazorPad Sig
speed' Sig
amp' Sig
cps' = Sig -> SE Sig
g Sig
cps' SE Sig -> SE Sig -> SE Sig
forall a. Num a => a -> a -> a
+ SE Sig
0.75 SE Sig -> SE Sig -> SE Sig
forall a. Num a => a -> a -> a
* Sig -> SE Sig
g (Sig
cps' Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.5)
    where
      g :: Sig -> SE Sig
g Sig
cps = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> D -> D -> D -> Sig
leg D
0.5 D
0 D
1 D
1) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig -> Sig -> Sig) -> Sig -> Sig -> Sig -> SE Sig
forall b t.
(SigSpace (SE b), Fractional t) =>
(Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
genRazor (Int -> (Sig -> Sig -> Sig -> Sig) -> Sig -> Sig -> Sig -> Sig
filt Int
1 Sig -> Sig -> Sig -> Sig
mlp) Sig
speed' Sig
amp' Sig
cps

      genRazor :: (Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
genRazor Sig -> t -> Sig -> b
f Sig
speed Sig
amp Sig
cps = Sig -> SE b -> SE b
forall a. SigSpace a => Sig -> a -> a
mul Sig
amp (SE b -> SE b) -> SE b -> SE b
forall a b. (a -> b) -> a -> b
$ do
          Sig
a1 <- Sig -> SE Sig
ampSpline Sig
0.01
          Sig
a2 <- Sig -> SE Sig
ampSpline Sig
0.02

          b -> SE b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> SE b) -> b -> SE b
forall a b. (a -> b) -> a -> b
$ Sig -> t -> Sig -> b
f (Sig
1000 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
500 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
amp) t
0.1 (Sig -> b) -> Sig -> b
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean [
                Sig -> Sig -> Sig -> Sig -> Sig
fosc Sig
1 Sig
3 (Sig
a1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
uosc (Sig
speed)) Sig
cps
              , Sig -> Sig -> Sig -> Sig -> Sig
fosc Sig
3 Sig
1 (Sig
a2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
uosc (Sig
speed Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
0.2)) Sig
cps
              , Sig -> Sig -> Sig -> Sig -> Sig
fosc Sig
1 Sig
7 (Sig
a1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
uosc (Sig
speed Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.15)) Sig
cps ]
          where ampSpline :: Sig -> SE Sig
ampSpline Sig
c = Sig -> Sig -> Sig -> Sig -> SE Sig
rspline ( Sig
amp) (Sig
3.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
amp) ((Sig
speed Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
4) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
c Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.1)) ((Sig
speed Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
4) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
c  Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
0.1))


-- |
-- > nightPad fadeInTime cps
impNightPad :: D -> Sig -> Sig
impNightPad :: D -> Sig -> Sig
impNightPad D
dt = (D -> Sig
fadeIn D
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig
stringPad Sig
1

-- |
--
-- > stringPad amplitude cps
stringPad :: Sig -> Sig -> Sig
stringPad :: Sig -> Sig -> Sig
stringPad Sig
amp Sig
cps = Sig -> Sig -> Sig
blp (Sig
900 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
300) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> Sig -> (Sig -> Sig) -> Sig -> Sig
chorusPitch Int
3 Sig
0.1 Sig -> Sig
f Sig
cps
    where f :: Sig -> Sig
f Sig
x = Sig -> Sig -> Tab -> Sig
poscil Sig
1 Sig
x Tab
giwave

giwave :: Tab
giwave :: Tab
giwave = [Double] -> Tab
sines [Double
1, Double
0.5, Double
0.33, Double
0.25, Double
0.0, Double
0.1, Double
0.1, Double
0.1]

fx1 :: Sig -> (a -> a) -> [GenFxSpec a]
fx1 :: Sig -> (a -> a) -> [GenFxSpec a]
fx1 Sig
dw a -> a
f = [FxSpec a -> GenFxSpec a
forall (m :: * -> *) a. Monad m => a -> m a
return (FxSpec a -> GenFxSpec a) -> FxSpec a -> GenFxSpec a
forall a b. (a -> b) -> a -> b
$ Sig -> Fx a -> FxSpec a
forall a. Sig -> Fx a -> FxSpec a
FxSpec Sig
dw (Fx a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)]

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

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

type Feedback = Sig

------------------------------------------------------
-- wave shaper

-- | Wave shaper. The signal should be bipolar. It ranges within the interval [-1, 1].
--
-- > wshaper table amount asig
--
-- wave shaper transforms the input signal with the table.
-- The amount of transformation scales the signal from 0 to 1.
-- the amount is ratio of scaling. It expects the values from the interval [0, 1].
--
wshaper :: Tab -> Sig -> Sig -> Sig
wshaper :: Tab -> Sig -> Sig -> Sig
wshaper Tab
t Sig
amt Sig
asig = Sig -> Tab -> Sig
forall a. SigOrD a => a -> Tab -> a
tablei (Sig
10 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
amt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
asig Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
20) Tab
t Sig -> [D] -> Sig
forall a. Tuple a => a -> [D] -> a
`withDs` [D
1, D
0.5]

-- | Wave shaper with sigmoid.
--
-- > genSaturator sigmoidRadius amount asig
--
-- * sigmoid radius is 5 to 100.
--
-- * amount is [0, 1]
genSaturator :: Double -> Sig -> Sig -> Sig
genSaturator :: Double -> Sig -> Sig -> Sig
genSaturator Double
rad Sig
amt = Tab -> Sig -> Sig -> Sig
wshaper (Double -> Tab
tanhSigmoid Double
rad) Sig
amt

-- | Alias for
--
-- > genSaturator 5
mildSaturator :: Sig -> Sig -> Sig
mildSaturator :: Sig -> Sig -> Sig
mildSaturator = Double -> Sig -> Sig -> Sig
genSaturator Double
1

-- | Alias for
--
-- > genSaturator 10
saturator :: Sig -> Sig -> Sig
saturator :: Sig -> Sig -> Sig
saturator = Double -> Sig -> Sig -> Sig
genSaturator Double
1.5

-- | Alias for
--
-- > genSaturator 50
hardSaturator :: Sig -> Sig -> Sig
hardSaturator :: Sig -> Sig -> Sig
hardSaturator = Double -> Sig -> Sig -> Sig
genSaturator Double
3.5

-- | Alias for
--
-- > genSaturator 100
hardSaturator2 :: Sig -> Sig -> Sig
hardSaturator2 :: Sig -> Sig -> Sig
hardSaturator2 = Double -> Sig -> Sig -> Sig
genSaturator Double
6.5


-----------------------------------------
-- attack detection

-- | Detects attacks in the signal. Outputs event stream of attack events.
--
-- > attackTrig threshold sigIn
--
-- threshhold cnmtrols the sensitivity of attack detection.
-- Try out different values in [0, 0.2]
attackTrig :: Sig -> Sig -> SE (Evt Unit)
attackTrig :: Sig -> Sig -> SE Tick
attackTrig Sig
thresh Sig
ain = (Sig -> Tick) -> SE Sig -> SE Tick
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sig -> Tick
sigToEvt (SE Sig -> SE Tick) -> SE Sig -> SE Tick
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> SE Sig
attackTrigSig Sig
thresh Sig
ain

-- | Detects attacks in the signal. Outputs trigger-signal
-- where 1 is when attack happens and 0 otherwise.
attackTrigSig :: Sig -> Sig -> SE Sig
attackTrigSig :: Sig -> Sig -> SE Sig
attackTrigSig Sig
thresh Sig
a = do
  Ref Sig
kTime <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef (Sig
iWait Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1)
  Ref Sig
kTrig <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef Sig
0

  Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
kTrig Sig
0
  Sig
timeVal <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
kTime

  BoolSig -> SE () -> SE ()
when1 (Sig
da Sig -> Sig -> BoolSig
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* Sig
thresh BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* Sig
timeVal Sig -> Sig -> BoolSig
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* Sig
iWait) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
    D -> Sig -> SE ()
printk D
0 Sig
timeVal
    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
kTrig Sig
1
    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
kTime Sig
0

  Ref Sig -> (Sig -> Sig) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref Sig
kTime (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+Sig
1)

  Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
kTrig
  where
    da :: Sig
da = D -> Sig -> Sig
diffSig D
0.01 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
rms Sig
a
    iWait :: Sig
    iWait :: Sig
iWait = Sig
100

    diffSig :: D -> Sig -> Sig
    diffSig :: D -> Sig -> Sig
diffSig D
dt Sig
x = Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- D -> Sig -> Sig
delaySig D
dt Sig
x


------------------------------
-- ambient envelope

-- | Make smooth attacks for the input guitar or piano-like sounds.
-- It simulates automatic volume control pedal. It detects striken attacks
-- and makes them sound more PAD-like.
--
-- first argument is threshold that controls sensitivity of attack detection.
-- The values like ~ 0.01, 0.02 is good start.
--
-- To use it with guitar it's good to add a bit of distortion and compression
-- to the signal to make it brighter and then to apply several delays to prolong the sustain
-- and release phases. And it's good to add some reverb at the end.
--
-- Here is an example of how to make ambient guitar with this effect:
--
-- > main = dac proc
-- >
-- > -- | Let's assume we read guitar from the first input of sound card
-- > proc :: Sig2 -> SE Sig2
-- > proc (x, _) = mul 1 $ hall 0.25 $
-- >          fmap ( fromMono . (adele 0.35 1 0.65 0.34) . (adele 0.35 0.25 0.75 0.34) .
-- >                 saturator 0.3  . tort 0.1 0.25 .
-- >                 magnus 2 0.25 1.1 0.6 0.4 1.8) $
-- >           ambiEnv 0.02 x
-- >
--
-- So I've added a tape echo with magnus,
-- then goes combo of saturator (compressor) and tort (distortion)
-- then goes a couple of delays (adele)
-- and the last part is sweet reverb (hall).
ambiEnv :: Sig -> Sig -> SE Sig
ambiEnv :: Sig -> Sig -> SE Sig
ambiEnv Sig
thresh Sig
ain = do
  Sig
attacks <- Sig -> Sig -> SE Sig
attackTrigSig Sig
thresh Sig
ain
  Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig -> Sig
delaySig D
0.1 (Sig -> Sig
env Sig
attacks) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
ain
  where
    env :: Sig -> Sig
env Sig
tr = Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig
adsr140 (Sig -> Sig
rms Sig
ain Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.05) Sig
tr Sig
4 Sig
1 Sig
1 Sig
3