-- | Padsynth algorithm. See the details at:
--
-- csound docs: <http://csound.github.io/docs/manual/GENpadsynth.html>
--
-- original description: <http://www.paulnasca.com/algorithms-created-by-me>
--
-- more detailed description: <http://zynaddsubfx.sourceforge.net/doc/PADsynth/PADsynth.htm>
--
-- An example:
--
-- > harms = [
-- >     1, 0.7600046992, 0.6199994683, 0.9399998784, 0.4400023818, 0.0600003302,
-- >     0.8499968648, 0.0899999291, 0.8199964762, 0.3199984133,
-- >     0.9400014281, 0.3000001907, 0.120003365, 0.1799997687, 0.5200006366]
-- >
-- > spec = defPadsynthSpec 42.2 harms
-- >
-- > main = dac $ mul 0.4 $ mixAt 0.35 largeHall2 $ mixAt 0.45 (echo 0.25 0.75) $
-- >             midi $ onMsg $ mul (fades 0.5 0.7) . padsynthOsc2 spec

module Csound.Air.Padsynth (
    -- * Generic padsynth oscillators
    padsynthOsc, padsynthOsc2,
    -- * Simple padsynth oscillators
    bwOscBy, bwOddOscBy, bwOscBy2, bwOddOscBy2,
    bwOsc, bwTri, bwSqr, bwSaw, bwOsc2, bwTri2, bwSqr2, bwSaw2,
    -- * Layered padsynth
    padsynthOscMultiCps, padsynthOscMultiCps2,
    padsynthOscMultiVol, padsynthOscMultiVol2,
    padsynthOscMultiVolCps, padsynthOscMultiVolCps2,

    -- * Granular oscillators
    morphsynthOscMultiCps, quadMorphsynthOscMultiCps
) where

import Data.List
import Control.Arrow (first, second)

import Csound.Typed
import Csound.Tab
import Csound.Air.Wave
import Csound.Typed.Opcode(poscil)
import Csound.Types(compareWhenD)

import Csound.Air.Granular.Morpheus

-- | Padsynth oscillator.
--
-- padsynthOsc spec frequency
--
-- It makes it easy to create padsynth sound waves (see Tab.padsynth).
-- It creates a padsynth table and reads it with poscil at the right speed.
padsynthOsc :: PadsynthSpec -> Sig -> SE Sig
padsynthOsc :: PadsynthSpec -> Sig -> SE Sig
padsynthOsc PadsynthSpec
spec Sig
freq = D -> Tab -> Sig -> SE Sig
padsynthOscByTab (Double -> D
double (Double -> D) -> Double -> D
forall a b. (a -> b) -> a -> b
$ PadsynthSpec -> Double
padsynthFundamental PadsynthSpec
spec) (PadsynthSpec -> Tab
padsynth PadsynthSpec
spec) Sig
freq

padsynthOscByTab :: D -> Tab -> Sig -> SE Sig
padsynthOscByTab :: D -> Tab -> Sig -> SE Sig
padsynthOscByTab D
baseFreq Tab
tab Sig
freq = SE Sig
ares
    where
        len :: D
len = Tab -> D
ftlen Tab
tab
        wave :: Sig -> SE Sig
wave = (D -> Sig -> Sig) -> Sig -> SE Sig
rndPhs (\D
phs Sig
frq -> Sig -> Sig -> Tab -> Sig
poscil Sig
1 Sig
frq Tab
tab Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
phs)
        ares :: SE Sig
ares = Sig -> SE Sig
wave (Sig
freq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ (D
getSampleRate D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
len) D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
baseFreq))

toStereoOsc :: (a -> SE Sig) -> (a -> SE Sig2)
toStereoOsc :: (a -> SE Sig) -> a -> SE Sig2
toStereoOsc a -> SE Sig
f a
x = do
    Sig
left  <- a -> SE Sig
f a
x
    Sig
right <- a -> SE Sig
f a
x
    Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig
left, Sig
right)

