{-# LANGUAGE DataKinds #-}

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

module Vivid.UGens.Triggers (
     -- in UGens.Filters:
   --   changed
---     gate
     -- in UGens.InOut
   -- , inTrig
---   , lastValue
     latch
     -- In UGens.Buffer:
   -- , phasor
   , pulseCount
   , pulseDivider
---   , sendReply
---   , sendTrig
---   , setResetFF
---   , stepper
   , sweep
     -- in UGens.Conversions:
   -- , t2a
   -- , t2k
---   , tChoose
     -- In UGens.Delays:
   -- , tDelay
---   , tExpRand
---   , tIRand
---   , tRand
---   , tWChoose
---   , tWIndex
---   , timer
---   , toggleFF
---   , trig
---   , trig1
   ) where

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

--- gate ::
--- gate =
--- lastValue ::
--- lastValue =

latch :: (Args '["in", "trigger"] '[] a) => a -> SDBody a Signal
latch :: a -> SDBody a Signal
latch = String
-> CalculationRate
-> Vs '["in", "trigger"]
-> NoDefaults (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
"Latch" CalculationRate
AR
   (Vs '["in", "trigger"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "trigger"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pulseCount :: Args '[] '["trigger", "reset"] a => a -> SDBody a Signal
pulseCount :: a -> SDBody a Signal
pulseCount = String
-> CalculationRate
-> Vs '["trigger", "reset"]
-> (UA "trigger" (SDBodyArgs a), UA "reset" (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
"PulseCount" CalculationRate
AR
   (Vs '["trigger", "reset"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["trigger", "reset"])
   (Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trig_ (Float
0::Float), Float -> UA "reset" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "reset" as
reset_ (Float
0::Float))

-- | \"Outputs one inpulse each time it receives a certain number of triggers at its input\"
-- 
--   The trigger \"can be any signal. A trigger happens when the signal changes from
--   non-positive to positive\"
-- 
--   \"div\" is the number of pulses to divide by. Default is 2.
-- 
--   \"start\" is the starting value of the count
-- 
--   Can be 'AR' or 'KR'
pulseDivider :: Args '["trigger"] '["div", "start"] a => a -> SDBody a Signal
pulseDivider :: a -> SDBody a Signal
pulseDivider = String
-> CalculationRate
-> Vs '["trigger", "div", "start"]
-> (UA "div" (SDBodyArgs a), UA "start" (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
"PulseDivider" CalculationRate
AR
   (Vs '["trigger", "div", "start"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["trigger", "div", "start"])
   (Float -> UA "div" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "div" as
div_ (Float
2::Float), Float -> UA "start" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "start" as
start_ (Float
0::Float))

--- sendReply ::
--- sendReply =
--- sendTrig ::
--- sendTrig =
--- setResetFF ::
--- setResetFF =
--- stepper ::
--- stepper =

sweep :: Args '["trigger"] '["rate"] a => a -> SDBody a Signal
sweep :: a -> SDBody a Signal
sweep = String
-> CalculationRate
-> Vs '["trigger", "rate"]
-> UA "rate" (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
"Sweep" CalculationRate
AR
   (Vs '["trigger", "rate"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["trigger", "rate"])
   (Float -> UA "rate" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rate" as
rate_ (Float
1::Float))

--- tChoose ::
--- tChoose =
--- tExpRand ::
--- tExpRand =
--- tIRand ::
--- tIRand =
--- tRand ::
--- tRand =
--- tWChoose ::
--- tWChoose =
--- tWIndex ::
--- tWIndex =
--- timer ::
--- timer =
--- toggleFF ::
--- toggleFF =
--- trig ::
--- trig =
--- trig1 ::
--- trig1 =