{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# Language FlexibleContexts #-}
module Csound.Catalog.Wave.Sean(
  RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec,
  snowCrackle,
  fmDrone, fmDrones, fmPulse, fmPulses, scDrone, scDrones,
  tenorOsc, sopranoOsc
) where

import Control.Monad

import Csound.Base hiding (formant, dur, idur)

data RissetBellSpec = RissetBellSpec
  { RissetBellSpec -> [D]
rissetBellRands     :: [D]
  , RissetBellSpec -> [D]
rissetBellRandShifts  :: [D]
  , RissetBellSpec -> [D]
rissetBellDurs    :: [D]
  , RissetBellSpec -> [Sig]
rissetBellAmps    :: [Sig]
  , RissetBellSpec -> [Sig]
rissetBellFreqs       :: [Sig]
  , RissetBellSpec -> [Sig]
rissetBellFreqShifts  :: [Sig]
  }

rissetBell :: RissetBellSpec -> (D, D) -> D -> Sig -> Sig -> SE Sig
rissetBell :: RissetBellSpec -> (D, D) -> D -> Sig -> Sig -> SE Sig
rissetBell RissetBellSpec
spec (D
from, D
to) D
dur Sig
amp Sig
cps = SE Sig
ares
  where
    idurs :: [D]
idurs  = (D -> D) -> [D] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D
dur D -> D -> D
forall a. Num a => a -> a -> a
* ) (RissetBellSpec -> [D]
rissetBellDurs RissetBellSpec
spec)
    ifreqs :: [Sig]
ifreqs = (Sig -> Sig) -> [Sig] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) (RissetBellSpec -> [Sig]
rissetBellFreqs RissetBellSpec
spec)
    ifreqDt' :: [Sig]
ifreqDt' = (RissetBellSpec -> [Sig]
rissetBellFreqShifts RissetBellSpec
spec)
    iamps :: [Sig]
iamps  = (Sig -> Sig) -> [Sig] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) (RissetBellSpec -> [Sig]
rissetBellAmps RissetBellSpec
spec)
    irands :: [D]
irands = (RissetBellSpec -> [D]
rissetBellRands RissetBellSpec
spec)
    irandDt' :: [D]
irandDt' = (RissetBellSpec -> [D]
rissetBellRandShifts RissetBellSpec
spec)

    partial :: Sig -> Sig -> Sig -> D -> D -> D -> SE Sig
partial Sig
iamp Sig
ifreq Sig
ifreqDt D
idur D
irand D
irandDt = do
      Sig
amod <- Sig -> Sig -> SE Sig
randi Sig
iamp ([D] -> Sig
linseg [D
from D -> D -> D
forall a. Num a => a -> a -> a
* D
irand D -> D -> D
forall a. Num a => a -> a -> a
+ D
irandDt, D
idur, D
to D -> D -> D
forall a. Num a => a -> a -> a
* D
irand D -> D -> D
forall a. Num a => a -> a -> a
+ D
irandDt])
      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 -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
