{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

module Vivid.UGens.Multichannel (

     -- * Multichannel > Ambisonics

---     biPanB2
---   , decodeB2
---   , panB
---   , panB2
---   , rotate2

     -- * Multichannel > Panners

---   , balance2
---   , linPan2
     pan2
---   , pan4
---   , panAz
     -- See above:
   -- , rotate2
   , splay
---   , splayAz

     -- * Multichannel > Select

---   , linSelectX
---   , linXFade2
   , select
---   , selectX
---   , selectXFocus
---   , xFade2

     -- * Multichannel
     
   , mix
---   , numChannels

   , addChannels
   ) where

import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SynthDef
--import Vivid.SynthDef.FromUA
import Vivid.UGens.Algebraic
import Vivid.UGens.Args
import Vivid.UGens.Generators.SingleValue (dc)
import Vivid.SynthDef.FromUA

import Control.Monad (foldM, zipWithM)
import Data.List.Split (chunksOf)

--- biPanB2 ::
--- biPanB2 =
--- decodeB2 ::
--- decodeB2 =
--- panB ::
--- panB =
--- panB2 ::
--- panB2 =
--- rotate2 ::
--- rotate2 =
--- balance2 ::
--- balance2 =
--- linPan2 ::
--- linPan2 =

-- | 'pos' is -1 to 1
-- 
--   'level' is \"a control-rate level input\"
pan2 :: Args '["in","pos"] '["level"] a => a -> SDBody a [Signal]
pan2 :: a -> SDBody a [Signal]
pan2 = Int
-> String
-> CalculationRate
-> Vs '["in", "pos", "level"]
-> UA "level" (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
2 String
"Pan2" CalculationRate
AR
   (Vs '["in", "pos", "level"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in","pos","level"])
   (Float -> UA "level" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "level" as
level_ (Float
1::Float))

-- return a tuple?: -- no no that's exactly when you run into problems with the foldable shit -- people get a tuple when they expect a list....
--- pan4 ::
--- pan4 =
--- panAz ::
--- panAz =

-- | "Spreads [a list] of channels across the stereo field."
splay :: ToSig s a => [s] -> SDBody' a [Signal]
splay :: [s] -> SDBody' a [Signal]
splay [s]
sigsMono = do
   -- sigs' <- mapM toSig sigs
   let numChans :: Float
       numChans :: Float
numChans = Int -> Float
forall a. Enum a => Int -> a
toEnum (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length::[a]->Int) [s]
sigsMono
   let positions :: [Float]
       positions :: [Float]
positions =
         (Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map ((\Float
x->Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
1) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
*(Float
2Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/(Float
numChansFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
1)))) [Float
0..(Float
numChansFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
1)]
    -- note SC has a different calculation for KR:
   let level :: Float
level = Float -> Float
forall a. Floating a => a -> a
sqrt (Float -> Float
forall a. Fractional a => a -> a
recip Float
numChans)
   [[Signal]]
sigsStereo <- (\s -> Float -> SDBody' a [Signal]
x -> (s -> Float -> SDBody' a [Signal])
-> [s]
-> [Float]
-> StateT ([Int], SynthDef a, VarSet a) Identity [[Signal]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM s -> Float -> SDBody' a [Signal]
x [s]
sigsMono [Float]
positions) ((s -> Float -> SDBody' a [Signal])
 -> StateT ([Int], SynthDef a, VarSet a) Identity [[Signal]])
-> (s -> Float -> SDBody' a [Signal])
-> StateT ([Int], SynthDef a, VarSet a) Identity [[Signal]]
forall a b. (a -> b) -> a -> b
$ \s
sig Float
pos ->
      (UA "in" a, UA "pos" a) -> SDBody (UA "in" a, UA "pos" a) [Signal]
forall a.
Args '["in", "pos"] '["level"] a =>
a -> SDBody a [Signal]
pan2 (s -> UA "in" a
forall s (as :: [Symbol]). ToSig s as => s -> UA "in" as
in_ s
sig, Float -> UA "pos" a
forall s (as :: [Symbol]). ToSig s as => s -> UA "pos" as
pos_ Float
pos)
   -- todo: is the rate correct in ALL cases?:
   (Signal -> StateT ([Int], SynthDef a, VarSet a) Identity Signal)
-> [Signal] -> SDBody' a [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Float
level Float
-> Signal -> StateT ([Int], SynthDef a, VarSet a) Identity Signal
forall i0 (a :: [Symbol]) i1.
(ToSig i0 a, ToSig i1 a) =>
i0 -> i1 -> SDBody' a Signal
~*) ([Signal] -> SDBody' a [Signal])
-> SDBody' a [Signal] -> SDBody' a [Signal]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Signal] -> [Signal] -> SDBody' a [Signal])
-> [Signal] -> [[Signal]] -> SDBody' a [Signal]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [Signal] -> [Signal] -> SDBody' a [Signal]
forall s0 (a :: [Symbol]) s1.
(ToSig s0 a, ToSig s1 a) =>
[s0] -> [s1] -> SDBody' a [Signal]
addChannels [] [[Signal]]
sigsStereo


-- | "Spreads [a list] of channels across the stereo field. Optional arguments are spread
--   and center, and equal power levelCompensation. The formula for the stereo position
--   is:
-- 
--   > ((0 .. (n - 1)) * (2 / (n - 1) - 1) * spread + center
--- splay' :: 
--- splay' =

--- splayAz ::
--- splayAz =

-- Don't implement: the geometry is wrong here and it's been deprecated:
-- splayZ ::

--- linSelectX ::
--- linSelectX =
--- linXFade2 ::
--- linXFade2 =

select :: ToSig s as => s -> [SDBody' as Signal] -> SDBody' as Signal
select :: s -> [SDBody' as Signal] -> SDBody' as Signal
select s
which [SDBody' as Signal]
array = do
   Signal
which' <- s -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig s
which
   [Signal]
array' <- (SDBody' as Signal -> SDBody' as Signal)
-> [SDBody' as Signal]
-> 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 SDBody' as Signal -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [SDBody' as Signal]
array
   UGen -> SDBody' as Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addUGen (UGen -> SDBody' as Signal) -> UGen -> SDBody' as Signal
forall a b. (a -> b) -> a -> b
$ UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S ByteString
"Select") CalculationRate
AR (Signal
which' Signal -> [Signal] -> [Signal]
forall a. a -> [a] -> [a]
: [Signal]
array') Int
1

--- selectX ::
--- selectX =
--- selectXFocus ::
--- selectXFocus =
--- xFade2 ::
--- xFade2 =

-- | Mixes down a list of audio rate inputs to one. 
-- 
--   This is more efficient than e.g. @foldl1 (~+)@
--
--   If the list is empty this is the same as @dc 0@
mix :: ToSig s a => [s] -> SDBody' a Signal
mix :: [s] -> SDBody' a Signal
mix [] = Float -> SDBody' a Signal
forall (a :: [Symbol]). Float -> SDBody' a Signal
dc Float
0
mix [s
x] = s -> SDBody' a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig s
x
mix [s]
xs = [Signal] -> SDBody' a Signal
forall s (a :: [Symbol]). ToSig s a => [s] -> SDBody' a Signal
mix ([Signal] -> SDBody' a Signal)
-> StateT ([Int], SynthDef a, VarSet a) Identity [Signal]
-> SDBody' a Signal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (([Signal] -> SDBody' a Signal)
-> [[Signal]]
-> StateT ([Int], SynthDef a, VarSet a) Identity [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Signal] -> SDBody' a Signal
forall (a :: [Symbol]). [Signal] -> SDBody' a Signal
mix' ([[Signal]]
 -> StateT ([Int], SynthDef a, VarSet a) Identity [Signal])
-> ([Signal] -> [[Signal]])
-> [Signal]
-> StateT ([Int], SynthDef a, VarSet a) Identity [Signal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Signal] -> [[Signal]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
4) ([Signal]
 -> StateT ([Int], SynthDef a, VarSet a) Identity [Signal])
-> StateT ([Int], SynthDef a, VarSet a) Identity [Signal]
-> StateT ([Int], SynthDef a, VarSet a) Identity [Signal]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (s -> SDBody' a Signal)
-> [s] -> StateT ([Int], SynthDef a, VarSet a) Identity [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM s -> SDBody' a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [s]
xs
 where
   mix' :: [Signal] -> SDBody' a Signal
   mix' :: [Signal] -> SDBody' a Signal
mix' [] = String -> SDBody' a Signal
forall a. HasCallStack => String -> a
error String
"something's broken"
   mix' [Signal
x] = Signal -> SDBody' a Signal
forall (m :: * -> *) a. Monad m => a -> m a
return Signal
x
   mix' [Signal
a,Signal
b] = Signal
a Signal -> Signal -> SDBody' a Signal
forall i0 (a :: [Symbol]) i1.
(ToSig i0 a, ToSig i1 a) =>
i0 -> i1 -> SDBody' a Signal
~+ Signal
b
   mix' ins :: [Signal]
ins@[Signal
_,Signal
_,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
"Sum3") CalculationRate
AR [Signal]
ins Int
1
   mix' ins :: [Signal]
ins@[Signal
_,Signal
_,Signal
_,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
"Sum4") CalculationRate
AR [Signal]
ins Int
1
   mix' [Signal]
_ = String -> SDBody' a Signal
forall a. HasCallStack => String -> a
error String
"that would be weird"

--- numChannels ::
--- numChannels =

-- | Like 'zipWithM' but if the lists are of different lengths, doesn't shorten the longer one
addChannels :: (ToSig s0 a, ToSig s1 a) => [s0] -> [s1] -> SDBody' a [Signal]
addChannels :: [s0] -> [s1] -> SDBody' a [Signal]
addChannels [] [s1]
xs = (s1 -> StateT ([Int], SynthDef a, VarSet a) Identity Signal)
-> [s1] -> SDBody' a [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM s1 -> StateT ([Int], SynthDef a, VarSet a) Identity Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [s1]
xs
addChannels [s0]
xs [] = (s0 -> StateT ([Int], SynthDef a, VarSet a) Identity Signal)
-> [s0] -> SDBody' a [Signal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM s0 -> StateT ([Int], SynthDef a, VarSet a) Identity Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig [s0]
xs
addChannels (s0
x:[s0]
xs) (s1
y:[s1]
ys) = do
   Signal
foo <- s0 -> StateT ([Int], SynthDef a, VarSet a) Identity Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig s0
x StateT ([Int], SynthDef a, VarSet a) Identity Signal
-> StateT ([Int], SynthDef a, VarSet a) Identity Signal
-> StateT ([Int], SynthDef a, VarSet a) Identity Signal
forall i0 (a :: [Symbol]) i1.
(ToSig i0 a, ToSig i1 a) =>
i0 -> i1 -> SDBody' a Signal
~+ s1 -> StateT ([Int], SynthDef a, VarSet a) Identity Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig s1
y
   (Signal
fooSignal -> [Signal] -> [Signal]
forall a. a -> [a] -> [a]
:) ([Signal] -> [Signal]) -> SDBody' a [Signal] -> SDBody' a [Signal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [s0] -> [s1] -> SDBody' a [Signal]
forall s0 (a :: [Symbol]) s1.
(ToSig s0 a, ToSig s1 a) =>
[s0] -> [s1] -> SDBody' a [Signal]
addChannels [s0]
xs [s1]
ys