{-# LANGUAGE
     DataKinds
   , ExtendedDefaultRules
   , LambdaCase
   , OverloadedStrings

   , NoIncoherentInstances
   , NoMonomorphismRestriction
   , NoUndecidableInstances
   #-}

module Vivid.UGens.InOut (
     -- This is deprecated in SC:
   --   audioIn
---     diskIn
     diskOut
---   , in__
   , aIn
   , kIn
---   , inFeedback
---   , inTrig
---   , lagIn
   , localIn
   , localOut
---   , maxLocalBufs
---   , offsetOut
   , out
   , out'
   , aOut
--- , kOut
--- , kOut_mono
   , replaceOut

     -- These 2 have been deprecated in SC:
--    , sharedIn
--    , sharedOut

   , soundIn
---   , vDiskIn
---   , xOut
   ) where

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

import Data.Proxy

aIn :: Args '["bus"] '[] a => a -> SDBody a Signal
aIn :: a -> SDBody a Signal
aIn = String
-> CalculationRate
-> Vs '["bus"]
-> 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
"In" CalculationRate
AR
   (Vs '["bus"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["bus"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

--- diskIn ::
--- diskIn =

-- | 'buf' is a temporary buffer to accumulate before writing.
-- 
--    "NOTE: The Buffer's numFrames must be a power of two and is recommended to be at least 65536 -- preferably 131072 or 262144. Smaller buffer sizes mean more frequent disk access, which can cause glitches."
--
--    65536 == 2 ^ 16
--    131072 == 2 ^ 17
--    262144 == 2 ^ 18
-- 
--    For ease of use with 'sd' this has output type \"[Signal]\", but the list
--      is always empty
diskOut :: ToSig s a => BufferId -> [s] -> SDBody' a [Signal]
diskOut :: BufferId -> [s] -> SDBody' a [Signal]
diskOut (BufferId Int32
bufId) [s]
sigs = do
   [Signal]
sigs' <- (s -> StateT ([Int], SynthDef a, VarSet a) Identity Signal)
-> [s] -> SDBody' a [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM s -> StateT ([Int], SynthDef a, VarSet a) Identity Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [s]
sigs
   UGen -> SDBody' a [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen (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
"DiskOut") CalculationRate
AR (Float -> Signal
Constant (Int32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
bufId) Signal -> [Signal] -> [Signal]
forall a. a -> [a] -> [a]
: [Signal]
sigs') Int
0

--- in__ ::
--- in__ =
--- inFeedback ::
--- inFeedback =
--- inTrig ::
--- inTrig =

kIn :: Args '["bus"] '[] a => a -> SDBody a Signal
kIn :: a -> SDBody a Signal
kIn = String
-> CalculationRate
-> Vs '["bus"]
-> 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
"In" CalculationRate
KR
   (Vs '["bus"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["bus"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

--- lagIn ::
--- lagIn =

-- localIn :: Args '[] '["default"] a => Int -> a -> SDBody a [Signal]
-- "default" is 0 for now:
localIn :: Int -> SDBody' a [Signal]
localIn :: Int -> SDBody' a [Signal]
localIn Int
numChans = do
   UGen -> SDBody' a [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen (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
"LocalIn") CalculationRate
AR [Float -> Signal
Constant Float
0] Int
numChans

localOut :: ToSig s as => [s] -> SDBody' as ()
localOut :: [s] -> SDBody' as ()
localOut [s]
inSig = do
   [Signal]
sigs <- (s -> StateT ([Int], SynthDef as, VarSet as) Identity Signal)
-> [s] -> StateT ([Int], SynthDef as, VarSet as) Identity [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM s -> StateT ([Int], SynthDef as, VarSet as) Identity Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [s]
inSig
   UGen -> StateT ([Int], SynthDef as, VarSet as) Identity [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen (UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S ByteString
"LocalOut") CalculationRate
AR [Signal]
sigs Int
0) StateT ([Int], SynthDef as, VarSet as) Identity [Signal]
-> ([Signal] -> SDBody' as ()) -> SDBody' as ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [] -> () -> SDBody' as ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [Signal]
_ -> String -> SDBody' as ()
forall a. HasCallStack => String -> a
error String
"??? (23s0g)"
   () -> SDBody' as ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


--- maxLocalBufs ::
--- maxLocalBufs =
--- offsetOut ::
--- offsetOut =

out :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal]
out :: busNum -> [i] -> SDBody' a [Signal]
out = busNum -> [i] -> SDBody' a [Signal]
forall i (a :: [Symbol]) busNum.
(ToSig i a, ToSig busNum a) =>
busNum -> [i] -> SDBody' a [Signal]
aOut

out' :: (Elem "out" a, ToSig i a) => [i] -> SDBody' a [Signal]
out' :: [i] -> SDBody' a [Signal]
out' = V "out" -> [i] -> SDBody' a [Signal]
forall i (a :: [Symbol]) busNum.
(ToSig i a, ToSig busNum a) =>
busNum -> [i] -> SDBody' a [Signal]
out (V "out"
forall (a :: Symbol). KnownSymbol a => Variable a
V::V "out")

aOut :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal]
aOut :: busNum -> [i] -> SDBody' a [Signal]
aOut busNum
busNum [i]
is = do
   Signal
busNum' <- busNum -> SDBody' a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig busNum
busNum
   [Signal]
is' <- (i -> SDBody' a Signal) -> [i] -> SDBody' a [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM i -> SDBody' a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [i]
is
   UGen -> SDBody' a [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen (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
"Out") CalculationRate
AR (Signal
busNum' Signal -> [Signal] -> [Signal]
forall a. a -> [a] -> [a]
: [Signal]
is') ((forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length::[a]->Int) [i]
is)

-- kOut

-- kIn ::
-- kIn =

-- todo: does this work/is it robust?:
replaceOut :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal]
replaceOut :: busNum -> [i] -> SDBody' a [Signal]
replaceOut busNum
busNum [i]
is = do
   Signal
busNum' <- busNum -> SDBody' a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig busNum
busNum
   [Signal]
is' <- (i -> SDBody' a Signal) -> [i] -> SDBody' a [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM i -> SDBody' a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [i]
is
   UGen -> SDBody' a [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen (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
"ReplaceOut") CalculationRate
AR (Signal
busNum' Signal -> [Signal] -> [Signal]
forall a. a -> [a] -> [a]
: [Signal]
is') ((forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length::[a]->Int) [i]
is)

-- | Audio bus input (usually mic)
soundIn :: Args '["bus"] '[] a => a -> SDBody a Signal
soundIn :: a -> SDBody a Signal
soundIn a
args = do
   Signal
bus <- a
args a -> Proxy "bus" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
`uaArgVal` (Proxy "bus"
forall k (t :: k). Proxy t
Proxy::Proxy "bus")
   Signal
nob <- 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
"NumOutputBuses") CalculationRate
IR [] Int
1 {- :: SDBody a Signal -}
   Signal
inPos <- Signal
nob Signal -> Signal -> SDBody a Signal
forall i0 (a :: [Symbol]) i1.
(ToSig i0 a, ToSig i1 a) =>
i0 -> i1 -> SDBody' a Signal
~+ (Signal
bus :: Signal)
   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
"In") CalculationRate
AR [Signal
inPos] Int
1


--- vDiskIn ::
--- vDiskIn =

-- | "Send signal to a bus, crossfading with previous contents"
-- 
--   
--- xOut ::
--- xOut =