amod (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
osc (Sig
ifreq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
ifreqDt)

    ares :: SE Sig
ares = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.75 (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
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [Sig] -> SE Sig) -> SE [Sig] -> SE Sig
forall a b. (a -> b) -> a -> b
$ ((Sig, Sig, Sig) -> (D, D, D) -> SE Sig)
-> [(Sig, Sig, Sig)] -> [(D, D, D)] -> SE [Sig]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\(Sig
iamp, Sig
ifreq, Sig
ifreqDt) (D
idur, D
irand, D
irandDt) -> Sig -> Sig -> Sig -> D -> D -> D -> SE Sig
partial Sig
iamp Sig
ifreq Sig
ifreqDt D
idur D
irand D
irandDt) ([Sig] -> [Sig] -> [Sig] -> [(Sig, Sig, Sig)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Sig]
iamps [Sig]
ifreqs [Sig]
ifreqDt') ([D] -> [D] -> [D] -> [(D, D, D)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [D]
idurs [D]
irands [D]
irandDt')

timpaniSpec :: RissetBellSpec
timpaniSpec = RissetBellSpec :: [D] -> [D] -> [D] -> [Sig] -> [Sig] -> [Sig] -> RissetBellSpec
RissetBellSpec
  { rissetBellDurs :: [D]
rissetBellDurs       = [D
0.087, D
0.5, D
0.804, D
0.065, D
0.325, D
0.54, D
1,    D
0.195, D
0.108, D
0.89, D
0.075]
  , rissetBellFreqs :: [Sig]
rissetBellFreqs      = [Sig
0.8,  Sig
1.00,  Sig
1.5,  Sig
1.65,  Sig
1.97,  Sig
2,    Sig
2.44, Sig
2.86,  Sig
2.71,  Sig
2.91,  Sig
3.27]
  , rissetBellFreqShifts :: [Sig]
rissetBellFreqShifts = [Sig
0,    Sig
0,    Sig
0,     Sig
0,     Sig
0,     Sig
0,    Sig
0,    Sig
0,    Sig
0,      Sig
0,     Sig
0]
  , rissetBellAmps :: [Sig]
rissetBellAmps       = [Sig
1,    Sig
2.52,  Sig
1.83, Sig
0.55,  Sig
1.47,  Sig
1.67, Sig
0.62, Sig
0.5,  Sig
0.52,   Sig
0.55,  Sig
0.33]
  , rissetBellRands :: [D]
rissetBellRands      = [D
0.56, D
0.56, D
0.92,  D
0.92,  D
1.19,  D
1.7,  D
2,    D
2.74, D
3,      D
3.75,  D
4.07]
  , rissetBellRandShifts :: [D]
rissetBellRandShifts = [D
0,    D
1,    D
0,     D
1.7,   D
0,     D
0,    D
0,    D
0,    D
0,      D
0,     D
0] }

timpani :: (D, D) -> D -> Sig -> Sig -> SE Sig
timpani :: (D, D) -> D -> Sig -> Sig -> SE Sig
timpani (D
from, D
to) D
dur Sig
amp Sig
cps = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
env (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ RissetBellSpec -> (D, D) -> D -> Sig -> Sig -> SE Sig
rissetBell RissetBellSpec
timpaniSpec (D
from, D
to) D
dur Sig
amp Sig
cps
  where env :: Sig
env = [D] -> D -> D -> Sig
expsegr [D
1, D
dur, D
0.001] D
dur D
0.001


noiseBellSpec :: RissetBellSpec
noiseBellSpec = RissetBellSpec :: [D] -> [D] -> [D] -> [Sig] -> [Sig] -> [Sig] -> RissetBellSpec
RissetBellSpec
  { rissetBellDurs :: [D]
rissetBellDurs        =[D
1,    D
0.9,  D
0.65, D
0.55, D
0.325, D
0.35, D
0.25, D
0.2,  D
0.15,  D
0.1, D
0.075]
  , rissetBellFreqs :: [Sig]
rissetBellFreqs       = [Sig
0.56, Sig
0.56, Sig
0.92, Sig
0.92, Sig
1.19,  Sig
1.7,  Sig
3,    Sig
2.74, Sig
3,     Sig
3.75, Sig
4.07]
  , rissetBellFreqShifts :: [Sig]
rissetBellFreqShifts    = [Sig
0,    Sig
1,    Sig
0,     Sig
1.7,    Sig
0,   Sig
0,   Sig
0,    Sig
0,    Sig
0,      Sig
0,      Sig
0]
  , rissetBellAmps :: [Sig]
rissetBellAmps        = [Sig
1,    Sig
0.67, Sig
1.35, Sig
1.8,  Sig
2.67, Sig
1.67, Sig
1.46,  Sig
1.33, Sig
1.33,  Sig
0.75, Sig
1.33]
  , rissetBellRands :: [D]
rissetBellRands         = [D
0.56, D
0.56, D
0.92,  D
0.92,  D
1.19,  D
1.7,  D
2,    D
2.74, D
3,      D
3.75,  D
4.07]
  , rissetBellRandShifts :: [D]
rissetBellRandShifts    = [D
0,    D
1,    D
0,     D
1.7,   D
0,     D
0,    D
0,    D
0,    D
0,      D
0,     D
0] }

-- | > dac $ noiseBell (31, 125) 2.3 0.2 2900
noiseBell :: (D, D) -> D -> Sig -> Sig -> SE Sig
noiseBell :: (D, D) -> D -> Sig -> Sig -> SE Sig
noiseBell (D
from, D
to) D
dur Sig
amp Sig
cps = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
env (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ RissetBellSpec -> (D, D) -> D -> Sig -> Sig -> SE Sig
rissetBell RissetBellSpec
noiseBellSpec (D
from, D
to) D
dur Sig
amp Sig
cps
  where env :: Sig
env = [D] -> D -> D -> Sig
expsegr [D
1, D
dur, D
0.001] D
dur D
0.001

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

-- | speed ~ 10 - 20
--
-- > snowCrackle speed
snowCrackle :: Sig -> Sig
snowCrackle :: Sig -> Sig
snowCrackle Sig
speed = Sig -> Sig -> Sig -> Sig
mlp Sig
1200 Sig
0.1 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> Sig
mouseDrum Sig
speed (Sig
3 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
uosc Sig
0.1)  (Sig
160 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
100 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
uosc Sig
0.13)
  where
    mouseDrum :: Sig -> Sig -> Sig -> Sig
    mouseDrum :: Sig -> Sig -> Sig -> Sig
mouseDrum Sig
freq Sig
index Sig
cps =
      ((D, D) -> SE Sig) -> Evt (Sco (D, D)) -> Sig
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched (D, D) -> SE Sig
forall (m :: * -> *). Monad m => (D, D) -> m Sig
instr (Evt (Sco (D, D)) -> Sig) -> Evt (Sco (D, D)) -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Evt (D, D) -> Evt (Sco (D, D))
forall a. Sig -> Evt a -> Evt (Sco a)
withDur (D -> Sig
sig D
dur) (Evt (D, D) -> Evt (Sco (D, D))) -> Evt (D, D) -> Evt (Sco (D, D))
forall a b. (a -> b) -> a -> b
$ ([D] -> (D, D)) -> Evt [D] -> Evt (D, D)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[D
a, D
b] -> (D
a, D
b)) (Evt [D] -> Evt (D, D)) -> Evt [D] -> Evt (D, D)
forall a b. (a -> b) -> a -> b
$ Int -> Evt Unit -> Evt [D]
forall b. Int -> Evt b -> Evt [D]
randList Int
2 (Evt Unit -> Evt [D]) -> Evt Unit -> Evt [D]
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit
dust Sig
freq
      where
        dur :: D
dur = D
0.049
        instr :: (D, D) -> m Sig
instr (D
rndCps, D
rndIndex) = Sig -> m Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> m Sig) -> Sig -> m Sig
forall a b. (a -> b) -> a -> b
$
          D -> Sig -> Sig -> Sig
mouseDrumGrain D
dur
            (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
10 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig (D
2 D -> D -> D
forall a. Num a => a -> a -> a
* D
rndCps D -> D -> D
forall a. Num a => a -> a -> a
- D
1))
            (Sig
index Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
0.01 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig (D
2 D -> D -> D
forall a. Num a => a -> a -> a
* D
rndIndex D -> D -> D
forall a. Num a => a -> a -> a
- D
1))

    mouseDrumGrain :: D -> Sig -> Sig -> Sig
mouseDrumGrain D
dur Sig
icarfreq Sig
index = Sig
aosc
      where
        iratio :: Sig
iratio = Sig
1.416
        idev :: Sig
idev = Sig
imodfreq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
index
        imodfreq :: Sig
imodfreq = Sig
icarfreq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
iratio
        amod :: Sig
amod = Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
idev Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
imodfreq) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
osc Sig
imodfreq
        kenv :: Sig
