{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# Language FlexibleContexts #-}
module Csound.Catalog.Wave.Thor(
  cathedralOrgan, cathedralOrganFx, hammondOrgan,

  amPiano, amPianoBy,

  pwBass, pwHarpsichord, pwEnsemble,
  pwBassBy, pwHarpsichordBy, pwEnsembleBy,


  simpleBass,

  ReleaseTime,
  EpianoOsc(..), epiano, epianoBy, pianoEnv, xpianoEnv,

  noisyChoir, thorWind, mildWind, boom, windWall,

  razorPad, razorLead
) where

import Prelude hiding (filter, all)
import Control.Monad

import Csound.Base hiding (pulse)

-- some instruments from the Thor explained series
--
-- https://www.propellerheads.se/substance/discovering-reason/index.cfm?article=part19&fuseaction=get_article

------------------------------
-- thor oscillators

------------------------------
-- 1 oscillators

cathedralOrganFx :: Sig -> Sig2
cathedralOrganFx :: Sig -> Sig2
cathedralOrganFx = Sig -> (Sig -> Sig2) -> Sig2 -> AtOut Sig Sig2 Sig2
forall a b c. MixAt a b c => Sig -> (a -> b) -> c -> AtOut a b c
mixAt Sig
0.25 Sig -> Sig2
largeHall (Sig2 -> Sig2) -> (Sig -> Sig2) -> Sig -> Sig2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig2
fromMono

cathedralOrgan :: Sig -> SE Sig
cathedralOrgan Sig
cps = 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
$ [SE Sig] -> SE 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 -> SE Sig) -> SE Sig) -> [Sig -> SE Sig] -> [SE Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
cps) [Sig -> Sig -> SE Sig
hammondOrgan Sig
3 , Sig -> (Sig -> SE Sig) -> Sig -> SE Sig
forall a. Sig -> (Sig -> a) -> Sig -> a
detune (Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
forall a. SigOrD a => a -> a
cent Sig
4) (Sig -> Sig -> SE Sig
hammondOrgan Sig
10), Sig -> (Sig -> SE Sig) -> Sig -> SE Sig
forall a. Sig -> (Sig -> a) -> Sig -> a
detune (Sig
3 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
forall a. SigOrD a => a -> a
cent Sig
3) (Sig -> Sig -> SE Sig
hammondOrgan Sig
6)]

