module Csound.Air.Hvs(
HvsSnapshot, HvsMatrix1, HvsMatrix2, HvsMatrix3,
hvs1, hvs2, hvs3,
csdHvs1, csdHvs2, csdHvs3
) where
import Control.Monad.Trans.Class
import Csound.Dynamic hiding (int)
import Csound.Typed
import Csound.Typed.Opcode hiding (hvs1, hvs2, hvs3)
import Csound.Tab
type HvsSnapshot = [Double]
type HvsMatrix1 = [HvsSnapshot]
type HvsMatrix2 = [HvsMatrix1]
type HvsMatrix3 = [HvsMatrix2]
csdHvs1 :: Sig -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs1 :: Sig -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs1 Sig
b1 D
b2 D
b3 Tab
b4 Tab
b5 Tab
b6 = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ (E -> Dep ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> Dep ()) -> DepT GE E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> Dep ()) -> DepT GE E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> DepT GE E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> DepT GE E) -> GE E -> DepT GE E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> E -> E
f (E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3 GE (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b4 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b5 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b6
where f :: E -> E -> E -> E -> E -> E -> E
f E
a1 E
a2 E
a3 E
a4 E
a5 E
a6 = Name -> Spec1 -> [E] -> E
opcs Name
"hvs1" [(Rate
Xr,[Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2,E
a3,E
a4,E
a5,E
a6]
csdHvs2 :: Sig -> Sig -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs2 :: Sig -> Sig -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs2 Sig
b1 Sig
b2 D
b3 D
b4 D
b5 Tab
b6 Tab
b7 Tab
b8 = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ (E -> Dep ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> Dep ()) -> DepT GE E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> Dep ()) -> DepT GE E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> DepT GE E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> DepT GE E) -> GE E -> DepT GE E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> E -> E -> E -> E
f (E -> E -> E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2 GE (E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3 GE (E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b4 GE (E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b5 GE (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b6 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b7 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b8
where f :: E -> E -> E -> E -> E -> E -> E -> E -> E
f E
a1 E
a2 E
a3 E
a4 E
a5 E
a6 E
a7 E
a8 = Name -> Spec1 -> [E] -> E
opcs Name
"hvs2" [(Rate
Xr,[Rate
Kr,Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1
,E
a2
,E
a3
,E
a4
,E
a5
,E
a6
,E
a7
,E
a8]
csdHvs3 :: Sig -> Sig -> Sig -> D -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs3 :: Sig -> Sig -> Sig -> D -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs3 Sig
b1 Sig
b2 Sig
b3 D
b4 D
b5 D
b6 D
b7 Tab
b8 Tab
b9 Tab
b10 = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ (E -> Dep ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> Dep ()) -> DepT GE E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> Dep ()) -> DepT GE E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> DepT GE E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> DepT GE E) -> GE E -> DepT GE E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> E -> E -> E -> E -> E -> E
f (E -> E -> E -> E -> E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E -> E -> E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2 GE (E -> E -> E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b3 GE (E -> E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b4 GE (E -> E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b5 GE (E -> E -> E -> E -> E -> E)
-> GE E -> GE (E -> E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b6 GE (E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b7 GE (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b8 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b9 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b10
where f :: E -> E -> E -> E -> E -> E -> E -> E -> E -> E -> E
f E
a1 E
a2 E
a3 E
a4 E
a5 E
a6 E
a7 E
a8 E
a9 E
a10 = Name -> Spec1 -> [E] -> E
opcs Name
"hvs3" [(Rate
Xr
,[Rate
Kr,Rate
Kr,Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2,E
a3,E
a4,E
a5,E
a6,E
a7,E
a8,E
a9,E
a10]
hvs1 :: HvsMatrix1 -> Sig -> SE [Sig]
hvs1 :: HvsMatrix1 -> Sig -> SE [Sig]
hvs1 HvsMatrix1
as Sig
x = do
Tab
outTab <- D -> SE Tab
newTab (Int -> D
int Int
numParams)
Sig -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs1 Sig
x (Int -> D
int Int
numParams) (Int -> D
int Int
numPointsX) Tab
outTab Tab
positionsTab Tab
snapTab
[Sig] -> SE [Sig]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sig] -> SE [Sig]) -> [Sig] -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ (Int -> Sig) -> [Int] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig
kr (Sig -> Sig) -> (Int -> Sig) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Tab -> Sig) -> Tab -> Sig -> Sig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sig -> Tab -> Sig
tab Tab
outTab (Sig -> Sig) -> (Int -> Sig) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
where
numParams :: Int
numParams = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ HvsMatrix1 -> [Double]
forall a. [a] -> a
head HvsMatrix1
as
numPointsX :: Int
numPointsX = HvsMatrix1 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HvsMatrix1
as
positionsTab :: Tab
positionsTab = [Double] -> Tab
doubles ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
0 .. Int
numPointsX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
snapTab :: Tab
snapTab = [Double] -> Tab
doubles ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ HvsMatrix1 -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat HvsMatrix1
as
hvs2 :: HvsMatrix2 -> Sig2 -> SE [Sig]
hvs2 :: HvsMatrix2 -> Sig2 -> SE [Sig]
hvs2 HvsMatrix2
as (Sig
x, Sig
y) = do
Tab
outTab <- D -> SE Tab
newTab (Int -> D
int Int
numParams)
Sig -> Sig -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs2 Sig
x Sig
y (Int -> D
int Int
numParams) (Int -> D
int Int
numPointsX) (Int -> D
int Int
numPointsY) Tab
outTab Tab
positionsTab Tab
snapTab
[Sig] -> SE [Sig]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sig] -> SE [Sig]) -> [Sig] -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ (Int -> Sig) -> [Int] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig
kr (Sig -> Sig) -> (Int -> Sig) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Tab -> Sig) -> Tab -> Sig -> Sig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sig -> Tab -> Sig
tab Tab
outTab (Sig -> Sig) -> (Int -> Sig) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
where
numParams :: Int
numParams = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ HvsMatrix1 -> [Double]
forall a. [a] -> a
head (HvsMatrix1 -> [Double]) -> HvsMatrix1 -> [Double]
forall a b. (a -> b) -> a -> b
$ HvsMatrix2 -> HvsMatrix1
forall a. [a] -> a
head HvsMatrix2
as
numPointsX :: Int
numPointsX = HvsMatrix1 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HvsMatrix1 -> Int) -> HvsMatrix1 -> Int
forall a b. (a -> b) -> a -> b
$ HvsMatrix2 -> HvsMatrix1
forall a. [a] -> a
head HvsMatrix2
as
numPointsY :: Int
numPointsY = HvsMatrix2 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HvsMatrix2
as
positionsTab :: Tab
positionsTab = [Double] -> Tab
doubles ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
0 .. (Int
numPointsX Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numPointsY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
snapTab :: Tab
snapTab = [Double] -> Tab
doubles ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ HvsMatrix1 -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (HvsMatrix1 -> [Double]) -> HvsMatrix1 -> [Double]
forall a b. (a -> b) -> a -> b
$ HvsMatrix2 -> HvsMatrix1
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat HvsMatrix2
as
hvs3 :: HvsMatrix3 -> Sig3 -> SE [Sig]
hvs3 :: HvsMatrix3 -> Sig3 -> SE [Sig]
hvs3 HvsMatrix3
as (Sig
x, Sig
y, Sig
z) = do
Tab
outTab <- D -> SE Tab
newTab (Int -> D
int Int
numParams)
Sig -> Sig -> Sig -> D -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()
csdHvs3 Sig
x Sig
y Sig
z (Int -> D
int Int
numParams) (Int -> D
int Int
numPointsX) (Int -> D
int Int
numPointsY) (Int -> D
int Int
numPointsZ) Tab
outTab Tab
positionsTab Tab
snapTab
[Sig] -> SE [Sig]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sig] -> SE [Sig]) -> [Sig] -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ (Int -> Sig) -> [Int] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig
kr (Sig -> Sig) -> (Int -> Sig) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Tab -> Sig) -> Tab -> Sig -> Sig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sig -> Tab -> Sig
tab Tab
outTab (Sig -> Sig) -> (Int -> Sig) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
where
numParams :: Int
numParams = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ HvsMatrix1 -> [Double]
forall a. [a] -> a
head (HvsMatrix1 -> [Double]) -> HvsMatrix1 -> [Double]
forall a b. (a -> b) -> a -> b
$ HvsMatrix2 -> HvsMatrix1
forall a. [a] -> a
head (HvsMatrix2 -> HvsMatrix1) -> HvsMatrix2 -> HvsMatrix1
forall a b. (a -> b) -> a -> b
$ HvsMatrix3 -> HvsMatrix2
forall a. [a] -> a
head HvsMatrix3
as
numPointsX :: Int
numPointsX = HvsMatrix1 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HvsMatrix1 -> Int) -> HvsMatrix1 -> Int
forall a b. (a -> b) -> a -> b
$ HvsMatrix2 -> HvsMatrix1
forall a. [a] -> a
head (HvsMatrix2 -> HvsMatrix1) -> HvsMatrix2 -> HvsMatrix1
forall a b. (a -> b) -> a -> b
$ HvsMatrix3 -> HvsMatrix2
forall a. [a] -> a
head HvsMatrix3
as
numPointsY :: Int
numPointsY = HvsMatrix2 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HvsMatrix2 -> Int) -> HvsMatrix2 -> Int
forall a b. (a -> b) -> a -> b
$ HvsMatrix3 -> HvsMatrix2
forall a. [a] -> a
head HvsMatrix3
as
numPointsZ :: Int
numPointsZ = HvsMatrix3 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HvsMatrix3
as
positionsTab :: Tab
positionsTab = [Double] -> Tab
doubles ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
0 .. (Int
numPointsX Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numPointsY Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numPointsZ) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
snapTab :: Tab
snapTab = [Double] -> Tab
doubles ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ HvsMatrix1 -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (HvsMatrix1 -> [Double]) -> HvsMatrix1 -> [Double]
forall a b. (a -> b) -> a -> b
$ HvsMatrix2 -> HvsMatrix1
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (HvsMatrix2 -> HvsMatrix1) -> HvsMatrix2 -> HvsMatrix1
forall a b. (a -> b) -> a -> b
$ HvsMatrix3 -> HvsMatrix2
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat HvsMatrix3
as