module Csound.Typed.Types.SigSpace(
SigSpace(..), BindSig(..), mul, mul', on, uon, At(..), MixAt(..),
cfd, genCfds, cfd4, cfds,
SigSpace2(..), BindSig2(..), mul2, mul2',
) where
import Control.Monad
import Control.Applicative
import Csound.Typed.Types.Prim
import Csound.Typed.GlobalState.SE
class SigSpace a where
mapSig :: (Sig -> Sig) -> a -> a
class SigSpace a => BindSig a where
bindSig :: (Sig -> SE Sig) -> a -> SE a
class SigSpace2 a where
mapSig2 :: (Sig2 -> Sig2) -> a -> a
class SigSpace2 a => BindSig2 a where
bindSig2 :: (Sig2 -> SE Sig2) -> a -> SE a
mul :: SigSpace a => Sig -> a -> a
mul k = mapSig (k * )
mul' :: BindSig a => SE Sig -> a -> SE a
mul' k = bindSig (\x -> fmap (* x) k)
mul2 :: SigSpace2 a => Sig2 -> a -> a
mul2 (ka, kb) = mapSig2 (\(a, b) -> (ka * a, kb * b))
mul2' :: BindSig2 a => SE Sig2 -> a -> SE a
mul2' k = bindSig2 (\(xa, xb) -> fmap (\(ka, kb) -> (ka * xa, kb * xb)) k)
on :: SigSpace a => Sig -> Sig -> a -> a
on a b x = uon a b $ mapSig unipolar x
where unipolar a = 0.5 + 0.5 * a
uon :: SigSpace a => Sig -> Sig -> a -> a
uon a b = mapSig (\x -> a + (b a) * x)
cfd :: (Num a, SigSpace a) => Sig -> a -> a -> a
cfd coeff a b = (1 coeff) `mul` a + coeff `mul` b
genCfds :: a -> (Sig -> a -> a -> a) -> [Sig] -> [a] -> a
genCfds zero mixFun cs xs = case xs of
[] -> zero
a:as -> foldl (\x f -> f x) a $ zipWith mix' cs as
where mix' c a b = mixFun c b a
cfd4 :: (Num a, SigSpace a) => Sig -> Sig -> a -> a -> a -> a -> a
cfd4 x y a b c d = sum $ zipWith mul [(1 x) * (1 y), x * (1 y) , x * y, (1 x) * y] [a, b, c, d]
cfds :: (Num a, SigSpace a) => [Sig] -> [a] -> a
cfds = genCfds 0 cfd
instance SigSpace Sig where mapSig = id
instance BindSig Sig where bindSig = id
instance (SigSpace a1, SigSpace a2) => SigSpace (a1, a2) where mapSig f (a1, a2) = (mapSig f a1, mapSig f a2)
instance (BindSig a1, BindSig a2) => BindSig (a1, a2) where bindSig f (a1, a2) = (,) <$> bindSig f a1 <*> bindSig f a2
instance (SigSpace a1, SigSpace a2, SigSpace a3) => SigSpace (a1, a2, a3) where mapSig f (a1, a2, a3) = (mapSig f a1, mapSig f a2, mapSig f a3)
instance (BindSig a1, BindSig a2, BindSig a3) => BindSig (a1, a2, a3) where bindSig f (a1, a2, a3) = (,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3
instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4) => SigSpace (a1, a2, a3, a4) where mapSig f (a1, a2, a3, a4) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4)
instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4) => BindSig (a1, a2, a3, a4) where bindSig f (a1, a2, a3, a4) = (,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4
instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5) => SigSpace (a1, a2, a3, a4, a5) where mapSig f (a1, a2, a3, a4, a5) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5)
instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5) => BindSig (a1, a2, a3, a4, a5) where bindSig f (a1, a2, a3, a4, a5) = (,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5
instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5, SigSpace a6) => SigSpace (a1, a2, a3, a4, a5, a6) where mapSig f (a1, a2, a3, a4, a5, a6) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6)
instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5, BindSig a6) => BindSig (a1, a2, a3, a4, a5, a6) where bindSig f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 <*> bindSig f a6
instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5, SigSpace a6, SigSpace a7) => SigSpace (a1, a2, a3, a4, a5, a6, a7) where mapSig f (a1, a2, a3, a4, a5, a6, a7) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6, mapSig f a7)
instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5, BindSig a6, BindSig a7) => BindSig (a1, a2, a3, a4, a5, a6, a7) where bindSig f (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 <*> bindSig f a6 <*> bindSig f a7
instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5, SigSpace a6, SigSpace a7, SigSpace a8) => SigSpace (a1, a2, a3, a4, a5, a6, a7, a8) where mapSig f (a1, a2, a3, a4, a5, a6, a7, a8) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6, mapSig f a7, mapSig f a8)
instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5, BindSig a6, BindSig a7, BindSig a8) => BindSig (a1, a2, a3, a4, a5, a6, a7, a8) where bindSig f (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 <*> bindSig f a6 <*> bindSig f a7 <*> bindSig f a8
instance SigSpace a => SigSpace (SE a) where mapSig f = fmap (mapSig f)
instance BindSig a => BindSig (SE a) where bindSig f = fmap (bindSig f)
toMono :: (Sig, Sig) -> Sig
toMono (a, b) = 0.5 * a + 0.5 * b
instance SigSpace2 Sig where mapSig2 f a = toMono $ f (a, a)
instance BindSig2 Sig where bindSig2 f a = fmap toMono $ f (a, a)
instance SigSpace2 (Sig, Sig) where mapSig2 = id
instance BindSig2 (Sig, Sig) where bindSig2 = id
instance SigSpace2 (Sig, Sig, Sig) where
mapSig2 f (a1, a2, a3) = (b1, b2, toMono (b3, b4))
where
(b1, b2, b3, b4) = mapSig2 f (a1, a2, a3, a4)
a4 = a3
instance BindSig2 (Sig, Sig, Sig) where
bindSig2 f (a1, a2, a3) = do
(b1, b2, b3, b4) <- bindSig2 f (a1, a2, a3, a4)
return (b1, b2, toMono (b3, b4))
where
a4 = a3
instance SigSpace2 (Sig, Sig, Sig, Sig) where
mapSig2 f (a1, a2, a3, a4) = (b1, b2, b3, b4)
where
(b1, b2) = f (a1, a2)
(b3, b4) = f (a3, a4)
instance BindSig2 (Sig, Sig, Sig, Sig) where
bindSig2 f (a1, a2, a3, a4) = do
(b1, b2) <- f (a1, a2)
(b3, b4) <- f (a3, a4)
return (b1, b2, b3, b4)
instance SigSpace2 (Sig, Sig, Sig, Sig, Sig) where
mapSig2 f (a1, a2, a3, a4, a5) = (b1, b2, b3, b4, toMono (b5, b6))
where
(b1, b2, b3, b4, b5, b6) = mapSig2 f (a1, a2, a3, a4, a5, a6)
a6 = a5
instance BindSig2 (Sig, Sig, Sig, Sig, Sig) where
bindSig2 f (a1, a2, a3, a4, a5) = do
(b1, b2, b3, b4, b5, b6) <- bindSig2 f (a1, a2, a3, a4, a5, a6)
return (b1, b2, b3, b4, toMono (b5, b6))
where
a6 = a5
instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig) where
mapSig2 f (a1, a2, a3, a4, a5, a6) = (b1, b2, b3, b4, b5, b6)
where
(b1, b2, b3, b4) = mapSig2 f (a1, a2, a3, a4)
(b5, b6) = f (a5, a6)
instance BindSig2 (Sig, Sig, Sig, Sig, Sig, Sig) where
bindSig2 f (a1, a2, a3, a4, a5, a6) = do
(b1, b2, b3, b4) <- bindSig2 f (a1, a2, a3, a4)
(b5, b6) <- f (a5, a6)
return (b1, b2, b3, b4, b5, b6)
instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
mapSig2 f (a1, a2, a3, a4, a5, a6, a7) = (b1, b2, b3, b4, b5, b6, toMono (b7, b8))
where
(b1, b2, b3, b4, b5, b6, b7, b8) = mapSig2 f (a1, a2, a3, a4, a5, a6, a7, a8)
a8 = a7
instance BindSig2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
bindSig2 f (a1, a2, a3, a4, a5, a6, a7) = do
(b1, b2, b3, b4, b5, b6, b7, b8) <- bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8)
return (b1, b2, b3, b4, b5, b6, toMono (b7, b8))
where
a8 = a7
instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
mapSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = (b1, b2, b3, b4, b5, b6, b7, b8)
where
(b1, b2, b3, b4, b5, b6) = mapSig2 f (a1, a2, a3, a4, a5, a6)
(b7, b8) = f (a7, a8)
instance BindSig2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where
bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = do
(b1, b2, b3, b4, b5, b6) <- bindSig2 f (a1, a2, a3, a4, a5, a6)
(b7, b8) <- f (a7, a8)
return (b1, b2, b3, b4, b5, b6, b7, b8)
instance SigSpace2 (Sig2, Sig2) where mapSig2 f (a1, a2) = (mapSig2 f a1, mapSig2 f a2)
instance BindSig2 (Sig2, Sig2) where bindSig2 f (a1, a2) = (,) <$> bindSig2 f a1 <*> bindSig2 f a2
instance SigSpace2 (Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3)
instance BindSig2 (Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3) = (,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3
instance SigSpace2 (Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4)
instance BindSig2 (Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4) = (,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4
instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4, a5) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5)
instance BindSig2 (Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4, a5) = (,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5
instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4, a5, a6) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5, mapSig2 f a6)
instance BindSig2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5 <*> bindSig2 f a6
instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4, a5, a6, a7) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5, mapSig2 f a6, mapSig2 f a7)
instance BindSig2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5 <*> bindSig2 f a6 <*> bindSig2 f a7
instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where mapSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5, mapSig2 f a6, mapSig2 f a7, mapSig2 f a8)
instance BindSig2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5 <*> bindSig2 f a6 <*> bindSig2 f a7 <*> bindSig2 f a8
instance SigSpace2 (Sig8, Sig8) where mapSig2 f (a1, a2) = (mapSig2 f a1, mapSig2 f a2)
instance BindSig2 (Sig8, Sig8) where bindSig2 f (a1, a2) = (,) <$> bindSig2 f a1 <*> bindSig2 f a2
instance SigSpace2 (Sig8, Sig8, Sig8, Sig8) where mapSig2 f (a1, a2, a3, a4) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4)
instance BindSig2 (Sig8, Sig8, Sig8, Sig8) where bindSig2 f (a1, a2, a3, a4) = (,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4
instance SigSpace2 (SE Sig) where mapSig2 f = fmap (mapSig2 f)
instance BindSig2 (SE Sig) where bindSig2 f = fmap (bindSig2 f)
instance SigSpace2 (SE (Sig, Sig)) where mapSig2 f = fmap (mapSig2 f)
instance BindSig2 (SE (Sig, Sig)) where bindSig2 f = fmap (bindSig2 f)
instance SigSpace2 (SE (Sig, Sig, Sig)) where mapSig2 f = fmap (mapSig2 f)
instance BindSig2 (SE (Sig, Sig, Sig)) where bindSig2 f = fmap (bindSig2 f)
instance SigSpace2 (SE (Sig, Sig, Sig, Sig)) where mapSig2 f = fmap (mapSig2 f)
instance BindSig2 (SE (Sig, Sig, Sig, Sig)) where bindSig2 f = fmap (bindSig2 f)
instance Num (SE Sig) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (SE (Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (SE (Sig, Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (SE (Sig, Sig, Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> Sig) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> (Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> (Sig, Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> (Sig, Sig, Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> SE Sig) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> SE (Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> SE (Sig, Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Num (a -> SE (Sig, Sig, Sig, Sig)) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = return . fromInteger
signum = fmap signum
abs = fmap abs
instance Fractional (SE Sig) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (SE (Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (SE (Sig, Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (SE (Sig, Sig, Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> SE Sig) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> SE (Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> SE (Sig, Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> SE (Sig, Sig, Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> Sig) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> (Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> (Sig, Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
instance Fractional (a -> (Sig, Sig, Sig, Sig)) where
(/) = liftA2 (/)
fromRational = return . fromRational
class SigSpace b => At a b c where
type AtOut a b c :: *
at :: (a -> b) -> c -> AtOut a b c
instance SigSpace a => At Sig Sig a where
type AtOut Sig Sig a = a
at f a = mapSig f a
instance At Sig (SE Sig) Sig where
type AtOut Sig (SE Sig) Sig = SE Sig
at f a = f a
instance At Sig (SE Sig) Sig2 where
type AtOut Sig (SE Sig) Sig2 = SE Sig2
at f a = bindSig f a
instance At Sig (SE Sig) Sig3 where
type AtOut Sig (SE Sig) Sig3 = SE Sig3
at f a = bindSig f a
instance At Sig (SE Sig) Sig4 where
type AtOut Sig (SE Sig) Sig4 = SE Sig4
at f a = bindSig f a
instance At Sig (SE Sig) (SE Sig) where
type AtOut Sig (SE Sig) (SE Sig) = SE Sig
at f a = join $ bindSig f a
instance At Sig (SE Sig) (SE Sig2) where
type AtOut Sig (SE Sig) (SE Sig2) = SE Sig2
at f a = join $ bindSig f a
instance At Sig (SE Sig) (SE Sig3) where
type AtOut Sig (SE Sig) (SE Sig3) = SE Sig3
at f a = join $ bindSig f a
instance At Sig (SE Sig) (SE Sig4) where
type AtOut Sig (SE Sig) (SE Sig4) = SE Sig4
at f a = join $ bindSig f a
instance At Sig Sig2 Sig where
type AtOut Sig Sig2 Sig = Sig2
at f a = f a
instance At Sig Sig2 (SE Sig) where
type AtOut Sig Sig2 (SE Sig) = SE Sig2
at f a = fmap f a
instance At Sig Sig2 Sig2 where
type AtOut Sig Sig2 Sig2 = Sig2
at f a = 0.5 * (f (fst a) + f (snd a))
instance At Sig Sig2 (SE Sig2) where
type AtOut Sig Sig2 (SE Sig2) = SE Sig2
at f a = fmap (at f) a
fromMono a = (a, a)
instance At Sig2 Sig2 Sig where
type AtOut Sig2 Sig2 Sig = Sig2
at f a = f $ fromMono a
instance At Sig2 Sig2 Sig2 where
type AtOut Sig2 Sig2 Sig2 = Sig2
at f a = f a
instance At Sig2 Sig2 (SE Sig) where
type AtOut Sig2 Sig2 (SE Sig) = SE Sig2
at f a = fmap (f . fromMono) a
instance At Sig2 Sig2 (SE Sig2) where
type AtOut Sig2 Sig2 (SE Sig2) = SE Sig2
at f a = fmap f a
instance At Sig2 (SE Sig2) Sig where
type AtOut Sig2 (SE Sig2) Sig = SE Sig2
at f a = f $ fromMono a
instance At Sig2 (SE Sig2) Sig2 where
type AtOut Sig2 (SE Sig2) Sig2 = SE Sig2
at f a = f a
instance At Sig2 (SE Sig2) (SE Sig) where
type AtOut Sig2 (SE Sig2) (SE Sig) = SE Sig2
at f a = (f . fromMono) =<< a
instance At Sig2 (SE Sig2) (SE Sig2) where
type AtOut Sig2 (SE Sig2) (SE Sig2) = SE Sig2
at f a = f =<< a
class (SigSpace b, At a b c) => MixAt a b c where
mixAt :: Sig -> (a -> b) -> c -> AtOut a b c
instance SigSpace a => MixAt Sig Sig a where
mixAt k f a = mapSig (\x -> cfd k x (f x)) a
instance MixAt Sig (SE Sig) Sig where
mixAt k f dry = do
wet <- f dry
return $ cfd k dry wet
instance MixAt Sig (SE Sig) Sig2 where
mixAt k f (dry1, dry2) = do
wet1 <- f dry1
wet2 <- f dry2
return $ cfd k (dry1, dry2) (wet1, wet2)
instance MixAt Sig (SE Sig) Sig3 where
mixAt k f (dry1, dry2, dry3) = do
wet1 <- f dry1
wet2 <- f dry2
wet3 <- f dry3
return $ cfd k (dry1, dry2, dry3) (wet1, wet2, wet3)
instance MixAt Sig (SE Sig) Sig4 where
mixAt k f (dry1, dry2, dry3, dry4) = do
wet1 <- f dry1
wet2 <- f dry2
wet3 <- f dry3
wet4 <- f dry4
return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4)
instance MixAt Sig (SE Sig) (SE Sig) where
mixAt k f dry = do
dry1 <- dry
wet1 <- f dry1
return $ cfd k dry1 wet1
instance MixAt Sig (SE Sig) (SE Sig2) where
mixAt k f dry = do
(dry1, dry2) <- dry
wet1 <- f dry1
wet2 <- f dry2
return $ cfd k (dry1, dry2) (wet1, wet2)
instance MixAt Sig (SE Sig) (SE Sig3) where
mixAt k f dry = do
(dry1, dry2, dry3) <- dry
wet1 <- f dry1
wet2 <- f dry2
wet3 <- f dry3
return $ cfd k (dry1, dry2, dry3) (wet1, wet2, wet3)
instance MixAt Sig (SE Sig) (SE Sig4) where
mixAt k f dry = do
(dry1, dry2, dry3, dry4) <- dry
wet1 <- f dry1
wet2 <- f dry2
wet3 <- f dry3
wet4 <- f dry4
return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4)
instance MixAt Sig Sig2 Sig where
mixAt k f dry = cfd k (dry, dry) wet
where wet = f dry
instance MixAt Sig Sig2 (SE Sig) where
mixAt k f dry = fmap (\x -> cfd k (x, x) (f x)) dry
instance MixAt Sig Sig2 Sig2 where
mixAt k f dry = cfd k dry wet
where wet = 0.5 * (f (fst dry) + f (snd dry))
instance MixAt Sig Sig2 (SE Sig2) where
mixAt k f dry = do
(dry1, dry2) <- dry
let wet = 0.5 * (f dry1 + f dry2)
return $ cfd k (dry1, dry2) wet
instance MixAt Sig2 Sig2 Sig where
mixAt k f dry1 = cfd k dry wet
where
dry = fromMono dry1
wet = f dry
instance MixAt Sig2 Sig2 Sig2 where
mixAt k f dry = cfd k dry wet
where
wet = f dry
instance MixAt Sig2 Sig2 (SE Sig) where
mixAt k f dry1 = do
dry <- fmap fromMono dry1
let wet = f dry
return $ cfd k dry wet
instance MixAt Sig2 Sig2 (SE Sig2) where
mixAt k f drySe = do
dry <- drySe
let wet = f dry
return $ cfd k dry wet
instance MixAt Sig2 (SE Sig2) Sig where
mixAt k f dry1 = do
wet <- f dry
return $ cfd k dry wet
where
dry = fromMono dry1
instance MixAt Sig2 (SE Sig2) Sig2 where
mixAt k f dry = do
wet <- f dry
return $ cfd k dry wet
instance MixAt Sig2 (SE Sig2) (SE Sig) where
mixAt k f dry1 = do
dry <- fmap fromMono dry1
wet <- f dry
return $ cfd k dry wet
instance MixAt Sig2 (SE Sig2) (SE Sig2) where
mixAt k f drySe = do
dry <- drySe
wet <- f dry
return $ cfd k dry wet