{-# LANGUAGE
     DataKinds
   , ExtendedDefaultRules
   , FlexibleContexts
   , LambdaCase
   , OverloadedStrings
   , TypeFamilies, NoMonoLocalBinds

   , NoIncoherentInstances
   , NoMonomorphismRestriction
   , NoUndecidableInstances
   #-}

module Vivid.UGens.Buffer (

     -- * Buffer > Info

     bufChannels
   , bufDur
   , bufFrames
   , bufRateScale
   , bufSampleRate
   , bufSamples

     -- * Buffer

   , bufRd
   , bufWr
---   , dbufrd
---   , dbufwr
---   , delTapRd
---   , delTapWr
---   , detectIndex
     -- In Vivid.UGens.InOut:
   -- , diskIn
     -- In Vivid.UGens.InOut:
   -- , diskOut
     -- In Vivid.UGens.Generators.Granular:
   -- , grainBuf
---   , harmonics
---   , index
---   , indexInBetween
---   , indexL
   , localBuf
---   , multiTap
   , phasor
   , playBuf
   , playBufPoly

   , recordBuf
   , recordBufPoly
---   , scopeOut
---   , shaper
     -- In Vivid.UGens.Generators.Granular
   -- , tGrains
---   , tap
     -- In Vivid.UGens.InOut:
   -- , vDiskIn
     -- In Vivid.UGens.Generators.Granular
   -- , warp1
---   , wrapIndex
   ) where

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

import Data.Proxy
import GHC.Real (Ratio((:%)))

-- | Add a single LocalBuf for FFT
-- 
--   Can use 'Vivid.UGens.Args.chans_' for \"numChans\"
--   and 'frames_' for \"Vivid.UGens.Args.numFrames\"
localBuf :: Args '["numChans","numFrames"] '[] a => a -> SDBody a Signal
localBuf :: a -> SDBody a Signal
localBuf a
args = do
   Signal
mlb <- SDBody a Signal
forall (args :: [Symbol]). SDBody' args Signal
addOrIncrementMaxLocalBufs
   Signal
numChannels' <- a -> Proxy "numChans" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
args (Proxy "numChans"
forall k (t :: k). Proxy t
Proxy::Proxy "numChans")
   Signal
numFrames' <- a -> Proxy "numFrames" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
args (Proxy "numFrames"
forall k (t :: k). Proxy t
Proxy::Proxy "numFrames")
   -- Another example where the args in sclang and scsynth are in different orders:
   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 ByteString
"LocalBuf") CalculationRate
IR [Signal
numChannels', Signal
numFrames', Signal
mlb] Int
1