-- | Stereo padsynth oscillatro. It creates two padsynth ftables for left and right channels.
padsynthOsc2 :: PadsynthSpec -> Sig -> SE Sig2
padsynthOsc2 :: PadsynthSpec -> Sig -> SE Sig2
padsynthOsc2 PadsynthSpec
spec Sig
freq = (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc (PadsynthSpec -> Sig -> SE Sig
padsynthOsc PadsynthSpec
spec) Sig
freq

layeredPadsynthSpec :: D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec :: D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec D
val [(D, PadsynthSpec)]
specs = do
    Ref Tab
refTab      <- Tab -> SE (Ref Tab)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef Tab
lastTab
    Ref D
refBaseFreq <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef D
lastBaseFreq

    D -> [(D, SE ())] -> SE ()
compareWhenD D
val (((D, PadsynthSpec) -> (D, SE ()))
-> [(D, PadsynthSpec)] -> [(D, SE ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PadsynthSpec -> SE ()) -> (D, PadsynthSpec) -> (D, SE ())
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PadsynthSpec -> SE ()) -> (D, PadsynthSpec) -> (D, SE ()))
-> (PadsynthSpec -> SE ()) -> (D, PadsynthSpec) -> (D, SE ())
forall a b. (a -> b) -> a -> b
$ Ref Tab -> Ref D -> PadsynthSpec -> SE ()
toCase Ref Tab
refTab Ref D
refBaseFreq) [(D, PadsynthSpec)]
specs)

    Tab
tab <- Ref Tab -> SE Tab
forall a. Tuple a => Ref a -> SE a
readRef Ref Tab
refTab
    D
baseFreq <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
refBaseFreq

    (D, Tab) -> SE (D, Tab)
forall (m :: * -> *) a. Monad m => a -> m a
return (D
baseFreq, Tab
tab)
    where
        toCase :: Ref Tab -> Ref D -> PadsynthSpec -> SE ()
toCase Ref Tab
refTab Ref D
refBaseFreq PadsynthSpec
spec = do
            Ref Tab -> Tab -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Tab
refTab (PadsynthSpec -> Tab
padsynth PadsynthSpec
spec)
            Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
refBaseFreq (Double -> D
double (Double -> D) -> Double -> D
forall a b. (a -> b) -> a -> b
$ PadsynthSpec -> Double
padsynthFundamental PadsynthSpec
spec)

        lastTab :: Tab
lastTab      = PadsynthSpec -> Tab
padsynth (PadsynthSpec -> Tab) -> PadsynthSpec -> Tab
forall a b. (a -> b) -> a -> b
$ (D, PadsynthSpec) -> PadsynthSpec
forall a b. (a, b) -> b
snd ((D, PadsynthSpec) -> PadsynthSpec)
-> (D, PadsynthSpec) -> PadsynthSpec
forall a b. (a -> b) -> a -> b
$ [(D, PadsynthSpec)] -> (D, PadsynthSpec)
forall a. [a] -> a
last [(D, PadsynthSpec)]
specs
        lastBaseFreq :: D
lastBaseFreq = Double -> D
double (Double -> D) -> Double -> D
forall a b. (a -> b) -> a -> b
$ PadsynthSpec -> Double
padsynthFundamental (PadsynthSpec -> Double) -> PadsynthSpec -> Double
forall a b. (a -> b) -> a -> b
$ (D, PadsynthSpec) -> PadsynthSpec
forall a b. (a, b) -> b
snd ((D, PadsynthSpec) -> PadsynthSpec)
-> (D, PadsynthSpec) -> PadsynthSpec
forall a b. (a -> b) -> a -> b
$ [(D, PadsynthSpec)] -> (D, PadsynthSpec)
forall a. [a] -> a
last [(D, PadsynthSpec)]
specs

-- | It uses several padsynth tables. Each table is responsible for specific interval of frequencies.
-- The list of pairs specifies the threshhold value and padsynth specification.
-- The padsynth table is active for all frequencies that lie below the given threshold.
--
-- > padsynthOscMultiCps thresholdSpecPairs frequency = ...
padsynthOscMultiCps :: [(Double, PadsynthSpec)] -> D -> SE Sig
padsynthOscMultiCps :: [(Double, PadsynthSpec)] -> D -> SE Sig
padsynthOscMultiCps [(Double, PadsynthSpec)]
specs D
freq = do
    (D
baseFreq, Tab
tab) <- D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec D
freq (((Double, PadsynthSpec) -> (D, PadsynthSpec))
-> [(Double, PadsynthSpec)] -> [(D, PadsynthSpec)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> D) -> (Double, PadsynthSpec) -> (D, PadsynthSpec)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Double -> D
double) [(Double, PadsynthSpec)]
specs)
    D -> Tab -> Sig -> SE Sig
padsynthOscByTab D
baseFreq Tab
tab (D -> Sig
sig D
freq)