kenv = [D] -> D -> D -> Sig
expsegr [D
1, D
dur, D
0.001] D
dur D
0.001
        aosc :: Sig
aosc = Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
kenv (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
osc (Sig
icarfreq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
amod)

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

fmDronePartial :: Sig -> p -> Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig) -> Sig
fmDronePartial Sig
amod' p
_index Sig
idev Sig
kamp1 Sig
ifreq1 (Sig
a1, Sig
a2, Sig
a3, Sig
a4) = Sig
ares
  where
    aosc1 :: Sig
aosc1 = Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
idev Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
kamp1) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
osc (Sig
ifreq1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a1)
    aosc2 :: Sig
aosc2 = Sig -> Sig
osc (Sig
ifreq1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
aosc1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
amod')
    aosc3 :: Sig
aosc3 = Sig -> Sig
osc (Sig
ifreq1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a3 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
aosc1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
amod')
    aosc4 :: Sig
aosc4 = Sig -> Sig
osc (Sig
a4 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
aosc1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
amod')
    ares :: Sig
ares  = Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
kamp1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Sig
aosc2, Sig
aosc3, Sig
aosc4]

scDrone :: (D, D) -> Sig -> Sig2
scDrone :: (D, D) -> Sig -> Sig2
scDrone = Sig -> (D, D) -> Sig -> Sig2
fmDrone Sig
3

scDrones :: [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2
scDrones :: [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2
scDrones = Sig -> [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2
fmDrones Sig
3

pulseIndex :: [Int] -> Sig -> Sig
pulseIndex :: [Int] -> Sig -> Sig
pulseIndex [Int]
ns Sig
speed = Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
7 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [Seq] -> Sig -> Sig
seqSqr [[Int] -> Seq
seqDesc [Int]
ns] Sig
speed

fmPulse :: [Int] -> Sig -> Sig -> Sig2
fmPulse :: [Int] -> Sig -> Sig -> Sig2
fmPulse [Int]
ns Sig
speed = Sig -> (D, D) -> Sig -> Sig2
fmDrone ([Int] -> Sig -> Sig
pulseIndex [Int]
ns Sig
speed) (D
0.05, D
0.5)

fmPulses :: [Sig] -> [Sig] -> [Int] -> Sig -> Sig -> SE Sig2
fmPulses :: [Sig] -> [Sig] -> [Int] -> Sig -> Sig -> SE Sig2
fmPulses [Sig]
amps [Sig]
harms [Int]
ns Sig
speed = Sig -> [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2
fmDrones ([Int] -> Sig -> Sig
pulseIndex [Int]
ns Sig
speed) [Sig]
amps [Sig]
harms (D
0.05, D
0.5)

-- | > dac $ fmDrone 3 (20, 5) 110
fmDrone :: Sig -> (D, D) -> Sig -> Sig2
fmDrone :: Sig -> (D, D) -> Sig -> Sig2
fmDrone Sig
index (D
iatt, D
irel) Sig
cps = (Sig
aout1, Sig
aout2)
  where
    ifreq1 :: Sig
ifreq1 = Sig
cps
    iamp :: Sig
iamp = Sig
0.39
    idev :: Sig
idev = Sig
index Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
ifreq1
    kamp1 :: Sig
kamp1 = D -> D -> D -> D -> Sig
leg D
iatt D
0 D
1 D
irel

    f :: Sig -> Sig -> Sig -> Sig -> Sig
f Sig
a1 Sig
a2 Sig
a3 Sig
a4 = Sig
iamp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig -> Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig) -> Sig
forall p.
Sig -> p -> Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig) -> Sig
fmDronePartial Sig
0 Sig
index Sig
idev Sig
kamp1 Sig
ifreq1 (Sig
a1, Sig
a2, Sig
a3, Sig
a4)

    aout1 :: Sig
aout1 = Sig -> Sig -> Sig -> Sig -> Sig
f Sig
1    Sig
0.998 Sig
1.5007 Sig
0.1
    aout2 :: Sig
aout2 = Sig -> Sig -> Sig -> Sig -> Sig
f Sig
0.99 Sig
0.987 Sig
1.498 Sig
0.13

fmDrones :: Sig -> [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2
fmDrones :: Sig -> [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2
fmDrones Sig
index [Sig]
amps [Sig]
harms (D
iatt, D
irel) Sig
cps = SE Sig2
aout
  where
    kamp1 :: Sig
kamp1 = D -> D -> D -> D -> Sig
leg D
iatt D
0 D
1 D
irel

    f :: Sig -> Sig -> SE Sig
f Sig
amp Sig
h = do
      let ifreq1 :: Sig
ifreq1 = Sig
h Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps
          idev :: Sig
idev = Sig
index Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
ifreq1

      Sig
a1 <- Sig -> Sig -> SE Sig
randomSig Sig
1     Sig
0.03
      Sig
a2 <- Sig -> Sig -> SE Sig
randomSig Sig
0.998 Sig
0.025
      Sig
a3 <- Sig -> Sig -> SE Sig
randomSig Sig
1.5   Sig
0.004
      Sig
a4 <- Sig -> Sig -> SE Sig
randomSig Sig
0.1   Sig
0.03
      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
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig -> Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig) -> Sig
forall p.
Sig -> p -> Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig) -> Sig
fmDronePartial Sig
0 Sig
index Sig
idev Sig
kamp1 Sig
ifreq1 (Sig
a1, Sig
a2, Sig
a3, Sig
a4)

    ares :: SE Sig
ares = ([Sig] -> Sig) -> SE [Sig] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [Sig] -> SE Sig) -> SE [Sig] -> SE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig -> SE Sig) -> [Sig] -> [Sig] -> SE [Sig]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Sig -> Sig -> SE Sig
f [Sig]
amps [Sig]
harms
    aout :: SE Sig2
aout = (Sig -> Sig -> Sig2) -> SE Sig -> SE Sig -> SE Sig2
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) SE Sig
ares SE Sig
ares

randomSig :: Sig -> Sig -> SE Sig
randomSig :: Sig -> Sig -> SE Sig
randomSig Sig
val Sig
dev = Sig -> Sig -> SE Sig
forall a. SigOrD a => a -> a -> SE a
random (Sig
val Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
dev) (Sig
val Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
dev)

------------------------------------------------------------------------
-- choir

sopranoOsc, tenorOsc :: (Sig -> Sig) -> Sig -> Sig -> SE Sig

tenorOsc :: (Sig -> Sig) -> Sig -> Sig -> SE Sig
tenorOsc   = Sig -> (Sig -> Sig) -> Sig -> Sig -> SE Sig
voiceOsc Sig
0.9
sopranoOsc :: (Sig -> Sig) -> Sig -> Sig -> SE Sig
sopranoOsc = Sig -> (Sig -> Sig) -> Sig -> Sig -> SE Sig
voiceOsc Sig
0.8

voiceOsc :: Sig -> (Sig -> Sig) -> Sig -> Sig -> SE Sig
voiceOsc :: Sig -> (Sig -> Sig) -> Sig -> Sig -> SE Sig
voiceOsc Sig
mulHarm Sig -> Sig
formantFilter Sig
kvib Sig
cps = (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
formantFilter (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b. (a -> b) -> a -> b
$ RndDev -> Sig -> Sig -> SE Sig
voiceAnimator (Sig -> Sig -> RndDev
RndDev Sig
0.05 Sig
0.75)  Sig
kvib (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
asig Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
kenv
  where
    iharms :: Sig
iharms = D -> Sig
sig D
getSampleRate Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.4 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
cps
    asig :: Sig
asig = Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Sig
gbuzz Sig
1 Sig
cps Sig
iharms Sig
1 Sig
mulHarm ([(PartialNumber, PartialNumber, PartialNumber)] -> Tab
sines3 [(PartialNumber
1, PartialNumber
1, PartialNumber
0.25)])
    kenv :: Sig
kenv = D -> D -> D -> D -> Sig
leg D
0.1 D
0 D
1 D
0.1

data RndDev = RndDev
  { RndDev -> Sig
rndDevRatio :: Sig
  , RndDev -> Sig
rndDevSpeed :: Sig
  }

voiceAnimator :: RndDev -> Sig -> Sig -> SE Sig
voiceAnimator :: RndDev -> Sig -> Sig -> SE Sig
voiceAnimator RndDev
rndDev Sig
kvib Sig
ain = SE Sig
aout
  where
    ktimes :: SE [Sig]
ktimes = (Sig -> Sig -> SE Sig) -> [Sig] -> [Sig] -> SE [Sig]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Sig
amp Sig
cps -> Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
osc Sig
cps) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ RndDev -> Sig -> SE Sig
addRnd RndDev
rndDev Sig
kvib) [Sig
0.0012, Sig
0.0009, Sig
0.00087, Sig
0.0011] [Sig
4, Sig
5, Sig
6.3, Sig
4.4]
    -- ktimes = zipWith (\amp cps -> kvib * amp * osc cps) [0.0012, 0.0009, 0.00087, 0.0011, 0.00093, 0.00081, 0.0071] [4, 5, 6.3, 4.4, 5.2, 4.2, 5.5]
    aout :: SE Sig
aout = ([Sig] -> Sig) -> SE [Sig] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> [Sig] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Sig
t -> Sig -> Sig -> D -> Sig
vdelay Sig
ain Sig
t D
0.015)) SE [Sig]
ktimes

addRnd :: RndDev -> Sig -> SE Sig
addRnd :: RndDev -> Sig -> SE Sig
addRnd RndDev
spec Sig
ain = do
  Sig
xDt <- Sig -> Sig -> SE Sig
randi (RndDev -> Sig
rndDevRatio RndDev
spec) (RndDev -> Sig
rndDevSpeed RndDev
spec)
  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
ain Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
xDt)