module Csound.Typed.Plugins.SolinaChorus(
    solinaChorus, testSolinaChorus
) where

import Csound.Dynamic

import Csound.Typed.Types
import Csound.Typed.GlobalState
import qualified Csound.Typed.GlobalState.Elements as E(solinaChorusPlugin)

-- Solina Chorus, based on Solina String Ensemble Chorus Module
--
--   based on:
--
--   J. Haible: Triple Chorus
--   http://jhaible.com/legacy/triple_chorus/triple_chorus.html
--
-- > solinaChorus (lfo_amp1, lfo_freq1) (lfo_amp2, lfo_freq2)
--
--   Author: Steven Yi
--   Date: 2016.05.22
--
-- Example
--
-- > x = solinaChorus (0.6, 0.18) (0.2, 6) x
solinaChorus :: (Sig, Sig) -> (Sig, Sig) -> Sig -> Sig
solinaChorus :: (Sig, Sig) -> (Sig, Sig) -> Sig -> Sig
solinaChorus (Sig
amp1, Sig
cps1) (Sig
amp2, Sig
cps2) Sig
ain = Sig -> Sig -> Sig -> Sig -> Sig -> Sig
solina_chorus Sig
ain Sig
cps1 Sig
amp1 Sig
cps2 Sig
amp2

testSolinaChorus :: Sig -> Sig
testSolinaChorus :: Sig -> Sig
testSolinaChorus Sig
x = (Sig, Sig) -> (Sig, Sig) -> Sig -> Sig
solinaChorus (Sig
0.6, Sig
0.18) (Sig
0.2, Sig
6) Sig
x

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

--   Solina Chorus, based on Solina String Ensemble Chorus Module
--
--   based on:
--
--   J. Haible: Triple Chorus
--   http://jhaible.com/legacy/triple_chorus/triple_chorus.html
--
--   Hugo Portillo: Solina-V String Ensemble
--   http://www.native-instruments.com/en/reaktor-community/reaktor-user-library/entry/show/4525/
--
--   Parabola tabled shape borrowed from Iain McCurdy delayStereoChorus.csd:
--   http://iainmccurdy.org/CsoundRealtimeExamples/Delays/delayStereoChorus.csd
--
--   Author: Steven Yi
--   Date: 2016.05.22
--
--  opcode solina_chorus, a, aKKKK
--
--  aLeft, klfo_freq1, klfo_amp1, klfo_freq2, klfo_amp2 xin
solina_chorus :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
solina_chorus :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
solina_chorus Sig
aLeft Sig
klfo_freq1 Sig
klfo_amp1 Sig
klfo_freq2 Sig
klfo_amp2 = GE E -> Sig
forall a. Val a => GE E -> a
fromGE (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ do
    UdoPlugin -> GE ()
addUdoPlugin UdoPlugin
E.solinaChorusPlugin
    E -> E -> E -> E -> E -> E
f (E -> E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
aLeft GE (E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
klfo_freq1 GE (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
klfo_amp1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
klfo_freq2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
klfo_amp2
    where f :: E -> E -> E -> E -> E -> E
f E
aLeft' E
klfo_freq1' E
klfo_amp1' E
klfo_freq2' E
klfo_amp2' = Name -> Spec1 -> [E] -> E
opcs Name
"solina_chorus" [(Rate
Ar, [Rate
Ar, Rate
Kr, Rate
Kr, Rate
Kr, Rate
Kr])] [E
aLeft', E
klfo_freq1', E
klfo_amp1', E
klfo_freq2', E
klfo_amp2']