-- | Stereo version of @padsynthOscMultiCps@.
padsynthOscMultiCps2 :: [(Double, PadsynthSpec)] -> D -> SE Sig2
padsynthOscMultiCps2 :: [(Double, PadsynthSpec)] -> D -> SE Sig2
padsynthOscMultiCps2 [(Double, PadsynthSpec)]
specs D
freq = do
    (D
baseFreq, Tab
tab) <- D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec D
freq (((Double, PadsynthSpec) -> (D, PadsynthSpec))
-> [(Double, PadsynthSpec)] -> [(D, PadsynthSpec)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> D) -> (Double, PadsynthSpec) -> (D, PadsynthSpec)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Double -> D
double) [(Double, PadsynthSpec)]
specs)
    (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc (D -> Tab -> Sig -> SE Sig
padsynthOscByTab D
baseFreq Tab
tab) (D -> Sig
sig D
freq)

-- | It behaves just like @padsynthOscMultiCps@ but it spreads the padsynth tables among amplitude values.
-- So the last input argument is a pair of amplitude and frequency:
--
-- > padsynthOscMultiVol thresholdSpecPairs (amplitude, frequency) = ...
padsynthOscMultiVol :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig
padsynthOscMultiVol :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig
padsynthOscMultiVol [(Double, PadsynthSpec)]
specs (D
amp, Sig
freq) = do
    (D
baseFreq, Tab
tab) <- D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec D
amp (((Double, PadsynthSpec) -> (D, PadsynthSpec))
-> [(Double, PadsynthSpec)] -> [(D, PadsynthSpec)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> D) -> (Double, PadsynthSpec) -> (D, PadsynthSpec)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Double -> D
double) [(Double, PadsynthSpec)]
specs)
    (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ D -> Tab -> Sig -> SE Sig
padsynthOscByTab D
baseFreq Tab
tab Sig
freq

-- | Stereo version of @padsynthOscMultiVol@.
padsynthOscMultiVol2 :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig2
padsynthOscMultiVol2 :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig2
padsynthOscMultiVol2 [(Double, PadsynthSpec)]
specs (D
amp, Sig
freq) = do
    (D
baseFreq, Tab
tab) <- D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec D
amp (((Double, PadsynthSpec) -> (D, PadsynthSpec))
-> [(Double, PadsynthSpec)] -> [(D, PadsynthSpec)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> D) -> (Double, PadsynthSpec) -> (D, PadsynthSpec)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Double -> D
double) [(Double, PadsynthSpec)]
specs)
    (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc ((Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig D
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) (SE Sig -> SE Sig) -> (Sig -> SE Sig) -> Sig -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Tab -> Sig -> SE Sig
padsynthOscByTab D
baseFreq Tab
tab) Sig
freq

-- | TODO (undefined function)
--
-- With this function we can create square zones in the domain of @(amplitude, frequency)@.
-- We can assign a separate padsynth table for each zone.
-- The list of pairs contains a pair of two threshold values @(amplitude, frequency)@ and dedicated padsynth specification.
--
-- > padsynthOscMultiVolCps thresholdSpecPairs (amplitude, frequency) = ...
padsynthOscMultiVolCps :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig
padsynthOscMultiVolCps :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig
padsynthOscMultiVolCps [((Double, Double), PadsynthSpec)]
_ = (D, D) -> SE Sig
forall a. HasCallStack => a
undefined

-- | TODO (undefined function)
--
-- Stereo version of @padsynthOscMultiVolCps@.
padsynthOscMultiVolCps2 :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig2
padsynthOscMultiVolCps2 :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig2
padsynthOscMultiVolCps2 [((Double, Double), PadsynthSpec)]
specs (D, D)
x = ((D, D) -> SE Sig) -> (D, D) -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc ([((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig
padsynthOscMultiVolCps [((Double, Double), PadsynthSpec)]
specs) (D, D)
x

----------------------------------------------------
-- waves

-- | Creates padsynth oscillator with given harmonics.
--
-- > bwOscBy harmonics bandwidth frequency
bwOscBy :: [Double] -> Double -> Sig -> SE Sig
bwOscBy :: [Double] -> Double -> Sig -> SE Sig
bwOscBy [Double]
harmonics Double
bandwidth = PadsynthSpec -> Sig -> SE Sig
padsynthOsc (Double -> [Double] -> PadsynthSpec
defPadsynthSpec Double
bandwidth [Double]
harmonics)

-- | Stereo version of @bwOscBy@.
bwOscBy2 :: [Double] -> Double -> Sig -> SE Sig2
bwOscBy2 :: [Double] -> Double -> Sig -> SE Sig2
bwOscBy2 [Double]
harmonics Double
bandwidth = (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc ([Double] -> Double -> Sig -> SE Sig
bwOscBy [Double]
harmonics Double
bandwidth)

-- | Creates padsynth oscillator with given odd harmonics.
--
-- > bwOddOscBy harmonics bandwidth frequency
bwOddOscBy :: [Double] -> Double -> Sig -> SE Sig
bwOddOscBy :: [Double] -> Double -> Sig -> SE Sig
bwOddOscBy [Double]
harmonics Double
bandwidth = PadsynthSpec -> Sig -> SE Sig
padsynthOsc ((Double -> [Double] -> PadsynthSpec
defPadsynthSpec Double
bandwidth [Double]
harmonics) { padsynthHarmonicStretch :: Double
padsynthHarmonicStretch = Double
2 })

-- | Stereo version of @bwOddOscBy@.
bwOddOscBy2 :: [Double] -> Double -> Sig -> SE Sig2
bwOddOscBy2 :: [Double] -> Double -> Sig -> SE Sig2
bwOddOscBy2 [Double]
harmonics Double
bandwidth = (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc ([Double] -> Double -> Sig -> SE Sig
bwOddOscBy [Double]
harmonics Double
bandwidth)

limit :: Int
limit :: Int
limit = Int
15

triCoeff, sqrCoeff, sawCoeff :: [Double]

triCoeff :: [Double]
triCoeff = Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
intersperse Double
0 ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) ((Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (-Double
1)) (Double
1)) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double
1, Double
3 ..]
sqrCoeff :: [Double]
sqrCoeff = Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
intersperse Double
0 ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) ((Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (-Double
1)) (Double
1)) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x))     ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double
1, Double
3 ..]
sawCoeff :: [Double]
sawCoeff = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) ((Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (-Double
1)) (Double
1)) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x)) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double
1, Double
2 ..]

