{-# LANGUAGE DataKinds #-}

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

module Vivid.UGens.Generators.SingleValue (
     dc
   -- , silent
   ) where

import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SynthDef

import qualified Data.ByteString.UTF8 as UTF8 (fromString)

-- | \"This UGen simply outputs the initial value you give it\"
dc :: Float -> SDBody' a Signal
dc :: Float -> SDBody' a Signal
dc Float
n =
   UGen -> SDBody' a Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addUGen (UGen -> SDBody' a Signal) -> UGen -> SDBody' a Signal
forall a b. (a -> b) -> a -> b
$ UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S (String -> ByteString
UTF8.fromString String
"DC")) CalculationRate
AR [Float -> Signal
Constant Float
n] Int
1

-- Not creating this because I don't want to clutter the namespace.
-- Just write "dc 0"!
{-
silent :: foo
silent =
-}