{-# DEPRECATED playBuf "use playBufPoly instead (and use bufRateScale and set doneAction)" #-}
-- | Unlike in SC, \"doneAction\\" defaults to 2
-- 
--   Also, the default rate is the 'bufRateScale' of the buffer
playBuf :: (Args '["buf"] '["rate","trigger","startPos","loop","doneAction"] a) => a -> SDBody a Signal
playBuf :: a -> SDBody a Signal
playBuf a
args = ((a -> SDBody a Signal) -> a -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ a
args) ((a -> SDBody a Signal) -> SDBody a Signal)
-> (a -> SDBody a Signal) -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["buf", "rate", "trigger", "startPos", "loop", "doneAction"]
-> (UA "rate" (SDBodyArgs a), UA "trigger" (SDBodyArgs a),
    UA "startPos" (SDBodyArgs a), UA "loop" (SDBodyArgs a),
    UA "doneAction" (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
"PlayBuf" CalculationRate
AR
   (Vs '["buf", "rate", "trigger", "startPos", "loop", "doneAction"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf","rate","trigger","startPos","loop","doneAction"])
   (SDBody a Signal -> UA "rate" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rate" as
rate_ SDBody a Signal
defaultRate, Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trigger_ ((Float
1)::Float), Float -> UA "startPos" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "startPos" as
startPos_ ((Float
0)::Float)
   ,Float -> UA "loop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "loop" as
loop_ ((Float
0)::Float), Float -> UA "doneAction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "doneAction" as
doneAction_ ((Float
2)::Float))
 where
        -- TODO: maybe don't want to do this. especially cause if you set the rate it doesn't multiply by this
        -- alternative is to change 'rate_' to 'bufrate_' and have that 'arg' function do a multiply
        -- update docs too:
          -- todo : put bufratescale on all of em if we decide to keep this behavior
   defaultRate :: SDBody a Signal
defaultRate = SDBody a Signal -> SDBody a Signal
forall s (as :: [Symbol]). ToSig s as => s -> SDBody' as Signal
bufRateScale (SDBody a Signal -> SDBody a Signal)
-> SDBody a Signal -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ a -> Variable "buf" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
args (Variable "buf"
forall (a :: Symbol). KnownSymbol a => Variable a
V::V "buf")

playBufPoly :: (Args '["buf"] '["rate","trigger","startPos","loop","doneAction"] a) => Int -> a -> SDBody a [Signal]
playBufPoly :: Int -> a -> SDBody a [Signal]
playBufPoly Int
numChans a
args = ((a -> SDBody a [Signal]) -> a -> SDBody a [Signal]
forall a b. (a -> b) -> a -> b
$ a
args) ((a -> SDBody a [Signal]) -> SDBody a [Signal])
-> (a -> SDBody a [Signal]) -> SDBody a [Signal]
forall a b. (a -> b) -> a -> b
$ Int
-> String
-> CalculationRate
-> Vs '["buf", "rate", "trigger", "startPos", "loop", "doneAction"]
-> (UA "rate" (SDBodyArgs a), UA "trigger" (SDBodyArgs a),
    UA "startPos" (SDBodyArgs a), UA "loop" (SDBodyArgs a),
    UA "doneAction" (SDBodyArgs a))
-> a
-> SDBody a [Signal]
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args [Signal]
makePolyUGen Int
numChans
   String
"PlayBuf" CalculationRate
AR
   (Vs '["buf", "rate", "trigger", "startPos", "loop", "doneAction"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf","rate","trigger","startPos","loop","doneAction"])
   (Float -> UA "rate" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rate" as
rate_ (Float
1::Float), Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trigger_ ((Float
1)::Float), Float -> UA "startPos" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "startPos" as
startPos_ ((Float
0)::Float)
   ,Float -> UA "loop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "loop" as
loop_ ((Float
0)::Float), Float -> UA "doneAction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "doneAction" as
doneAction_ (Float
0::Float)) -- NOTE doneAction is back to 0...! Good idea? (TODO)

-- | Unlike in SC, "doneAction" defaults to 2 and "loop" defaults to 0
recordBuf :: (Args '["buf","in"] '["offset","recLevel","preLevel","run","loop","trigger","doneAction"] a) => a -> SDBody a Signal
recordBuf :: a -> SDBody a Signal
recordBuf = String
-> CalculationRate
-> Vs
     '["buf", "offset", "recLevel", "preLevel", "run", "loop",
       "trigger", "doneAction", "in"]
-> (UA "offset" (SDBodyArgs a), UA "recLevel" (SDBodyArgs a),
    UA "preLevel" (SDBodyArgs a), UA "run" (SDBodyArgs a),
    UA "loop" (SDBodyArgs a), UA "trigger" (SDBodyArgs a),
    UA "doneAction" (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
"RecordBuf" CalculationRate
AR
   (Vs
  '["buf", "offset", "recLevel", "preLevel", "run", "loop",
    "trigger", "doneAction", "in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf","offset","recLevel","preLevel","run","loop","trigger","doneAction","in"])
   -- this is another example of different order:
   (Float -> UA "offset" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "offset" as
offset_ ((Float
0)::Float), Float -> UA "recLevel" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "recLevel" as
recLevel_ ((Float
1)::Float), Float -> UA "preLevel" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "preLevel" as
preLevel_ ((Float
0)::Float), Float -> UA "run" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "run" as
run_ ((Float
1)::Float), Float -> UA "loop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "loop" as
loop_ ((Float
0)::Float), Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trigger_ ((Float
1)::Float), Float -> UA "doneAction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "doneAction" as
doneAction_ ((Float
2)::Float))

-- | Unlike in SC, "doneAction" defaults to 2 and "loop" defaults to 0
recordBufPoly :: (Args '["buf","in"] '["offset","recLevel","preLevel","run","loop","trigger","doneAction"] a) => Int -> a -> SDBody a [Signal]
recordBufPoly :: Int -> a -> SDBody a [Signal]
recordBufPoly Int
numChans = Int
-> String
-> CalculationRate
-> Vs
     '["buf", "offset", "recLevel", "preLevel", "run", "loop",
       "trigger", "doneAction", "in"]
-> (UA "offset" (SDBodyArgs a), UA "recLevel" (SDBodyArgs a),
    UA "preLevel" (SDBodyArgs a), UA "run" (SDBodyArgs a),
    UA "loop" (SDBodyArgs a), UA "trigger" (SDBodyArgs a),
    UA "doneAction" (SDBodyArgs a))
-> a
-> SDBody a [Signal]
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args [Signal]
makePolyUGen Int
numChans
   String
"RecordBuf" CalculationRate
AR
   (Vs
  '["buf", "offset", "recLevel", "preLevel", "run", "loop",
    "trigger", "doneAction", "in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf","offset","recLevel","preLevel","run","loop","trigger","doneAction","in"])
   -- this is another example of different order:
   (Float -> UA "offset" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "offset" as
offset_ ((Float
0)::Float), Float -> UA "recLevel" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "recLevel" as
recLevel_ ((Float
1)::Float), Float -> UA "preLevel" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "preLevel" as
preLevel_ ((Float
0)::Float), Float -> UA "run" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "run" as
run_ ((Float
1)::Float), Float -> UA "loop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "loop" as
loop_ ((Float
0)::Float), Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trigger_ ((Float
1)::Float), Float -> UA "doneAction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "doneAction" as
doneAction_ ((Float
2)::Float))



-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so!
bufChannels :: (Args '["buf"] '[] a) => a -> SDBody a Signal
bufChannels :: a -> SDBody a Signal
bufChannels = String
-> CalculationRate
-> Vs '["buf"]
-> 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
"BufChannels" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so!
bufDur :: (Args '["buf"] '[] a) => a -> SDBody a Signal
bufDur :: a -> SDBody a Signal
bufDur = String
-> CalculationRate
-> Vs '["buf"]
-> 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
"BufDur" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- bufFrames :: (Args '["buf"] '[] a) => a -> SDBody a Signal

-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so!
-- 
--   Note you don't need to use "buf_" when you use this
bufFrames :: ToSig s as => s -> SDBody' as Signal
bufFrames :: s -> SDBody' as Signal
bufFrames = ((UA "buf" as -> SDBody' as Signal)
-> (s -> UA "buf" as) -> s -> SDBody' as Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> UA "buf" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "buf" as
buf_) ((UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal)
-> (UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults as
-> UA "buf" as
-> SDBody' as 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
"BufFrames" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults as
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- bufRateScale :: (Args '["buf"] '[] a) => a -> SDBody a Signal

-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so!
-- 
--   Note you don't need to use "buf_" when you use this
bufRateScale :: ToSig s as => s -> SDBody' as Signal
bufRateScale :: s -> SDBody' as Signal
bufRateScale = ((UA "buf" as -> SDBody' as Signal)
-> (s -> UA "buf" as) -> s -> SDBody' as Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> UA "buf" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "buf" as
buf_) ((UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal)
-> (UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults as
-> UA "buf" as
-> SDBody' as 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
"BufRateScale" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults as
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- bufSampleRate :: (Args '["buf"] '[] a) => a -> SDBody a Signal

-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so!
-- 
--   Note you don't need to use "buf_" when you use this
bufSampleRate :: ToSig s as => s -> SDBody' as Signal
bufSampleRate :: s -> SDBody' as Signal
bufSampleRate = ((UA "buf" as -> SDBody' as Signal)
-> (s -> UA "buf" as) -> s -> SDBody' as Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> UA "buf" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "buf" as
buf_) ((UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal)
-> (UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults as
-> UA "buf" as
-> SDBody' as 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
"BufSampleRate" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults as
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- bufSamples :: (Args '["buf"] '[] a) => a -> SDBody a Signal

-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so!
-- 
--   Note you don't need to use "buf_" when you use this
bufSamples :: ToSig s as => s -> SDBody' as Signal
bufSamples :: s -> SDBody' as Signal
bufSamples = ((UA "buf" as -> SDBody' as Signal)
-> (s -> UA "buf" as) -> s -> SDBody' as Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> UA "buf" as
forall s (as :: [Symbol]). ToSig s as => s -> UA "buf" as
buf_) ((UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal)
-> (UA "buf" as -> SDBody' as Signal) -> s -> SDBody' as Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults as
-> UA "buf" as
-> SDBody' as 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
"BufSamples" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults as
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- | \"phase\" must be at audio rate ('AR')
-- 
--   \"numChans\" can't be set after the synth is created, and must be a fixed integer
bufRd :: Args '["numChans", "buf", "phase"] '["loop", "interp"] a => a -> SDBody a [Signal]
bufRd :: a -> SDBody a [Signal]
bufRd a
args = do
   Int
numChans <- a -> Variable "numChans" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
args (Variable "numChans"
forall (a :: Symbol). KnownSymbol a => Variable a
V::V "numChans") SDBody a Signal
-> (Signal
    -> StateT
         ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
         Identity
         Int)
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Constant Float
x -> case Float -> Rational
forall a. Real a => a -> Rational
toRational Float
x of
         Integer
n :% Integer
1 -> Int
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
 -> StateT
      ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
      Identity
      Int)
-> Int
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n
         Rational
_ -> String
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     Int
forall a. HasCallStack => String -> a
error (String
 -> StateT
      ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
      Identity
      Int)
-> String
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     Int
forall a b. (a -> b) -> a -> b
$ String
"bufRd: numChans not an integer!: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
x
      Signal
_ -> String
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     Int
forall a. HasCallStack => String -> a
error String
"bufrd: not a fixed integer!"
   Int
-> String
-> CalculationRate
-> Vs '["buf", "phase", "loop", "interp"]
-> (UA "loop" (SDBodyArgs a), UA "interp" (SDBodyArgs a))
-> a
-> SDBody a [Signal]
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args [Signal]
makePolyUGen Int
numChans
      String
"BufRd" CalculationRate
AR
      (Vs '["buf", "phase", "loop", "interp"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "phase", "loop", "interp"])
      (Float -> UA "loop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "loop" as
loop_ ((Float
1)::Float), Float -> UA "interp" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "interp" as
interp_ ((Float
2)::Float))
      a
args

-- | "phase" must be at audio rate ('AR')
bufWr :: (Args '["in", {- "numChans", -} "buf", "phase"] '["loop"] a) => a -> SDBody a Signal
bufWr :: a -> SDBody a Signal
bufWr = String
-> CalculationRate
-> Vs '["buf", "phase", "loop", "in"]
-> UA "loop" (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
"BufWr" CalculationRate
AR
   -- An example of arguments in different orders in sclang and scsynth:
   (Vs '["buf", "phase", "loop", "in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "phase", "loop", "in"])
   (Float -> UA "loop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "loop" as
loop_ ((Float
1)::Float))

        -- returns demandrate
--- dbufrd ::
--- dbufrd =
--- dbufwr ::
--- dbufwr =

-- | "phase" must be the output of 'delTapWr'
--delTapRd :: (Args '["buf", "phase", "delSecs"] '["interp"] a) => s -> SDBody a Signal
--- delTapRd ::
--- delTapRd =

--- delTapWr ::
--- delTapWr =
--- detectIndex ::
--- detectIndex =
--- harmonics ::
--- harmonics =
--- index ::
--- index =
--- indexInBetween ::
--- indexInBetween =
--- indexL ::
--- indexL =
--- multiTap ::
--- multiTap =

phasor :: (Args '[] '["trigger", "rate", "start", "end", "resetPos"] a) => a -> SDBody a Signal
phasor :: a -> SDBody a Signal
phasor = String
-> CalculationRate
-> Vs '["trigger", "rate", "start", "end", "resetPos"]
-> (UA "trigger" (SDBodyArgs a), UA "rate" (SDBodyArgs a),
    UA "start" (SDBodyArgs a), UA "end" (SDBodyArgs a),
    UA "resetPos" (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
"Phasor" CalculationRate
AR
   (Vs '["trigger", "rate", "start", "end", "resetPos"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["trigger", "rate", "start", "end", "resetPos"])
   (Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trig_ ((Float
0)::Float), Float -> UA "rate" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rate" as
rate_ ((Float
1)::Float), Float -> UA "start" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "start" as
start_ ((Float
0)::Float), Float -> UA "end" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "end" as
end_ ((Float
1)::Float), Float -> UA "resetPos" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "resetPos" as
resetPos_ ((Float
0)::Float))

--- scopeOut ::
--- scopeOut =
--- shaper ::
--- shaper =
--- tap ::
--- tap =
--- wrapIndex ::
--- wrapIndex =