-- | Pure sine wave with padsynth wave table:
--
-- > bwOsc bandwidth frequency
bwOsc :: Double -> Sig -> SE Sig
bwOsc :: Double -> Sig -> SE Sig
bwOsc = [Double] -> Double -> Sig -> SE Sig
bwOscBy [Double
1]

-- | Triangle wave with padsynth wave table:
--
-- > bwTri bandwidth frequency
bwTri :: Double -> Sig -> SE Sig
bwTri :: Double -> Sig -> SE Sig
bwTri = [Double] -> Double -> Sig -> SE Sig
bwOscBy (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
limit [Double]
triCoeff)

-- | Square wave with padsynth wave table:
--
-- > bwSqr bandwidth frequency
bwSqr :: Double -> Sig -> SE Sig
bwSqr :: Double -> Sig -> SE Sig
bwSqr = [Double] -> Double -> Sig -> SE Sig
bwOscBy (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
limit [Double]
sqrCoeff)

-- | Saw-tooth wave with padsynth wave table:
--
-- > bwSaw bandwidth frequency
bwSaw :: Double -> Sig -> SE Sig
bwSaw :: Double -> Sig -> SE Sig
bwSaw = [Double] -> Double -> Sig -> SE Sig
bwOscBy (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
limit [Double]
sawCoeff)


-- | Stereo version of @bwOsc@.
bwOsc2 :: Double -> Sig -> SE Sig2
bwOsc2 :: Double -> Sig -> SE Sig2
bwOsc2 Double
bandwidth = (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc (Double -> Sig -> SE Sig
bwOsc Double
bandwidth)

-- | Stereo version of @bwTri@.
bwTri2 :: Double -> Sig -> SE Sig2
bwTri2 :: Double -> Sig -> SE Sig2
bwTri2 Double
bandwidth = (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc (Double -> Sig -> SE Sig
bwTri Double
bandwidth)

-- | Stereo version of @bwSqr@.
bwSqr2 :: Double -> Sig -> SE Sig2
bwSqr2 :: Double -> Sig -> SE Sig2
bwSqr2 Double
bandwidth = (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc (Double -> Sig -> SE Sig
bwSqr Double
bandwidth)

-- | Stereo version of @bwSaw@.
bwSaw2 :: Double -> Sig -> SE Sig2
bwSaw2 :: Double -> Sig -> SE Sig2
bwSaw2 Double
bandwidth = (Sig -> SE Sig) -> Sig -> SE Sig2
forall a. (a -> SE Sig) -> a -> SE Sig2
toStereoOsc (Double -> Sig -> SE Sig
bwSaw Double
bandwidth)

-- Interesting algorithms / examples

-- harms = [ 1,  1, 0.7600046992, 0.6199994683, 0.9399998784, 0.4400023818, 0.0600003302, 0.8499968648, 0.0899999291, 0.8199964762, 0.3199984133, 0.9400014281, 0.3000001907, 0.120003365, 0.1799997687, 0.5200006366]
-- spec = defPadsynthSpec 82.2 harms
-- dac $ mul 0.4 $ at (bhp 30) $ mixAt 0.35 largeHall2 $ mixAt 0.45 (echo 0.25 0.75) $ midi $ onMsg $ (\cps -> (at (mlp (200 + (cps + 3000)) 0.15) . mul (fades 0.5 0.7) . padsynthOsc2 spec) cps)


-- noisy
-- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.35 largeHall2 $ mixAt 0.5 (echo 0.25 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3]) 14) pink) +  padsynthOsc2 spec x + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps)
-- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.35 largeHall2 $ mixAt 0.5 (echo 0.25 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . bat (bp (x * 5) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3]) 14) white) +  padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps)
-- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.15 magicCave2 $ mixAt 0.43 (echo 0.35 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . bat (bp (x * 11) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3] * uosc (expseg [0.25, 5, 8])) 14) white) +  padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps)

