-- | UGen argument labels
-- 
--   These are usually named the same as their sclang counterparts.

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE NoRebindableSyntax #-}

{-# LANGUAGE
     ConstraintKinds
   , DataKinds
   , ExistentialQuantification
   , NoMonomorphismRestriction
   , FlexibleContexts
   , FlexibleInstances
   , KindSignatures
   , PartialTypeSignatures
   , TypeFamilies, NoMonoLocalBinds
   , TypeOperators
   #-}


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


module Vivid.UGens.Args where

import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SynthDef
import Vivid.SynthDef.FromUA
-- import Vivid.SynthDef.TypesafeArgs (getSymbolVals)

import qualified Data.ByteString.UTF8 as UTF8 (fromString)
import qualified Data.Map as Map
-- import Data.Monoid
-- import GHC.TypeLits

a_ :: ToSig s as => s -> UA "a" as
a_ :: s -> UA "a" as
a_ = SDBody' as Signal -> UA "a" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "a" as)
-> (s -> SDBody' as Signal) -> s -> UA "a" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

a0_ :: ToSig s as => s -> UA "a0" as
a0_ :: s -> UA "a0" as
a0_ = SDBody' as Signal -> UA "a0" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "a0" as)
-> (s -> SDBody' as Signal) -> s -> UA "a0" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

a1_ :: ToSig s as => s -> UA "a1" as
a1_ :: s -> UA "a1" as
a1_ = SDBody' as Signal -> UA "a1" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "a1" as)
-> (s -> SDBody' as Signal) -> s -> UA "a1" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

a2_ :: ToSig s as => s -> UA "a2" as
a2_ :: s -> UA "a2" as
a2_ = SDBody' as Signal -> UA "a2" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "a2" as)
-> (s -> SDBody' as Signal) -> s -> UA "a2" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

active_ :: ToSig s as => s -> UA "active" as
active_ :: s -> UA "active" as
active_ = SDBody' as Signal -> UA "active" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "active" as)
-> (s -> SDBody' as Signal) -> s -> UA "active" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

add_ :: ToSig s as => s -> UA "add" as
add_ :: s -> UA "add" as
add_ = SDBody' as Signal -> UA "add" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "add" as)
-> (s -> SDBody' as Signal) -> s -> UA "add" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

ampThreshold_ :: ToSig s as => s -> UA "ampThreshold" as
ampThreshold_ :: s -> UA "ampThreshold" as
ampThreshold_ = SDBody' as Signal -> UA "ampThreshold" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "ampThreshold" as)
-> (s -> SDBody' as Signal) -> s -> UA "ampThreshold" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

aReal_ :: ToSig s as => s -> UA "aReal" as
aReal_ :: s -> UA "aReal" as
aReal_ = SDBody' as Signal -> UA "aReal" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "aReal" as)
-> (s -> SDBody' as Signal) -> s -> UA "aReal" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | SC compatibility
areal_ :: ToSig s as => s -> UA "aReal" as
areal_ :: s -> UA "aReal" as
areal_ = s -> UA "aReal" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "aReal" as
aReal_

aImag_ :: ToSig s as => s -> UA "aImag" as
aImag_ :: s -> UA "aImag" as
aImag_ = SDBody' as Signal -> UA "aImag" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "aImag" as)
-> (s -> SDBody' as Signal) -> s -> UA "aImag" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | SC compatibility
aimag_ :: ToSig s as => s -> UA "aImag" as
aimag_ :: s -> UA "aImag" as
aimag_ = s -> UA "aImag" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "aImag" as
aImag_

attackSecs_ :: ToSig s as => s -> UA "attackSecs" as
attackSecs_ :: s -> UA "attackSecs" as
attackSecs_ = SDBody' as Signal -> UA "attackSecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "attackSecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "attackSecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'attackSecs_', for SC compatibility
attackTime_ :: ToSig s as => s -> UA "attackSecs" as
attackTime_ :: s -> UA "attackSecs" as
attackTime_ = s -> UA "attackSecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "attackSecs" as
attackSecs_

b_ :: ToSig s as => s -> UA "b" as
b_ :: s -> UA "b" as
b_ = SDBody' as Signal -> UA "b" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "b" as)
-> (s -> SDBody' as Signal) -> s -> UA "b" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

b1_ :: ToSig s as => s -> UA "b1" as
b1_ :: s -> UA "b1" as
b1_ = SDBody' as Signal -> UA "b1" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "b1" as)
-> (s -> SDBody' as Signal) -> s -> UA "b1" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

b2_ :: ToSig s as => s -> UA "b2" as
b2_ :: s -> UA "b2" as
b2_ = SDBody' as Signal -> UA "b2" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "b2" as)
-> (s -> SDBody' as Signal) -> s -> UA "b2" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

bias_ :: ToSig s as => s -> UA "bias" as
bias_ :: s -> UA "bias" as
bias_ = SDBody' as Signal -> UA "bias" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "bias" as)
-> (s -> SDBody' as Signal) -> s -> UA "bias" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

bins_ :: ToSig s as => s -> UA "bins" as
bins_ :: s -> UA "bins" as
bins_ = SDBody' as Signal -> UA "bins" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "bins" as)
-> (s -> SDBody' as Signal) -> s -> UA "bins" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

bits_ :: ToSig s as => s -> UA "bits" as
bits_ :: s -> UA "bits" as
bits_ = SDBody' as Signal -> UA "bits" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "bits" as)
-> (s -> SDBody' as Signal) -> s -> UA "bits" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

buf_ :: ToSig s as => s -> UA "buf" as
buf_ :: s -> UA "buf" as
buf_ = SDBody' as Signal -> UA "buf" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "buf" as)
-> (s -> SDBody' as Signal) -> s -> UA "buf" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | For SC compatibility -- alias of 'buf_'
buffer_ :: ToSig s as => s -> UA "buf" as
buffer_ :: s -> UA "buf" as
buffer_ = s -> UA "buf" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "buf" as
buf_

bus_ :: ToSig s as => s -> UA "bus" as
bus_ :: s -> UA "bus" as
bus_ = SDBody' as Signal -> UA "bus" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "bus" as)
-> (s -> SDBody' as Signal) -> s -> UA "bus" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

bw_ :: ToSig s as => s -> UA "bw" as
bw_ :: s -> UA "bw" as
bw_ = SDBody' as Signal -> UA "bw" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "bw" as)
-> (s -> SDBody' as Signal) -> s -> UA "bw" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- Maybe should actually just be "bw"?:
bwFreq_ :: ToSig s as => s -> UA "bwFreq" as
bwFreq_ :: s -> UA "bwFreq" as
bwFreq_  = SDBody' as Signal -> UA "bwFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "bwFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "bwFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

bwr_ :: ToSig s as => s -> UA "bwr" as
bwr_ :: s -> UA "bwr" as
bwr_ = SDBody' as Signal -> UA "bwr" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "bwr" as)
-> (s -> SDBody' as Signal) -> s -> UA "bwr" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

c_ :: ToSig s as => s -> UA "c" as
c_ :: s -> UA "c" as
c_ = SDBody' as Signal -> UA "c" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "c" as)
-> (s -> SDBody' as Signal) -> s -> UA "c" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'numChans_'
chans_ :: ToSig s as => s -> UA "numChans" as
chans_ :: s -> UA "numChans" as
chans_ = s -> UA "numChans" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "numChans" as
numChans_

clampSecs_ :: ToSig s as => s -> UA "clampSecs" as
clampSecs_ :: s -> UA "clampSecs" as
clampSecs_ = SDBody' as Signal -> UA "clampSecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "clampSecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "clampSecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'clampSecs_', for SC compatibility
clampTime_ :: ToSig s as => s -> UA "clampSecs" as
clampTime_ :: s -> UA "clampSecs" as
clampTime_ = s -> UA "clampSecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "clampSecs" as
clampSecs_

clar_ :: ToSig s as => s -> UA "clar" as
clar_ :: s -> UA "clar" as
clar_ = SDBody' as Signal -> UA "clar" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "clar" as)
-> (s -> SDBody' as Signal) -> s -> UA "clar" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

coef_ :: ToSig s as => s -> UA "coef" as
coef_ :: s -> UA "coef" as
coef_ = SDBody' as Signal -> UA "coef" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "coef" as)
-> (s -> SDBody' as Signal) -> s -> UA "coef" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

control_ :: ToSig s as => s -> UA "control" as
control_ :: s -> UA "control" as
control_ = SDBody' as Signal -> UA "control" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "control" as)
-> (s -> SDBody' as Signal) -> s -> UA "control" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

crossFade_ :: ToSig s as => s -> UA "crossFade" as
crossFade_ :: s -> UA "crossFade" as
crossFade_ = SDBody' as Signal -> UA "crossFade" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "crossFade" as)
-> (s -> SDBody' as Signal) -> s -> UA "crossFade" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | For SC compatibility -- alias of 'crossFade_'
crossfade_ :: ToSig s as => s -> UA "crossFade" as
crossfade_ :: s -> UA "crossFade" as
crossfade_ = SDBody' as Signal -> UA "crossFade" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "crossFade" as)
-> (s -> SDBody' as Signal) -> s -> UA "crossFade" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | **This may change in the future**
curve_curve :: Int -> UA "curve" as
curve_curve :: Int -> UA "curve" as
curve_curve = SDBody' as Signal -> UA "curve" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "curve" as)
-> (Int -> SDBody' as Signal) -> Int -> UA "curve" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal -> SDBody' as Signal
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal -> SDBody' as Signal)
-> (Int -> Signal) -> Int -> SDBody' as Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Signal
Constant (Float -> Signal) -> (Int -> Float) -> Int -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

{-
curve_step = 0
curve_linear = 1
curve_lin = 1
curve_exponential = 2
curve_exp = 2
curve_sine = 3
curve_sin = 3
curve_welch = 4
curve_wel = 4
curve_squared = 6
curve_sqr = 6
curve_cubed = 7
curve_cub = 7
envCurveNumber (Curve_Curve _) = 5
-}

damp_ :: ToSig s as => s -> UA "damp" as
damp_ :: s -> UA "damp" as
damp_ = SDBody' as Signal -> UA "damp" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "damp" as)
-> (s -> SDBody' as Signal) -> s -> UA "damp" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

damping_ :: ToSig s as => s -> UA "damping" as
damping_ :: s -> UA "damping" as
damping_ = SDBody' as Signal -> UA "damping" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "damping" as)
-> (s -> SDBody' as Signal) -> s -> UA "damping" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

db_ :: ToSig s as => s -> UA "db" as
db_ :: s -> UA "db" as
db_ = SDBody' as Signal -> UA "db" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "db" as)
-> (s -> SDBody' as Signal) -> s -> UA "db" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

decaySecs_ :: ToSig s as => s -> UA "decaySecs" as
decaySecs_ :: s -> UA "decaySecs" as
decaySecs_ = SDBody' as Signal -> UA "decaySecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "decaySecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "decaySecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'decaySecs_' for SC compatibility
decayTime_ :: ToSig s as => s -> UA "decaySecs" as
decayTime_ :: s -> UA "decaySecs" as
decayTime_ = s -> UA "decaySecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "decaySecs" as
decaySecs_

decayScale_ :: ToSig s as => s -> UA "decayScale" as
decayScale_ :: s -> UA "decayScale" as
decayScale_ = SDBody' as Signal -> UA "decayScale" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "decayScale" as)
-> (s -> SDBody' as Signal) -> s -> UA "decayScale" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | SC compatibility
decayscale_ :: ToSig s as => s -> UA "decayScale" as
decayscale_ :: s -> UA "decayScale" as
decayscale_ = s -> UA "decayScale" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "decayScale" as
decayScale_

-- | Alias of 'decaySecs_' for SC compatibility
decaytime_ :: ToSig s as => s -> UA "decaySecs" as
decaytime_ :: s -> UA "decaySecs" as
decaytime_ = s -> UA "decaySecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "decaySecs" as
decaySecs_

default_ :: ToSig s as => s -> UA "default" as
default_ :: s -> UA "default" as
default_ = SDBody' as Signal -> UA "default" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "default" as)
-> (s -> SDBody' as Signal) -> s -> UA "default" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'delaySecs_' for SC compatibility
delay_ :: ToSig s as => s -> UA "delaySecs" as
delay_ :: s -> UA "delaySecs" as
delay_ = s -> UA "delaySecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "delaySecs" as
delaySecs_

delaySecs_ :: ToSig s as => s -> UA "delaySecs" as
delaySecs_ :: s -> UA "delaySecs" as
delaySecs_ = SDBody' as Signal -> UA "delaySecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "delaySecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "delaySecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'delaySecs_' for SC compatibility
delayTime_ :: ToSig s as => s -> UA "delaySecs" as
delayTime_ :: s -> UA "delaySecs" as
delayTime_ = s -> UA "delaySecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "delaySecs" as
delaySecs_

-- | Alias of 'delaySecs_' for SC compatibility
delaytime_ :: ToSig s as => s -> UA "delaySecs" as
delaytime_ :: s -> UA "delaySecs" as
delaytime_ = s -> UA "delaySecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "delaySecs" as
delaySecs_

density_ :: ToSig s as => s -> UA "density" as
density_ :: s -> UA "density" as
density_ = SDBody' as Signal -> UA "density" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "density" as)
-> (s -> SDBody' as Signal) -> s -> UA "density" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

depth_ :: ToSig s as => s -> UA "depth" as
depth_ :: s -> UA "depth" as
depth_ = SDBody' as Signal -> UA "depth" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "depth" as)
-> (s -> SDBody' as Signal) -> s -> UA "depth" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

depthVariation_ :: ToSig s as => s -> UA "depthVariation" as
depthVariation_ :: s -> UA "depthVariation" as
depthVariation_ = SDBody' as Signal -> UA "depthVariation" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "depthVariation" as)
-> (s -> SDBody' as Signal) -> s -> UA "depthVariation" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

div_ :: ToSig s as => s -> UA "div" as
div_ :: s -> UA "div" as
div_ = SDBody' as Signal -> UA "div" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "div" as)
-> (s -> SDBody' as Signal) -> s -> UA "div" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

dn_ :: ToSig s as => s -> UA "dn" as
dn_ :: s -> UA "dn" as
dn_ = SDBody' as Signal -> UA "dn" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "dn" as)
-> (s -> SDBody' as Signal) -> s -> UA "dn" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

doneAction_ :: ToSig s as => s -> UA "doneAction" as
doneAction_ :: s -> UA "doneAction" as
doneAction_ = SDBody' as Signal -> UA "doneAction" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "doneAction" as)
-> (s -> SDBody' as Signal) -> s -> UA "doneAction" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

downSample_ :: ToSig s as => s -> UA "downSample" as
downSample_ :: s -> UA "downSample" as
downSample_ = SDBody' as Signal -> UA "downSample" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "downSample" as)
-> (s -> SDBody' as Signal) -> s -> UA "downSample" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

dryLevel_, drylevel_ :: ToSig s as => s -> UA "dryLevel" as
dryLevel_ :: s -> UA "dryLevel" as
dryLevel_ = SDBody' as Signal -> UA "dryLevel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "dryLevel" as)
-> (s -> SDBody' as Signal) -> s -> UA "dryLevel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

drylevel_ :: s -> UA "dryLevel" as
drylevel_ = s -> UA "dryLevel" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "dryLevel" as
dryLevel_

dsthi_ :: ToSig s as => s -> UA "dsthi" as
dsthi_ :: s -> UA "dsthi" as
dsthi_ = SDBody' as Signal -> UA "dsthi" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "dsthi" as)
-> (s -> SDBody' as Signal) -> s -> UA "dsthi" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

dstlo_ :: ToSig s as => s -> UA "dstlo" as
dstlo_ :: s -> UA "dstlo" as
dstlo_ = SDBody' as Signal -> UA "dstlo" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "dstlo" as)
-> (s -> SDBody' as Signal) -> s -> UA "dstlo" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'duration_'
dur_ :: ToSig s as => s -> UA "duration" as
dur_ :: s -> UA "duration" as
dur_ = s -> UA "duration" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "duration" as
duration_

duration_ :: ToSig s as => s -> UA "duration" as
duration_ :: s -> UA "duration" as
duration_ = SDBody' as Signal -> UA "duration" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "duration" as)
-> (s -> SDBody' as Signal) -> s -> UA "duration" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

earlyRefLevel_, earlyreflevel_ :: ToSig s as => s -> UA "earlyRefLevel" as
earlyRefLevel_ :: s -> UA "earlyRefLevel" as
earlyRefLevel_ = SDBody' as Signal -> UA "earlyRefLevel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "earlyRefLevel" as)
-> (s -> SDBody' as Signal) -> s -> UA "earlyRefLevel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

earlyreflevel_ :: s -> UA "earlyRefLevel" as
earlyreflevel_ = s -> UA "earlyRefLevel" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "earlyRefLevel" as
earlyRefLevel_

end_ :: ToSig s as => s -> UA "end" as
end_ :: s -> UA "end" as
end_ = SDBody' as Signal -> UA "end" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "end" as)
-> (s -> SDBody' as Signal) -> s -> UA "end" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

execFreq_ :: ToSig s as => s -> UA "execFreq" as
execFreq_ :: s -> UA "execFreq" as
execFreq_ = SDBody' as Signal -> UA "execFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "execFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "execFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'exponent_'
exp_ :: ToSig s as => s -> UA "exponent" as
exp_ :: s -> UA "exponent" as
exp_ = s -> UA "exponent" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "exponent" as
exponent_

exponent_ :: ToSig s as => s -> UA "exponent" as
exponent_ :: s -> UA "exponent" as
exponent_ = SDBody' as Signal -> UA "exponent" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "exponent" as)
-> (s -> SDBody' as Signal) -> s -> UA "exponent" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

fftSize_ :: ToSig s as => s -> UA "fftSize" as
fftSize_ :: s -> UA "fftSize" as
fftSize_ = SDBody' as Signal -> UA "fftSize" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "fftSize" as)
-> (s -> SDBody' as Signal) -> s -> UA "fftSize" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | For SC compatibility -- alias of 'fftSize_'
fftsize_ :: ToSig s as => s -> UA "fftSize" as
fftsize_ :: s -> UA "fftSize" as
fftsize_ = s -> UA "fftSize" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "fftSize" as
fftSize_

formFreq_ :: ToSig s as => s -> UA "formFreq" as
formFreq_ :: s -> UA "formFreq" as
formFreq_ = SDBody' as Signal -> UA "formFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "formFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "formFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

frames_ :: ToSig s as => s -> UA "numFrames" as
frames_ :: s -> UA "numFrames" as
frames_ = s -> UA "numFrames" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "numFrames" as
numFrames_

frameSize_ :: ToSig s as => s -> UA "frameSize" as
frameSize_ :: s -> UA "frameSize" as
frameSize_ = SDBody' as Signal -> UA "frameSize" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "frameSize" as)
-> (s -> SDBody' as Signal) -> s -> UA "frameSize" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | For SC compatibility -- alias of 'frameSize_'
framesize_ :: ToSig s as => s -> UA "frameSize" as
framesize_ :: s -> UA "frameSize" as
framesize_ = s -> UA "frameSize" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "frameSize" as
frameSize_

freeze_ :: ToSig s as => s -> UA "freeze" as
freeze_ :: s -> UA "freeze" as
freeze_ = SDBody' as Signal -> UA "freeze" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "freeze" as)
-> (s -> SDBody' as Signal) -> s -> UA "freeze" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

freq_ :: ToSig s as => s -> UA "freq" as
freq_ :: s -> UA "freq" as
freq_  = SDBody' as Signal -> UA "freq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "freq" as)
-> (s -> SDBody' as Signal) -> s -> UA "freq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

freqOffset_ :: ToSig s as => s -> UA "freqOffset" as
freqOffset_ :: s -> UA "freqOffset" as
freqOffset_ = SDBody' as Signal -> UA "freqOffset" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "freqOffset" as)
-> (s -> SDBody' as Signal) -> s -> UA "freqOffset" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | SC compatibility:
freqoffset_ :: ToSig s as => s -> UA "freqOffset" as
freqoffset_ :: s -> UA "freqOffset" as
freqoffset_ = s -> UA "freqOffset" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "freqOffset" as
freqOffset_


freqScale_ :: ToSig s as => s -> UA "freqScale" as
freqScale_ :: s -> UA "freqScale" as
freqScale_ = SDBody' as Signal -> UA "freqScale" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "freqScale" as)
-> (s -> SDBody' as Signal) -> s -> UA "freqScale" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | SC compatibility:
freqscale_ :: ToSig s as => s -> UA "freqScale" as
freqscale_ :: s -> UA "freqScale" as
freqscale_ = s -> UA "freqScale" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "freqScale" as
freqScale_

friction_ :: ToSig s as => s -> UA "friction" as
friction_ :: s -> UA "friction" as
friction_ = SDBody' as Signal -> UA "friction" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "friction" as)
-> (s -> SDBody' as Signal) -> s -> UA "friction" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

fundFreq_ :: ToSig s as => s -> UA "fundFreq" as
fundFreq_ :: s -> UA "fundFreq" as
fundFreq_ = SDBody' as Signal -> UA "fundFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "fundFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "fundFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

g_ :: ToSig s as => s -> UA "g" as
g_ :: s -> UA "g" as
g_ = SDBody' as Signal -> UA "g" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "g" as)
-> (s -> SDBody' as Signal) -> s -> UA "g" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

gain_ :: ToSig s as => s -> UA "gain" as
gain_ :: s -> UA "gain" as
gain_ = SDBody' as Signal -> UA "gain" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "gain" as)
-> (s -> SDBody' as Signal) -> s -> UA "gain" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

gate_ :: ToSig s as => s -> UA "gate" as
gate_ :: s -> UA "gate" as
gate_ = SDBody' as Signal -> UA "gate" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "gate" as)
-> (s -> SDBody' as Signal) -> s -> UA "gate" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

hi_ :: ToSig s as => s -> UA "hi" as
hi_ :: s -> UA "hi" as
hi_ = SDBody' as Signal -> UA "hi" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "hi" as)
-> (s -> SDBody' as Signal) -> s -> UA "hi" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

hop_ :: ToSig s as => s -> UA "hop" as
hop_ :: s -> UA "hop" as
hop_ = SDBody' as Signal -> UA "hop" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "hop" as)
-> (s -> SDBody' as Signal) -> s -> UA "hop" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

id_ :: ToSig s as => s -> UA "id" as
id_ :: s -> UA "id" as
id_ = SDBody' as Signal -> UA "id" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "id" as)
-> (s -> SDBody' as Signal) -> s -> UA "id" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

in_ :: ToSig s as => s -> UA "in" as
in_ :: s -> UA "in" as
in_ = SDBody' as Signal -> UA "in" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "in" as)
-> (s -> SDBody' as Signal) -> s -> UA "in" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

initFreq_ :: ToSig s as => s -> UA "initFreq" as
initFreq_ :: s -> UA "initFreq" as
initFreq_ = SDBody' as Signal -> UA "initFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "initFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "initFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

inputBW_, inputbw_ :: ToSig s as => s -> UA "inputBW" as
inputBW_ :: s -> UA "inputBW" as
inputBW_ = SDBody' as Signal -> UA "inputBW" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "inputBW" as)
-> (s -> SDBody' as Signal) -> s -> UA "inputBW" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

inputbw_ :: s -> UA "inputBW" as
inputbw_ = s -> UA "inputBW" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "inputBW" as
inputBW_

integrate_ :: ToSig s as => s -> UA "integrate" as
integrate_ :: s -> UA "integrate" as
integrate_ = SDBody' as Signal -> UA "integrate" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "integrate" as)
-> (s -> SDBody' as Signal) -> s -> UA "integrate" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Interpolation
interp_ :: ToSig s as => s -> UA "interp" as
interp_ :: s -> UA "interp" as
interp_ = SDBody' as Signal -> UA "interp" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "interp" as)
-> (s -> SDBody' as Signal) -> s -> UA "interp" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | For SC compatibility -- alias of 'interp_'
interpolation_ :: ToSig s as => s -> UA "interp" as
interpolation_ :: s -> UA "interp" as
interpolation_ = s -> UA "interp" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "interp" as
interp_

iphase_ :: ToSig s as => s -> UA "iphase" as
iphase_ :: s -> UA "iphase" as
iphase_ = SDBody' as Signal -> UA "iphase" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "iphase" as)
-> (s -> SDBody' as Signal) -> s -> UA "iphase" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

irBufNum_ :: ToSig s as => s -> UA "irBufNum" as
irBufNum_ :: s -> UA "irBufNum" as
irBufNum_ = SDBody' as Signal -> UA "irBufNum" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "irBufNum" as)
-> (s -> SDBody' as Signal) -> s -> UA "irBufNum" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | For SC compatibility -- alias of 'irBufSize_'
irbufnum_ :: ToSig s as => s -> UA "irBufNum" as
irbufnum_ :: s -> UA "irBufNum" as
irbufnum_ = s -> UA "irBufNum" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "irBufNum" as
irBufNum_

kernel_ :: ToSig s as => s -> UA "kernel" as
kernel_ :: s -> UA "kernel" as
kernel_ = SDBody' as Signal -> UA "kernel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "kernel" as)
-> (s -> SDBody' as Signal) -> s -> UA "kernel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias, for SC compatibility
lag_ :: ToSig s as => s -> UA "lagSecs" as
lag_ :: s -> UA "lagSecs" as
lag_ = SDBody' as Signal -> UA "lagSecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "lagSecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "lagSecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

lagSecs_ :: ToSig s as => s -> UA "lagSecs" as
lagSecs_ :: s -> UA "lagSecs" as
lagSecs_ = SDBody' as Signal -> UA "lagSecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "lagSecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "lagSecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | For SC compatibility:
lagTime_ :: ToSig s as => s -> UA "lagSecs" as
lagTime_ :: s -> UA "lagSecs" as
lagTime_ = s -> UA "lagSecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "lagSecs" as
lagSecs_

length_ :: ToSig s as => s -> UA "length" as
length_ :: s -> UA "length" as
length_ = SDBody' as Signal -> UA "length" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "length" as)
-> (s -> SDBody' as Signal) -> s -> UA "length" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

level_ :: ToSig s as => s -> UA "level" as
level_ :: s -> UA "level" as
level_ = SDBody' as Signal -> UA "level" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "level" as)
-> (s -> SDBody' as Signal) -> s -> UA "level" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

lo_ :: ToSig s as => s -> UA "lo" as
lo_ :: s -> UA "lo" as
lo_ = SDBody' as Signal -> UA "lo" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "lo" as)
-> (s -> SDBody' as Signal) -> s -> UA "lo" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

loop_ :: ToSig s as => s -> UA "loop" as
loop_ :: s -> UA "loop" as
loop_ = SDBody' as Signal -> UA "loop" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "loop" as)
-> (s -> SDBody' as Signal) -> s -> UA "loop" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

m_ :: ToSig s as => s -> UA "m" as
m_ :: s -> UA "m" as
m_ = SDBody' as Signal -> UA "m" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "m" as)
-> (s -> SDBody' as Signal) -> s -> UA "m" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

max_ :: ToSig s as => s -> UA "max" as
max_ :: s -> UA "max" as
max_ = SDBody' as Signal -> UA "max" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "max" as)
-> (s -> SDBody' as Signal) -> s -> UA "max" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

maxBinsPerOctave_ :: ToSig s as => s -> UA "maxBinsPerOctave" as
maxBinsPerOctave_ :: s -> UA "maxBinsPerOctave" as
maxBinsPerOctave_ = SDBody' as Signal -> UA "maxBinsPerOctave" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "maxBinsPerOctave" as)
-> (s -> SDBody' as Signal) -> s -> UA "maxBinsPerOctave" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

maxDelaySecs_ :: ToSig s as => s -> UA "maxDelaySecs" as
maxDelaySecs_ :: s -> UA "maxDelaySecs" as
maxDelaySecs_ = SDBody' as Signal -> UA "maxDelaySecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "maxDelaySecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "maxDelaySecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'maxDelaySecs_' for SC compatibility
maxDelayTime_ :: ToSig s as => s -> UA "maxDelaySecs" as
maxDelayTime_ :: s -> UA "maxDelaySecs" as
maxDelayTime_ = SDBody' as Signal -> UA "maxDelaySecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "maxDelaySecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "maxDelaySecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'maxDelaySecs_' for SC compatibility
maxdelaytime_ :: ToSig s as => s -> UA "maxDelaySecs" as
maxdelaytime_ :: s -> UA "maxDelaySecs" as
maxdelaytime_ = s -> UA "maxDelaySecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "maxDelaySecs" as
maxDelayTime_

maxFreq_ :: ToSig s as => s -> UA "maxFreq" as
maxFreq_ :: s -> UA "maxFreq" as
maxFreq_ = SDBody' as Signal -> UA "maxFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "maxFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "maxFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

maxRoomSize_, maxroomsize_ :: ToSig s as => s -> UA "maxRoomSize" as
maxRoomSize_ :: s -> UA "maxRoomSize" as
maxRoomSize_ = SDBody' as Signal -> UA "maxRoomSize" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "maxRoomSize" as)
-> (s -> SDBody' as Signal) -> s -> UA "maxRoomSize" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

maxroomsize_ :: s -> UA "maxRoomSize" as
maxroomsize_ = s -> UA "maxRoomSize" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "maxRoomSize" as
maxRoomSize_

-- | Alias of 'max_', for SC compatibility
maxVal_ :: ToSig s as => s -> UA "max" as
maxVal_ :: s -> UA "max" as
maxVal_ = SDBody' as Signal -> UA "max" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "max" as)
-> (s -> SDBody' as Signal) -> s -> UA "max" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

median_ :: ToSig s as => s -> UA "median" as
median_ :: s -> UA "median" as
median_ = SDBody' as Signal -> UA "median" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "median" as)
-> (s -> SDBody' as Signal) -> s -> UA "median" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

min_ :: ToSig s as => s -> UA "min" as
min_ :: s -> UA "min" as
min_ = SDBody' as Signal -> UA "min" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "min" as)
-> (s -> SDBody' as Signal) -> s -> UA "min" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

minFreq_ :: ToSig s as => s -> UA "minFreq" as
minFreq_ :: s -> UA "minFreq" as
minFreq_ = SDBody' as Signal -> UA "minFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "minFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "minFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

minmax_ :: ToSig s as => s -> UA "minmax" as
minmax_ :: s -> UA "minmax" as
minmax_ = SDBody' as Signal -> UA "minmax" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "minmax" as)
-> (s -> SDBody' as Signal) -> s -> UA "minmax" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'min_', for SC compatibility
minVal_ :: ToSig s as => s -> UA "min" as
minVal_ :: s -> UA "min" as
minVal_ = SDBody' as Signal -> UA "min" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "min" as)
-> (s -> SDBody' as Signal) -> s -> UA "min" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

mix_ :: ToSig s as => s -> UA "mix" as
mix_ :: s -> UA "mix" as
mix_ = SDBody' as Signal -> UA "mix" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "mix" as)
-> (s -> SDBody' as Signal) -> s -> UA "mix" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

mul_ :: ToSig s as => s -> UA "mul" as
mul_ :: s -> UA "mul" as
mul_ = SDBody' as Signal -> UA "mul" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "mul" as)
-> (s -> SDBody' as Signal) -> s -> UA "mul" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

numChans_ :: ToSig s as => s -> UA "numChans" as
numChans_ :: s -> UA "numChans" as
numChans_ = SDBody' as Signal -> UA "numChans" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "numChans" as)
-> (s -> SDBody' as Signal) -> s -> UA "numChans" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

numFrames_ :: ToSig s as => s -> UA "numFrames" as
numFrames_ :: s -> UA "numFrames" as
numFrames_ = SDBody' as Signal -> UA "numFrames" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "numFrames" as)
-> (s -> SDBody' as Signal) -> s -> UA "numFrames" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

numTeeth_ :: ToSig s as => s -> UA "numTeeth" as
numTeeth_ :: s -> UA "numTeeth" as
numTeeth_ = SDBody' as Signal -> UA "numTeeth" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "numTeeth" as)
-> (s -> SDBody' as Signal) -> s -> UA "numTeeth" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

offset_ :: ToSig s as => s -> UA "offset" as
offset_ :: s -> UA "offset" as
offset_ = SDBody' as Signal -> UA "offset" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "offset" as)
-> (s -> SDBody' as Signal) -> s -> UA "offset" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

onset_ :: ToSig s as => s -> UA "onset" as
onset_ :: s -> UA "onset" as
onset_ = SDBody' as Signal -> UA "onset" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "onset" as)
-> (s -> SDBody' as Signal) -> s -> UA "onset" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

peakLevel_ :: ToSig s as => s -> UA "peakLevel" as
peakLevel_ :: s -> UA "peakLevel" as
peakLevel_ = SDBody' as Signal -> UA "peakLevel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "peakLevel" as)
-> (s -> SDBody' as Signal) -> s -> UA "peakLevel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

peakThreshold_ :: ToSig s as => s -> UA "peakThreshold" as
peakThreshold_ :: s -> UA "peakThreshold" as
peakThreshold_ = SDBody' as Signal -> UA "peakThreshold" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "peakThreshold" as)
-> (s -> SDBody' as Signal) -> s -> UA "peakThreshold" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

phase_ :: ToSig s as => s -> UA "phase" as
phase_ :: s -> UA "phase" as
phase_ = SDBody' as Signal -> UA "phase" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "phase" as)
-> (s -> SDBody' as Signal) -> s -> UA "phase" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

pitchDispersion_ :: ToSig s as => s -> UA "pitchDispersion" as
pitchDispersion_ :: s -> UA "pitchDispersion" as
pitchDispersion_ = SDBody' as Signal -> UA "pitchDispersion" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "pitchDispersion" as)
-> (s -> SDBody' as Signal) -> s -> UA "pitchDispersion" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

pos_ :: ToSig s as => s -> UA "pos" as
pos_ :: s -> UA "pos" as
pos_ = SDBody' as Signal -> UA "pos" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "pos" as)
-> (s -> SDBody' as Signal) -> s -> UA "pos" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

post_ :: ToSig s as => s -> UA "post" as
post_ :: s -> UA "post" as
post_ = SDBody' as Signal -> UA "post" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "post" as)
-> (s -> SDBody' as Signal) -> s -> UA "post" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

preLevel_ :: ToSig s as => s -> UA "preLevel" as
preLevel_ :: s -> UA "preLevel" as
preLevel_ = SDBody' as Signal -> UA "preLevel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "preLevel" as)
-> (s -> SDBody' as Signal) -> s -> UA "preLevel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

rate_ :: ToSig s as => s -> UA "rate" as
rate_ :: s -> UA "rate" as
rate_ = SDBody' as Signal -> UA "rate" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "rate" as)
-> (s -> SDBody' as Signal) -> s -> UA "rate" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

rateVariation_ :: ToSig s as => s -> UA "rateVariation" as
rateVariation_ :: s -> UA "rateVariation" as
rateVariation_ = SDBody' as Signal -> UA "rateVariation" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "rateVariation" as)
-> (s -> SDBody' as Signal) -> s -> UA "rateVariation" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

radius_ :: ToSig s as => s -> UA "radius" as
radius_ :: s -> UA "radius" as
radius_ = SDBody' as Signal -> UA "radius" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "radius" as)
-> (s -> SDBody' as Signal) -> s -> UA "radius" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

ratio_ :: ToSig s as => s -> UA "ratio" as
ratio_ :: s -> UA "ratio" as
ratio_ = SDBody' as Signal -> UA "ratio" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "ratio" as)
-> (s -> SDBody' as Signal) -> s -> UA "ratio" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

recLevel_ :: ToSig s as => s -> UA "recLevel" as
recLevel_ :: s -> UA "recLevel" as
recLevel_ = SDBody' as Signal -> UA "recLevel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "recLevel" as)
-> (s -> SDBody' as Signal) -> s -> UA "recLevel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

relaxSecs_ :: ToSig s as => s -> UA "relaxSecs" as
relaxSecs_ :: s -> UA "relaxSecs" as
relaxSecs_ = SDBody' as Signal -> UA "relaxSecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "relaxSecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "relaxSecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'relaxSecs_' for SC compatibility
relaxTime_ :: ToSig s as => s -> UA "relaxSecs" as
relaxTime_ :: s -> UA "relaxSecs" as
relaxTime_ = SDBody' as Signal -> UA "relaxSecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "relaxSecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "relaxSecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

releaseSecs_ :: ToSig s as => s -> UA "releaseSecs" as
releaseSecs_ :: s -> UA "releaseSecs" as
releaseSecs_ = SDBody' as Signal -> UA "releaseSecs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "releaseSecs" as)
-> (s -> SDBody' as Signal) -> s -> UA "releaseSecs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'releaseSecs_', for SC compatibility
releaseTime_ :: ToSig s as => s -> UA "releaseSecs" as
releaseTime_ :: s -> UA "releaseSecs" as
releaseTime_ = s -> UA "releaseSecs" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "releaseSecs" as
releaseSecs_

repeats_ :: ToSig s as => s -> UA "repeats" as
repeats_ :: s -> UA "repeats" as
repeats_ = SDBody' as Signal -> UA "repeats" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "repeats" as)
-> (s -> SDBody' as Signal) -> s -> UA "repeats" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Shorter alias for 'repeats_'
reps_ :: ToSig s as => s -> UA "repeats" as
reps_ :: s -> UA "repeats" as
reps_ = s -> UA "repeats" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "repeats" as
repeats_

reset_ :: ToSig s as => s -> UA "reset" as
reset_ :: s -> UA "reset" as
reset_ = SDBody' as Signal -> UA "reset" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "reset" as)
-> (s -> SDBody' as Signal) -> s -> UA "reset" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

resetPos_ :: ToSig s as => s -> UA "resetPos" as
resetPos_ :: s -> UA "resetPos" as
resetPos_ = SDBody' as Signal -> UA "resetPos" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "resetPos" as)
-> (s -> SDBody' as Signal) -> s -> UA "resetPos" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

revTime_, revtime_ :: ToSig s as => s -> UA "revTime" as
revTime_ :: s -> UA "revTime" as
revTime_ = SDBody' as Signal -> UA "revTime" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "revTime" as)
-> (s -> SDBody' as Signal) -> s -> UA "revTime" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias, for compatibility
revtime_ :: s -> UA "revTime" as
revtime_ = s -> UA "revTime" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "revTime" as
revTime_

room_ :: ToSig s as => s -> UA "room" as
room_ :: s -> UA "room" as
room_ = SDBody' as Signal -> UA "room" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "room" as)
-> (s -> SDBody' as Signal) -> s -> UA "room" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

roomSize_ :: ToSig s as => s -> UA "roomSize" as
roomSize_ :: s -> UA "roomSize" as
roomSize_ = SDBody' as Signal -> UA "roomSize" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "roomSize" as)
-> (s -> SDBody' as Signal) -> s -> UA "roomSize" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias, for compatibility
roomsize_ :: ToSig s as => s -> UA "roomSize" as
roomsize_ :: s -> UA "roomSize" as
roomsize_ = s -> UA "roomSize" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "roomSize" as
roomSize_

root_ :: ToSig s as => s -> UA "root" as
root_ :: s -> UA "root" as
root_ = SDBody' as Signal -> UA "root" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "root" as)
-> (s -> SDBody' as Signal) -> s -> UA "root" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

rq_ :: ToSig s as => s -> UA "rq" as
rq_ :: s -> UA "rq" as
rq_ = SDBody' as Signal -> UA "rq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "rq" as)
-> (s -> SDBody' as Signal) -> s -> UA "rq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

rs_ :: ToSig s as => s -> UA "rs" as
rs_ :: s -> UA "rs" as
rs_ = SDBody' as Signal -> UA "rs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "rs" as)
-> (s -> SDBody' as Signal) -> s -> UA "rs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

run_ :: ToSig s as => s -> UA "run" as
run_ :: s -> UA "run" as
run_ = SDBody' as Signal -> UA "run" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "run" as)
-> (s -> SDBody' as Signal) -> s -> UA "run" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

sawFreq_ :: ToSig s as => s -> UA "sawFreq" as
sawFreq_ :: s -> UA "sawFreq" as
sawFreq_ = SDBody' as Signal -> UA "sawFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "sawFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "sawFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

secs_ :: ToSig s as => s -> UA "secs" as
secs_ :: s -> UA "secs" as
secs_ = SDBody' as Signal -> UA "secs" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "secs" as)
-> (s -> SDBody' as Signal) -> s -> UA "secs" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

shift_ :: ToSig s as => s -> UA "shift" as
shift_ :: s -> UA "shift" as
shift_ = SDBody' as Signal -> UA "shift" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "shift" as)
-> (s -> SDBody' as Signal) -> s -> UA "shift" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

slopeAbove_ :: ToSig s as => s -> UA "slopeAbove" as
slopeAbove_ :: s -> UA "slopeAbove" as
slopeAbove_ = SDBody' as Signal -> UA "slopeAbove" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "slopeAbove" as)
-> (s -> SDBody' as Signal) -> s -> UA "slopeAbove" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

slopeBelow_ :: ToSig s as => s -> UA "slopeBelow" as
slopeBelow_ :: s -> UA "slopeBelow" as
slopeBelow_ = SDBody' as Signal -> UA "slopeBelow" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "slopeBelow" as)
-> (s -> SDBody' as Signal) -> s -> UA "slopeBelow" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

spread_ :: ToSig s as => s -> UA "spread" as
spread_ :: s -> UA "spread" as
spread_ = SDBody' as Signal -> UA "spread" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "spread" as)
-> (s -> SDBody' as Signal) -> s -> UA "spread" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

spring_ :: ToSig s as => s -> UA "spring" as
spring_ :: s -> UA "spring" as
spring_ = SDBody' as Signal -> UA "spring" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "spring" as)
-> (s -> SDBody' as Signal) -> s -> UA "spring" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

srchi_ :: ToSig s as => s -> UA "srchi" as
srchi_ :: s -> UA "srchi" as
srchi_ = SDBody' as Signal -> UA "srchi" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "srchi" as)
-> (s -> SDBody' as Signal) -> s -> UA "srchi" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

srclo_ :: ToSig s as => s -> UA "srclo" as
srclo_ :: s -> UA "srclo" as
srclo_ = SDBody' as Signal -> UA "srclo" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "srclo" as)
-> (s -> SDBody' as Signal) -> s -> UA "srclo" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

startPos_ :: ToSig s as => s -> UA "startPos" as
startPos_ :: s -> UA "startPos" as
startPos_ = SDBody' as Signal -> UA "startPos" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "startPos" as)
-> (s -> SDBody' as Signal) -> s -> UA "startPos" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

start_ :: ToSig s as => s -> UA "start" as
start_ :: s -> UA "start" as
start_ = SDBody' as Signal -> UA "start" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "start" as)
-> (s -> SDBody' as Signal) -> s -> UA "start" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

step_ :: ToSig s as => s -> UA "step" as
step_ :: s -> UA "step" as
step_ = SDBody' as Signal -> UA "step" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "step" as)
-> (s -> SDBody' as Signal) -> s -> UA "step" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

stretch_ :: ToSig s as => s -> UA "stretch" as
stretch_ :: s -> UA "stretch" as
stretch_ = SDBody' as Signal -> UA "stretch" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "stretch" as)
-> (s -> SDBody' as Signal) -> s -> UA "stretch" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

susLevel_ :: ToSig s as => s -> UA "susLevel" as
susLevel_ :: s -> UA "susLevel" as
susLevel_ = SDBody' as Signal -> UA "susLevel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "susLevel" as)
-> (s -> SDBody' as Signal) -> s -> UA "susLevel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

syncFreq_ :: ToSig s as => s -> UA "syncFreq" as
syncFreq_ :: s -> UA "syncFreq" as
syncFreq_ = SDBody' as Signal -> UA "syncFreq" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "syncFreq" as)
-> (s -> SDBody' as Signal) -> s -> UA "syncFreq" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

tailLevel_, taillevel_ :: ToSig s as => s -> UA "tailLevel" as
tailLevel_ :: s -> UA "tailLevel" as
tailLevel_ = SDBody' as Signal -> UA "tailLevel" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "tailLevel" as)
-> (s -> SDBody' as Signal) -> s -> UA "tailLevel" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

taillevel_ :: s -> UA "tailLevel" as
taillevel_ = s -> UA "tailLevel" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "tailLevel" as
tailLevel_

threshold_ :: ToSig s as => s -> UA "threshold" as
threshold_ :: s -> UA "threshold" as
threshold_ = SDBody' as Signal -> UA "threshold" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "threshold" as)
-> (s -> SDBody' as Signal) -> s -> UA "threshold" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias for "threshold_"
thresh_ :: ToSig s as => s -> UA "threshold" as
thresh_ :: s -> UA "threshold" as
thresh_ = s -> UA "threshold" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "threshold" as
threshold_

timeDispersion_ :: ToSig s as => s -> UA "timeDispersion" as
timeDispersion_ :: s -> UA "timeDispersion" as
timeDispersion_ = SDBody' as Signal -> UA "timeDispersion" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "timeDispersion" as)
-> (s -> SDBody' as Signal) -> s -> UA "timeDispersion" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

trig_ :: ToSig s as => s -> UA "trigger" as
trig_ :: s -> UA "trigger" as
trig_ = s -> UA "trigger" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trigger_

-- | You can use "trig_" instead
trigger_ :: ToSig s as => s -> UA "trigger" as
trigger_ :: s -> UA "trigger" as
trigger_ = SDBody' as Signal -> UA "trigger" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "trigger" as)
-> (s -> SDBody' as Signal) -> s -> UA "trigger" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

trigid_ :: ToSig s as => s -> UA "trigid" as
trigid_ :: s -> UA "trigid" as
trigid_ = SDBody' as Signal -> UA "trigid" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "trigid" as)
-> (s -> SDBody' as Signal) -> s -> UA "trigid" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Short alias for 'ugen_'
ug_ :: ToSig s as => s -> UA "ugen" as
ug_ :: s -> UA "ugen" as
ug_ = SDBody' as Signal -> UA "ugen" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "ugen" as)
-> (s -> SDBody' as Signal) -> s -> UA "ugen" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

ugen_ :: ToSig s as => s -> UA "ugen" as
ugen_ :: s -> UA "ugen" as
ugen_ = SDBody' as Signal -> UA "ugen" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "ugen" as)
-> (s -> SDBody' as Signal) -> s -> UA "ugen" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

up_ :: ToSig s as => s -> UA "up" as
up_ :: s -> UA "up" as
up_ = SDBody' as Signal -> UA "up" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "up" as)
-> (s -> SDBody' as Signal) -> s -> UA "up" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

warp_ :: ToSig s as => s -> UA "warp" as
warp_ :: s -> UA "warp" as
warp_ = SDBody' as Signal -> UA "warp" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "warp" as)
-> (s -> SDBody' as Signal) -> s -> UA "warp" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

width_ :: ToSig s as => s -> UA "width" as
width_ :: s -> UA "width" as
width_ = SDBody' as Signal -> UA "width" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "width" as)
-> (s -> SDBody' as Signal) -> s -> UA "width" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

wipe_ :: (ToSig s as) => s -> UA "wipe" as
wipe_ :: s -> UA "wipe" as
wipe_ = SDBody' as Signal -> UA "wipe" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "wipe" as)
-> (s -> SDBody' as Signal) -> s -> UA "wipe" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

-- | Alias of 'windowSize_'
winsize_ :: ToSig s as => s -> UA "windowSize" as
winsize_ :: s -> UA "windowSize" as
winsize_ = s -> UA "windowSize" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "windowSize" as
windowSize_

windowSize_ :: ToSig s as => s -> UA "windowSize" as
windowSize_ :: s -> UA "windowSize" as
windowSize_ = SDBody' as Signal -> UA "windowSize" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "windowSize" as)
-> (s -> SDBody' as Signal) -> s -> UA "windowSize" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

wintype_ :: ToSig s as => s -> UA "windowType" as
wintype_ :: s -> UA "windowType" as
wintype_ = s -> UA "windowType" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "windowType" as
windowType_

windowType_ :: ToSig s as => s -> UA "windowType" as
windowType_ :: s -> UA "windowType" as
windowType_ = SDBody' as Signal -> UA "windowType" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "windowType" as)
-> (s -> SDBody' as Signal) -> s -> UA "windowType" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig

xi_ :: ToSig s as => s -> UA "xi" as
xi_ :: s -> UA "xi" as
xi_ = SDBody' as Signal -> UA "xi" as
forall (name :: Symbol) (args :: [Symbol]).
KnownSymbol name =>
SDBody' args Signal -> UA name args
UA (SDBody' as Signal -> UA "xi" as)
-> (s -> SDBody' as Signal) -> s -> UA "xi" as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig)


-- this one gives you:
-- (same as above but "args" at the end there)
--     Could not deduce (FromUA (UA "phase" args0))
-- (this is the same arg as if you have no type sig)


makeMakeUGen :: (
     GetSymbolVals (Vs tags)
   , FromUA optional
   , FromUA userSupplied
   , SDBodyArgs optional ~ SDBodyArgs userSupplied
   , SDBodyArgs optional ~ args
   ) => (UGen -> SDBody' args x) -> Int -> String -> CalculationRate -> Vs tags -> optional -> (userSupplied -> SDBody' args x)
makeMakeUGen :: (UGen -> SDBody' args x)
-> Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args x
makeMakeUGen UGen -> SDBody' args x
addUGenF Int
numOuts String
ugenName CalculationRate
calcRate Vs tags
tagList optional
defaultArgs = \userSupplied
userSupplied -> do
   Map String Signal
theArgList <- [(String, Signal)] -> Map String Signal
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Signal)] -> Map String Signal)
-> StateT
     ([Int], SynthDef args, VarSet args) Identity [(String, Signal)]
-> StateT
     ([Int], SynthDef args, VarSet args) Identity (Map String Signal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultArgs optional
-> OverwritingArgs userSupplied
-> SDBody optional [(String, Signal)]
forall a b.
(FromUA a, FromUA b, SDBodyArgs a ~ SDBodyArgs b) =>
DefaultArgs a -> OverwritingArgs b -> SDBody a [(String, Signal)]
fromUAWithDefaults (optional -> DefaultArgs optional
forall a. a -> DefaultArgs a
DefaultArgs optional
defaultArgs) (userSupplied -> OverwritingArgs userSupplied
forall a. a -> OverwritingArgs a
OverwritingArgs userSupplied
userSupplied)
   let signals :: [Signal]
signals =
          (String -> Signal) -> [String] -> [Signal]
forall a b. (a -> b) -> [a] -> [b]
map (\String
k -> Signal -> String -> Map String Signal -> Signal
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (String -> Signal
forall a. HasCallStack => String -> a
error (String -> Signal) -> String -> Signal
forall a b. (a -> b) -> a -> b
$ String
"that's weird (likely a ugen with a typo in 'Vs'): "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
ugenNameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
k) String
k Map String Signal
theArgList) ([String] -> [Signal]) -> [String] -> [Signal]
forall a b. (a -> b) -> a -> b
$ Vs tags -> [String]
forall x. GetSymbolVals x => x -> [String]
getSymbolVals Vs tags
tagList
   UGen -> SDBody' args x
addUGenF (UGen -> SDBody' args x) -> UGen -> SDBody' args x
forall a b. (a -> b) -> a -> b
$ UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S (String -> ByteString
UTF8.fromString String
ugenName)) CalculationRate
calcRate ([Signal]
signals :: [Signal]) Int
numOuts

makeMonoUGen, makeUGen :: (
     GetSymbolVals (Vs tags)
   , FromUA optional
   , FromUA userSupplied
   , SDBodyArgs optional ~ SDBodyArgs userSupplied
   , SDBodyArgs optional ~ args
   ) => String -> CalculationRate -> Vs tags -> optional -> (userSupplied -> SDBody' args Signal)
makeMonoUGen :: String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args Signal
makeMonoUGen = (UGen -> SDBody' args Signal)
-> Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args Signal
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol])
       x.
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
(UGen -> SDBody' args x)
-> Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args x
makeMakeUGen UGen -> SDBody' args Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addMonoUGen Int
1
makeUGen :: String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args Signal
makeUGen = String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args 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
makeMonoUGen

makePolyUGen :: (
     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
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args [Signal]
makePolyUGen Int
n = (UGen -> SDBody' args [Signal])
-> Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args [Signal]
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol])
       x.
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
(UGen -> SDBody' args x)
-> Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args x
makeMakeUGen UGen -> SDBody' args [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen Int
n