-- | hammondOrgan detune
--
-- detune = [0, 30] (in cents)
hammondOrgan :: Sig -> Sig -> SE Sig
hammondOrgan :: Sig -> Sig -> SE Sig
hammondOrgan Sig
dt Sig
x = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> D -> Sig
fades D
0.01 D
0.05) (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 a. Fractional a => [a] -> a
mean (SE [Sig] -> SE Sig) -> SE [Sig] -> SE Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> SE Sig) -> [Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> SE Sig
rndOsc
  [ Sig
x
  , Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
forall a. SigOrD a => a -> a
cent Sig
dt
  , Sig
3 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
forall a. SigOrD a => a -> a
cent (Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt) ]

------------------------------
-- 2 am & sync

amPianoBy :: ResonFilter -> Sig -> SE Sig
amPianoBy :: ResonFilter -> Sig -> SE Sig
amPianoBy ResonFilter
filter Sig
x = 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
$ (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 (ResonFilter
filter (Sig
env Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
3000 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
x)) Sig
0.25) (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b. (a -> b) -> a -> b
$ (Sig -> SE Sig
rndSaw Sig
x SE Sig -> SE Sig -> SE Sig
forall a. Num a => a -> a -> a
* Sig -> SE Sig
rndSaw (Sig
4 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
x))
  where env :: Sig
env = D -> D -> D -> D -> Sig
leg D
0.01 D
4 D
0 D
0.02

amPiano :: Sig -> SE Sig
amPiano :: Sig -> SE Sig
amPiano = ResonFilter -> Sig -> SE Sig
amPianoBy ResonFilter
mlp

------------------------------
-- 3 pwm

pwBassBy :: ResonFilter -> Sig -> SE Sig
pwBassBy :: ResonFilter -> Sig -> SE Sig
pwBassBy ResonFilter
filter Sig
cps = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> D -> Sig
fades D
0.005 D
0.05) (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 (ResonFilter
filter Sig
1500  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 -> Sig -> SE Sig
rndPw (Sig
0.25 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
0.07 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
osc (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ (Sig
7 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
1000)))) Sig
cps

pwBass :: Sig -> SE Sig
pwBass :: Sig -> SE Sig
pwBass = ResonFilter -> Sig -> SE Sig
pwBassBy ResonFilter
mlp

simpleBass :: (D, D) -> Sig
simpleBass :: (D, D) -> Sig
simpleBass (D
amp, D
cps') = Sig
aout
  where
    cps :: Sig
cps = D -> Sig
sig D
cps'

    all :: Sig
all = [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
      [ Sig -> Sig
0.4 (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall a. Num a => a -> a -> a
* Tab -> Sig -> Sig
oscBy Tab
pulse (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.998 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.12
      , Sig -> Sig
0.4 (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
osc         (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
1.002 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.12
      , Sig -> Sig
0.4 (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall a. Num a => a -> a -> a
* Tab -> Sig -> Sig
oscBy Tab
pulse (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.998 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.12
      , Sig -> Sig
0.7 (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
osc         (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
cps         Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.24 ]

    aout :: Sig
aout = Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
kgain Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [D] -> D -> D -> Sig
linsegr [D
0, D
0.01, D
1, (D
3.5 D -> D -> D
forall a. Num a => a -> a -> a
* D
amp), D
0] D
0.35 D
0)
      (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig
blp (Sig
700 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ (D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
500))
      (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig
bhp Sig
65
      (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig
bhp Sig
65
      (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig
blp Sig
ksweep
      (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig
blp Sig
ksweep Sig
all

    ksweep :: Sig
ksweep = [D] -> D -> D -> Sig
expsegr [D
3000, D
0.03, D
9000] D
3 D
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
3000

    pulse :: Tab
pulse = [PartialStrength] -> Tab
sines [PartialStrength
1, PartialStrength
1, PartialStrength
1, PartialStrength
1, PartialStrength
0.7, PartialStrength
0.5, PartialStrength
0.3, PartialStrength
0.1]

    kgain :: Sig
kgain = Sig
2

pwHarpsichordBy :: ResonFilter -> Sig -> SE Sig
pwHarpsichordBy :: ResonFilter -> Sig -> SE Sig
pwHarpsichordBy ResonFilter
filter Sig
x = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
2.5 (SE Sig -> SE Sig) -> SE 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.005 D
1.5 D
0 D
0.25) (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 (ResonFilter
filter (Sig
env Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
8000) Sig
0.15) (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig 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 (ResonFilter
hp Sig
2500 Sig
0.3) (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> SE Sig
rndPw Sig
0.4 Sig
x
  where env :: Sig
env = D -> D -> D -> D -> Sig
leg D
0.01 D
4 D
0 D
0.01

pwHarpsichord :: Sig -> SE Sig
pwHarpsichord :: Sig -> SE Sig
pwHarpsichord = ResonFilter -> Sig -> SE Sig
pwHarpsichordBy ResonFilter
mlp

pwEnsembleBy :: ResonFilter -> Sig -> SE Sig
pwEnsembleBy :: ResonFilter -> Sig -> SE Sig
pwEnsembleBy ResonFilter
filter 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 (ResonFilter
filter (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)

pwEnsemble :: Sig -> SE Sig
pwEnsemble :: Sig -> SE Sig
pwEnsemble = ResonFilter -> Sig -> SE Sig
pwEnsembleBy ResonFilter
mlp

------------------------------
-- 4 Multi osc (unision)

type ReleaseTime = D

data EpianoOsc = EpianoOsc
  { EpianoOsc -> Int
epianoOscChorusNum :: Int
  , EpianoOsc -> Sig
epianoOscChorusAmt :: Sig
  , EpianoOsc -> Sig
epianoOscNum       :: Sig
  , EpianoOsc -> Sig
epianoOscWeight    :: Sig
  }

xpianoEnv :: ReleaseTime -> (D, D) -> Sig
xpianoEnv :: D -> (D, D) -> Sig
xpianoEnv D
userRelease (D
amp, D
cps) = D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> D -> D -> D -> Sig
xeg D
0.01 D
sust D
0.25 D
rel
  where
    sust :: D
sust = D -> D -> D
forall a. (IfB a, OrdB a) => a -> a -> a
maxB (D
amp D -> D -> D
forall a. Num a => a -> a -> a
+ D
2 D -> D -> D
forall a. Num a => a -> a -> a
+ (D
0.7 D -> D -> D
forall a. Num a => a -> a -> a
- D
3 D -> D -> D
forall a. Num a => a -> a -> a
* D
k D -> D -> D
forall a. Floating a => a -> a -> a
** D
2)) D
0.1
    rel :: D
rel  = D
userRelease D -> D -> D
forall a. Num a => a -> a -> a
+ D -> D -> D
forall a. (IfB a, OrdB a) => a -> a -> a
maxB ((D
amp D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
5) D -> D -> D
forall a. Num a => a -> a -> a
+ D
0.05 D -> D -> D
forall a. Num a => a -> a -> a
- (D
k D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
10)) D
0.02
    k :: D
k    = D
cps D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
3500

pianoEnv :: ReleaseTime -> (D, D) -> Sig
pianoEnv :: D -> (D, D) -> Sig
pianoEnv D
userRelease (D
amp, D
cps) = D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> D -> D -> D -> Sig
leg D
0.001 D
sust D
0.25 D
rel
  where
    sust :: D
sust = D -> D -> D
forall a. (IfB a, OrdB a) => a -> a -> a
maxB (D
amp D -> D -> D
forall a. Num a => a -> a -> a
+ D
2 D -> D -> D
forall a. Num a => a -> a -> a
+ (D
0.7 D -> D -> D
forall a. Num a => a -> a -> a
- D
3 D -> D -> D
forall a. Num a => a -> a -> a
* D
k D -> D -> D
forall a. Floating a => a -> a -> a
** D
2)) D
0.1
    rel :: D
rel  = D
userRelease D -> D -> D
forall a. Num a => a -> a -> a
+ D -> D -> D
forall a. (IfB a, OrdB a) => a -> a -> a
maxB ((D
amp D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
5) D -> D -> D
forall a. Num a => a -> a -> a
+ D
0.05 D -> D -> D
forall a. Num a => a -> a -> a
- (D
k D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
10)) D
0.02
    k :: D
k    = D
cps D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
3500

epianoBy :: ResonFilter -> ReleaseTime -> [EpianoOsc] -> (D, D) -> SE Sig
epianoBy :: ResonFilter -> D -> [EpianoOsc] -> (D, D) -> SE Sig
epianoBy ResonFilter
filter D
releaseTime [EpianoOsc]
xs (D
amp, D
cps) = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (D -> (D, D) -> Sig
pianoEnv D
releaseTime (D
amp, D
cps)) (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 (ResonFilter
filter (Sig
2500 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
4500 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (D -> D -> D -> D -> Sig
leg D
0.085 D
3 D
0 D
0.1)) Sig
0.25) (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig 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
$ (EpianoOsc -> SE Sig) -> [EpianoOsc] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\EpianoOsc
x -> Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (EpianoOsc -> Sig
epianoOscWeight EpianoOsc
x) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Int -> Sig -> (Sig -> SE Sig) -> Sig -> SE Sig
forall a.
Fractional a =>
Int -> Sig -> (Sig -> SE a) -> Sig -> SE a
multiRndSE (EpianoOsc -> Int
epianoOscChorusNum EpianoOsc
x) (EpianoOsc -> Sig
epianoOscChorusAmt EpianoOsc
x) (Sig -> (Sig -> SE Sig) -> Sig -> SE Sig
forall a. Sig -> (Sig -> a) -> Sig -> a
detune (EpianoOsc -> Sig
epianoOscNum EpianoOsc
x) Sig -> SE Sig
rndOsc) (D -> Sig
sig D
cps)) [EpianoOsc]
xs

epiano :: ReleaseTime -> [EpianoOsc] -> (D, D) -> SE Sig
epiano :: D -> [EpianoOsc] -> (D, D) -> SE Sig
epiano = ResonFilter -> D -> [EpianoOsc] -> (D, D) -> SE Sig
epianoBy ResonFilter
mlp

------------------------------
-- 5 noise

noisyChoir :: Int -> Sig -> Sig -> SE Sig
noisyChoir :: Int -> Sig -> Sig -> SE Sig
noisyChoir Int
n Sig
ratio Sig
cps = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
0.5 (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ SE Sig -> [Sig] -> [Sig] -> Int -> Sig -> Sig -> SE Sig
genGhostChoir SE Sig
white [Sig
1, Sig
1] [Sig
1, Sig
0.5] Int
n (Sig
5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
300 Sig -> Sig -> Sig
forall a. Floating a => a -> a -> a
** Sig
ratio) Sig
cps

genGhostChoir :: (SE Sig) -> [Sig] -> [Sig] -> Int -> Sig -> Sig -> SE Sig
genGhostChoir :: SE Sig -> [Sig] -> [Sig] -> Int -> Sig -> Sig -> SE Sig
genGhostChoir SE Sig
noiseGen [Sig]
amps [Sig]
hs Int
n Sig
bw 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
$ ([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]
hs
  where
    f :: Sig -> Sig -> SE Sig
    f :: Sig -> Sig -> SE Sig
f Sig
a Sig
h = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
a (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. At Sig a b => (Sig -> a) -> b -> AtOut Sig a b
bat (Int -> ResonFilter -> ResonFilter
filt Int
n ResonFilter
bp (Sig
h Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps) Sig
bw) SE Sig
noiseGen
    env :: Sig
env = D -> D -> Sig
fades D
0.4 D
0.5

------------------------------
-- 6 noise

mildWind :: Sig -> SE Sig
mildWind :: Sig -> SE Sig
mildWind Sig
cps = Sig -> Sig -> Sig2 -> SE Sig
thorWind (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
2) Sig
120 (Sig
0.2, Sig
0.5)

thorWind :: Sig -> Sig -> (Sig, Sig) -> SE Sig
thorWind :: Sig -> Sig -> Sig2 -> SE Sig
thorWind Sig
cps Sig
bw (Sig
speedMin, Sig
speedMax) = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
1.3 (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ do
  Sig
speed <- Sig -> Sig -> Sig -> Sig -> SE Sig
rspline (-Sig
1) Sig
1 Sig
speedMin Sig
speedMax
  (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 (ResonFilter
mlp (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
bw Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
speed) Sig
0.8) SE Sig
pink

boom :: Sig -> SE Sig
boom :: Sig -> SE Sig
boom Sig
cps = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
1.2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> D -> D -> Sig
expon D
1 D
2.05 D
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
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 -> SE Sig) -> [Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Sig
x -> (Sig -> Sig) -> SE Sig -> AtOut Sig Sig (SE Sig)
forall a b. At Sig a b => (Sig -> a) -> b -> AtOut Sig a b
bat (ResonFilter
bp (Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
x) Sig
10) SE Sig
white) [Sig
1, Sig
1.51, Sig
2.1, Sig
3.05]

windWall :: Sig -> SE Sig
windWall :: Sig -> SE Sig
windWall Sig
cps = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
amEnv (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
hp1 Sig
400) (SE Sig -> AtOut Sig Sig (SE Sig))
-> SE Sig -> AtOut Sig 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 (ResonFilter
mlp (Sig
filtEnv Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps) Sig
0.2) (Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
20 SE Sig
white )
  where
    amEnv :: Sig
amEnv   = D -> D -> D -> D -> Sig
leg D
7 D
10 D
0 D
8
    filtEnv :: Sig
filtEnv = D -> D -> D -> D -> Sig
leg D
6 D
0 D
1 D
5

------------------------------
-- 9, 10 fm

razorPad :: (Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
razorPad Sig -> t -> Sig -> b
filter Sig
speed Sig
amp Sig
frq = Sig -> SE b
f Sig
frq SE b -> SE b -> SE b
forall a. Num a => a -> a -> a
+ SE b
0.75 SE b -> SE b -> SE b
forall a. Num a => a -> a -> a
* Sig -> SE b
f (Sig
frq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.5)
  where f :: Sig -> SE b
f Sig
cps = Sig -> SE b -> SE b
forall a. SigSpace a => Sig -> a -> a
mul (D -> D -> D -> D -> Sig
leg D
0.5 D
0 D
1 D
1) (SE b -> SE b) -> SE b -> SE b
forall a b. (a -> b) -> a -> b
$ (Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
forall b t.
(SigSpace (SE b), Fractional t) =>
(Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
genRazor Sig -> t -> Sig -> b
filter Sig
speed Sig
amp Sig
cps

razorLead :: Sig -> Sig -> Sig -> Sig -> SE Sig
razorLead Sig
bright Sig
speed Sig
amp Sig
cps = 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
* D -> D -> D -> D -> Sig
leg D
0.01 D
1 D
0.5 D
0.5) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ ResonFilter -> Sig -> Sig -> Sig -> SE Sig
forall b t.
(SigSpace (SE b), Fractional t) =>
(Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
genRazor (Int -> ResonFilter -> ResonFilter
filt Int
2 (Sig -> ResonFilter
lp18 (Sig -> ResonFilter) -> Sig -> ResonFilter
forall a b. (a -> b) -> a -> b
$ Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
bright)) Sig
speed Sig
amp Sig
cps

genRazor :: (Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
genRazor Sig -> t -> Sig -> b
filter 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
filter (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 -> ResonFilter
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 -> ResonFilter
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 -> ResonFilter
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))