-- an idea ^ to crossfade between noises 4 knobs and to crossfade between harmonics other 4 knobs
-- for a synth

----------------------------------------------------------------
-- morpheus oscil

-- | Combines morpheus oscillators with padsynth algorithm.
-- It uses single table for granular synthesis.
morphsynthOscMultiCps :: MorphSpec -> [(Double, PadsynthSpec)] -> D -> SE Sig2
morphsynthOscMultiCps :: MorphSpec -> [(Double, PadsynthSpec)] -> D -> SE Sig2
morphsynthOscMultiCps MorphSpec
morphSpec [(Double, PadsynthSpec)]
specs D
freq = do
    (D
baseFreq, Tab
tab) <- D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec D
freq (((Double, PadsynthSpec) -> (D, PadsynthSpec))
-> [(Double, PadsynthSpec)] -> [(D, PadsynthSpec)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> D) -> (Double, PadsynthSpec) -> (D, PadsynthSpec)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Double -> D
double) [(Double, PadsynthSpec)]
specs)
    MorphSpec -> (D, Tab) -> Sig -> SE Sig2
morpheusOsc MorphSpec
morphSpec (D
baseFreq, Tab
tab) (D -> Sig
sig D
freq)

-- | Combines morpheus oscillators with padsynth algorithm.
-- It uses up to four tables for granular synthesis.
quadMorphsynthOscMultiCps :: MorphSpec -> [[(Double, PadsynthSpec)]] -> (Sig, Sig) -> D -> SE Sig2
quadMorphsynthOscMultiCps :: MorphSpec -> [[(Double, PadsynthSpec)]] -> Sig2 -> D -> SE Sig2
quadMorphsynthOscMultiCps MorphSpec
morphSpec [[(Double, PadsynthSpec)]]
specs (Sig
x, Sig
y) D
freq = do
    [(D, Tab)]
freqTabs <- ([(Double, PadsynthSpec)] -> SE (D, Tab))
-> [[(Double, PadsynthSpec)]] -> SE [(D, Tab)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [(Double, PadsynthSpec)] -> SE (D, Tab)
getFreqTab [[(Double, PadsynthSpec)]]
specs
    let mainFreq :: D
mainFreq = (D, Tab) -> D
forall a b. (a, b) -> a
fst ((D, Tab) -> D) -> (D, Tab) -> D
forall a b. (a -> b) -> a -> b
$ [(D, Tab)] -> (D, Tab)
forall a. [a] -> a
head [(D, Tab)]
freqTabs
    MorphSpec -> D -> [(Sig, Tab)] -> Sig2 -> Sig -> SE Sig2
morpheusOsc2 MorphSpec
morphSpec D
mainFreq (((D, Tab) -> (Sig, Tab)) -> [(D, Tab)] -> [(Sig, Tab)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> (D, Tab) -> (Sig, Tab)
forall b. D -> (D, b) -> (Sig, b)
toTab D
mainFreq) [(D, Tab)]
freqTabs) (Sig
x, Sig
y) (D -> Sig
sig D
freq)
    where
        getFreqTab :: [(Double, PadsynthSpec)] -> SE (D, Tab)
getFreqTab [(Double, PadsynthSpec)]
spec = D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec D
freq (((Double, PadsynthSpec) -> (D, PadsynthSpec))
-> [(Double, PadsynthSpec)] -> [(D, PadsynthSpec)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> D) -> (Double, PadsynthSpec) -> (D, PadsynthSpec)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Double -> D
double) [(Double, PadsynthSpec)]
spec)
        toTab :: D -> (D, b) -> (Sig, b)
toTab D
mainFreq (D
frq, b
t) = (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
frq D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
mainFreq, b
t)