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

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

module Vivid.UGens.Filters.Pitch (
     freqShift
   , pitchShift
   , vibrato
   ) where

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

-- | \"Moves all the components of a signal by a fixed amount but does not preserve the original harmonic relationships.\" You might want 'Vivid.UGens.Filters.Pitch.pitchShift' instead.
freqShift :: (Args '["in"] '["freq", "phase"] a) => a -> SDBody a Signal
freqShift :: a -> SDBody a Signal
freqShift = String
-> CalculationRate
-> Vs '["in", "freq", "phase"]
-> (UA "freq" (SDBodyArgs a), UA "phase" (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
"FreqShift" CalculationRate
AR
   (Vs '["in", "freq", "phase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "phase"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
0::Float), Float -> UA "phase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "phase" as
phase_ (Float
0::Float))

        {-
pitchShift :: In a -> Ratio a -> SDBody a Signal
pitchShift (In inp) (Ratio ratio) = do
   in' <- toSigM inp
   ratio' <- toSigM ratio
   addUGen $ UGen (UGName_S "PitchShift") AR [in', {- windowSize: -} Constant 0.2, ratio', {-pitchDispersion -} Constant 0, {- timeDispersion -} Constant 0] 1
-}

pitchShift :: (Args '["in", "ratio"] '["windowSize", "pitchDispersion", "timeDispersion"] a) => a -> SDBody a Signal
pitchShift :: a -> SDBody a Signal
pitchShift = String
-> CalculationRate
-> Vs
     '["in", "windowSize", "ratio", "pitchDispersion", "timeDispersion"]
-> (UA "windowSize" (SDBodyArgs a),
    UA "pitchDispersion" (SDBodyArgs a),
    UA "timeDispersion" (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
"PitchShift" CalculationRate
AR
   (Vs
  '["in", "windowSize", "ratio", "pitchDispersion", "timeDispersion"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "windowSize", "ratio", "pitchDispersion", "timeDispersion"])
   (Float -> UA "windowSize" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "windowSize" as
windowSize_ (Float
0.2::Float), Float -> UA "pitchDispersion" (SDBodyArgs a)
forall s (as :: [Symbol]).
ToSig s as =>
s -> UA "pitchDispersion" as
pitchDispersion_ (Float
0::Float), Float -> UA "timeDispersion" (SDBodyArgs a)
forall s (as :: [Symbol]).
ToSig s as =>
s -> UA "timeDispersion" as
timeDispersion_ (Float
0::Float))

vibrato :: (Args '[] '["freq", "rate", "depth", "delaySecs", "onset", "rateVariation", "depthVariation", "iphase"] a) => a -> SDBody a Signal
vibrato :: a -> SDBody a Signal
vibrato = String
-> CalculationRate
-> Vs
     '["freq", "rate", "depth", "delaySecs", "onset", "rateVariation",
       "depthVariation", "iphase"]
-> (UA "freq" (SDBodyArgs a), UA "rate" (SDBodyArgs a),
    UA "depth" (SDBodyArgs a), UA "delaySecs" (SDBodyArgs a),
    UA "onset" (SDBodyArgs a), UA "rateVariation" (SDBodyArgs a),
    UA "depthVariation" (SDBodyArgs a), UA "iphase" (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
"Vibrato" CalculationRate
AR
   (Vs
  '["freq", "rate", "depth", "delaySecs", "onset", "rateVariation",
    "depthVariation", "iphase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "rate", "depth", "delaySecs", "onset", "rateVariation", "depthVariation", "iphase"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "rate" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rate" as
rate_ (Float
6::Float), Float -> UA "depth" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "depth" as
depth_ (Float
0.02::Float), Float -> UA "delaySecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "delaySecs" as
delay_ (Float
0::Float), Float -> UA "onset" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "onset" as
onset_ (Float
0::Float), Float -> UA "rateVariation" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rateVariation" as
rateVariation_ (Float
0.04::Float), Float -> UA "depthVariation" (SDBodyArgs a)
forall s (as :: [Symbol]).
ToSig s as =>
s -> UA "depthVariation" as
depthVariation_ (Float
0.1::Float), Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float))