{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}

module Vivid.UGens.Reverbs (
     freeVerb
---   , freeVerb2
   , gVerb
   ) where

import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SynthDef
import Vivid.SynthDef.FromUA
import Vivid.UGens.Args

-- | \"mix\", \"room\", and \"damp\" params range from 0 to1
freeVerb :: (Args '["in"] '["mix", "room", "damp"] a) => a -> SDBody a Signal
freeVerb :: a -> SDBody a Signal
freeVerb = String
-> CalculationRate
-> Vs '["in", "mix", "room", "damp"]
-> (UA "mix" (SDBodyArgs a), UA "room" (SDBodyArgs a),
    UA "damp" (SDBodyArgs a))
-> a
-> SDBody a Signal
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args Signal
makeUGen
   String
"FreeVerb" CalculationRate
AR
   (Vs '["in", "mix", "room", "damp"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "mix", "room", "damp"])
   -- Strangely in SC it's "0.33" instead of (1/3) (greater precision). If we want exact compatibility we should switch to match that:
   (Float -> UA "mix" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "mix" as
mix_ (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3::Float), Float -> UA "room" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "room" as
room_ (Float
0.5::Float), Float -> UA "damp" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "damp" as
damp_ (Float
0.5::Float))

--- freeVerb2 ::
--- freeVerb2 =

-- | Note this is specifically a two-channel UGen
--
--   There are known issues with this! (From SC:)
-- 
--    - \"There is a large CPU spike when the synth is instantiated while all the delay lines are zeroed out.\"
--    - \"Quick changes in roomsize result in zipper noise.\"
--    - \"Changing the roomsize does not work properly! Still trying to look for the bug... (-josh)\"
--
--   Since: vivid-0.4.1
gVerb :: Args '["in"] '["roomSize", "revTime", "damping", "inputBW", "spread", "dryLevel", "earlyRefLevel", "tailLevel", "maxRoomSize"] a => a -> SDBody a [Signal]
gVerb :: a -> SDBody a [Signal]
gVerb = Int
-> String
-> CalculationRate
-> Vs
     '["in", "roomSize", "revTime", "damping", "inputBW", "spread",
       "dryLevel", "earlyRefLevel", "tailLevel", "maxRoomSize"]
-> (UA "roomSize" (SDBodyArgs a), UA "revTime" (SDBodyArgs a),
    UA "damping" (SDBodyArgs a), UA "inputBW" (SDBodyArgs a),
    UA "spread" (SDBodyArgs a), UA "dryLevel" (SDBodyArgs a),
    UA "earlyRefLevel" (SDBodyArgs a), UA "tailLevel" (SDBodyArgs a),
    UA "maxRoomSize" (SDBodyArgs a))
-> a
-> SDBody a [Signal]
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args [Signal]
makePolyUGen Int
2
   String
"GVerb" CalculationRate
AR
   (Vs
  '["in", "roomSize", "revTime", "damping", "inputBW", "spread",
    "dryLevel", "earlyRefLevel", "tailLevel", "maxRoomSize"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "roomSize", "revTime", "damping", "inputBW", "spread", "dryLevel", "earlyRefLevel", "tailLevel", "maxRoomSize"])
   (Float -> UA "roomSize" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "roomSize" as
roomSize_ (Float
10::Float), Float -> UA "revTime" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "revTime" as
revTime_ (Float
3::Float), Float -> UA "damping" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "damping" as
damping_ (Float
0.5::Float), Float -> UA "inputBW" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "inputBW" as
inputBW_ (Float
0.5::Float), Float -> UA "spread" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "spread" as
spread_ (Float
15::Float), Float -> UA "dryLevel" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "dryLevel" as
dryLevel_ (Float
1::Float), Float -> UA "earlyRefLevel" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "earlyRefLevel" as
earlyRefLevel_ (Float
0.7::Float), Float -> UA "tailLevel" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "tailLevel" as
tailLevel_ (Float
0.5::Float), Float -> UA "maxRoomSize" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "maxRoomSize" as
maxRoomSize_ (Float
300::Float))