{-# Language ScopedTypeVariables #-}
-- | The port is a tool to route the auio signals between instruments.
-- We can allocate the port at the instance of the instrument (at the note)
-- and pass the reference in the note to another instrument. That instrument
-- cn write a signal to the port or can read the singals.
module Csound.Typed.GlobalState.Port(
    IsPort(..), mixPort, modifyPort,
    Port(..), freePort,
    PortCtrl(..), freePortCtrl
) where

import Control.Monad
import Control.Monad.Trans.Class
import Data.Proxy

import Csound.Dynamic

import Csound.Typed.GlobalState.GE
import Csound.Typed.GlobalState.SE
import Csound.Typed.Types.Tuple
import Csound.Typed.Types.Prim

import Csound.Typed.GlobalState.Opcodes(freeChn, chnName, chnget, chnset, chngetK, chnsetK)

-- port class

class IsPort p where
    readPort  :: Sigs a => p a -> SE a
    writePort :: Sigs a => p a -> a -> SE ()

mixPort :: (Sigs a) => IsPort port => port a -> a -> SE ()
mixPort :: forall a (port :: * -> *).
(Sigs a, IsPort port) =>
port a -> a -> SE ()
mixPort port a
p a
value = port a -> (a -> a) -> SE ()
forall a (port :: * -> *).
(Sigs a, IsPort port) =>
port a -> (a -> a) -> SE ()
modifyPort port a
p (a
value a -> a -> a
forall a. Num a => a -> a -> a
+ )

modifyPort :: (Sigs a, IsPort port) => port a -> (a -> a) -> SE ()
modifyPort :: forall a (port :: * -> *).
(Sigs a, IsPort port) =>
port a -> (a -> a) -> SE ()
modifyPort port a
p a -> a
f = do
    a
value <- port a -> SE a
forall a. Sigs a => port a -> SE a
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> SE a
readPort port a
p
    port a -> a -> SE ()
forall a. Sigs a => port a -> a -> SE ()
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> a -> SE ()
writePort port a
p (a -> SE ()) -> a -> SE ()
forall a b. (a -> b) -> a -> b
$ a -> a
f a
value

-- port for audio signals

newtype Port a = Port { forall a. Port a -> GE E
unPort :: GE E }

freePort :: forall a . Sigs a => SE (Port a)
freePort :: forall a. Sigs a => SE (Port a)
freePort = Dep (Port a) -> SE (Port a)
forall a. Dep a -> SE a
SE (Dep (Port a) -> SE (Port a)) -> Dep (Port a) -> SE (Port a)
forall a b. (a -> b) -> a -> b
$ (E -> Port a) -> DepT GE E -> Dep (Port a)
forall a b. (a -> b) -> DepT GE a -> DepT GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> Port a
forall a. GE E -> Port a
Port (GE E -> Port a) -> (E -> GE E) -> E -> Port a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return) (DepT GE E -> Dep (Port a)) -> DepT GE E -> Dep (Port a)
forall a b. (a -> b) -> a -> b
$ DepT GE E
forall (m :: * -> *). Monad m => DepT m E
freeChn

instance Sigs a => Tuple (Port a) where
    tupleMethods :: TupleMethods (Port a)
tupleMethods = (D -> Port a) -> (Port a -> D) -> TupleMethods (Port a)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods D -> Port a
to Port a -> D
from
        where
            to :: D -> Port a
            to :: D -> Port a
to =  GE E -> Port a
forall a. GE E -> Port a
Port (GE E -> Port a) -> (D -> GE E) -> D -> Port a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> GE E
forall a. Val a => a -> GE E
toGE

            from :: Port a -> D
            from :: Port a -> D
from (Port GE E
e) = GE E -> D
forall a. Val a => GE E -> a
fromGE GE E
e

instance Sigs a => Arg (Port a) where

instance IsPort Port where
    readPort :: forall a. Sigs a => Port a -> SE a
readPort Port a
port = Dep a -> SE a
forall a. Dep a -> SE a
SE (Dep a -> SE a) -> Dep a -> SE a
forall a b. (a -> b) -> a -> b
$ GE (Dep a) -> Dep a
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep a) -> Dep a) -> GE (Dep a) -> Dep a
forall a b. (a -> b) -> a -> b
$ do
        [E]
names <- Port a -> GE [E]
forall a. Sigs a => Port a -> GE [E]
getNames Port a
port
        Dep a -> GE (Dep a)
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep a -> GE (Dep a)) -> Dep a -> GE (Dep a)
forall a b. (a -> b) -> a -> b
$ ([E] -> a) -> DepT GE [E] -> Dep a
forall a b. (a -> b) -> DepT GE a -> DepT GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> ([E] -> GE [E]) -> [E] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [E] -> GE [E]
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return) (DepT GE [E] -> Dep a) -> DepT GE [E] -> Dep a
forall a b. (a -> b) -> a -> b
$ (E -> DepT GE E) -> [E] -> DepT GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM E -> DepT GE E
forall (m :: * -> *). Monad m => E -> DepT m E
chnget [E]
names

    writePort :: forall a. Sigs a => Port a -> a -> SE ()
writePort Port a
port a
a = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
        ([E]
names, [E]
values) <- GE ([E], [E]) -> DepT GE ([E], [E])
forall (m :: * -> *) a. Monad m => m a -> DepT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GE ([E], [E])
getNamesAndValues
        (E -> E -> Dep ()) -> [E] -> [E] -> Dep ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ E -> E -> Dep ()
forall (m :: * -> *). Monad m => E -> E -> DepT m ()
chnset [E]
names [E]
values
        where
            getNamesAndValues :: GE ([E], [E])
getNamesAndValues = do
                [E]
names  <- Port a -> GE [E]
forall a. Sigs a => Port a -> GE [E]
getNames Port a
port
                [E]
values <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
a
                ([E], [E]) -> GE ([E], [E])
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([E]
names, [E]
values)

-------------------------------------------------------------
-- ports for control signals

newtype PortCtrl a = PortCtrl { forall a. PortCtrl a -> GE E
unPortCtrl :: GE E }

freePortCtrl :: forall a . Sigs a => SE (PortCtrl a)
freePortCtrl :: forall a. Sigs a => SE (PortCtrl a)
freePortCtrl = Dep (PortCtrl a) -> SE (PortCtrl a)
forall a. Dep a -> SE a
SE (Dep (PortCtrl a) -> SE (PortCtrl a))
-> Dep (PortCtrl a) -> SE (PortCtrl a)
forall a b. (a -> b) -> a -> b
$ (E -> PortCtrl a) -> DepT GE E -> Dep (PortCtrl a)
forall a b. (a -> b) -> DepT GE a -> DepT GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> PortCtrl a
forall a. GE E -> PortCtrl a
PortCtrl (GE E -> PortCtrl a) -> (E -> GE E) -> E -> PortCtrl a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return) (DepT GE E -> Dep (PortCtrl a)) -> DepT GE E -> Dep (PortCtrl a)
forall a b. (a -> b) -> a -> b
$ DepT GE E
forall (m :: * -> *). Monad m => DepT m E
freeChn

instance Sigs a => Tuple (PortCtrl a) where
    tupleMethods :: TupleMethods (PortCtrl a)
tupleMethods = (D -> PortCtrl a) -> (PortCtrl a -> D) -> TupleMethods (PortCtrl a)
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods D -> PortCtrl a
to PortCtrl a -> D
from
        where
            to :: D -> PortCtrl a
            to :: D -> PortCtrl a
to =  GE E -> PortCtrl a
forall a. GE E -> PortCtrl a
PortCtrl (GE E -> PortCtrl a) -> (D -> GE E) -> D -> PortCtrl a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> GE E
forall a. Val a => a -> GE E
toGE

            from :: PortCtrl a -> D
            from :: PortCtrl a -> D
from (PortCtrl GE E
e) = GE E -> D
forall a. Val a => GE E -> a
fromGE GE E
e

instance Sigs a => Arg (PortCtrl a) where

instance IsPort PortCtrl where
    readPort :: forall a. Sigs a => PortCtrl a -> SE a
readPort PortCtrl a
port = Dep a -> SE a
forall a. Dep a -> SE a
SE (Dep a -> SE a) -> Dep a -> SE a
forall a b. (a -> b) -> a -> b
$ GE (Dep a) -> Dep a
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep a) -> Dep a) -> GE (Dep a) -> Dep a
forall a b. (a -> b) -> a -> b
$ do
        [E]
names <- PortCtrl a -> GE [E]
forall a. Sigs a => PortCtrl a -> GE [E]
getNamesCtrl PortCtrl a
port
        Dep a -> GE (Dep a)
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep a -> GE (Dep a)) -> Dep a -> GE (Dep a)
forall a b. (a -> b) -> a -> b
$ ([E] -> a) -> DepT GE [E] -> Dep a
forall a b. (a -> b) -> DepT GE a -> DepT GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> ([E] -> GE [E]) -> [E] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [E] -> GE [E]
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return) (DepT GE [E] -> Dep a) -> DepT GE [E] -> Dep a
forall a b. (a -> b) -> a -> b
$ (E -> DepT GE E) -> [E] -> DepT GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM E -> DepT GE E
forall (m :: * -> *). Monad m => E -> DepT m E
chngetK [E]
names

    writePort :: forall a. Sigs a => PortCtrl a -> a -> SE ()
writePort PortCtrl a
port a
a = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
        ([E]
names, [E]
values) <- GE ([E], [E]) -> DepT GE ([E], [E])
forall (m :: * -> *) a. Monad m => m a -> DepT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GE ([E], [E])
getNamesAndValues
        (E -> E -> Dep ()) -> [E] -> [E] -> Dep ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ E -> E -> Dep ()
forall (m :: * -> *). Monad m => E -> E -> DepT m ()
chnsetK [E]
names [E]
values
        where
            getNamesAndValues :: GE ([E], [E])
getNamesAndValues = do
                [E]
names  <- PortCtrl a -> GE [E]
forall a. Sigs a => PortCtrl a -> GE [E]
getNamesCtrl PortCtrl a
port
                [E]
values <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
a
                ([E], [E]) -> GE ([E], [E])
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([E]
names, [E]
values)

-------------------------------------------------------

getNames :: forall a . Sigs a => Port a -> GE [E]
getNames :: forall a. Sigs a => Port a -> GE [E]
getNames (Port GE E
ref) = do
    E
idx <- GE E
ref
    [E] -> GE [E]
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([E] -> GE [E]) -> [E] -> GE [E]
forall a b. (a -> b) -> a -> b
$ (Int -> E) -> [Int] -> [E]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> E -> E) -> E -> Int -> E
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> E -> E
chnName E
idx) [Int
1 .. (Proxy a -> Int
forall a. Tuple a => Proxy a -> Int
tupleArity (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))]

getNamesCtrl :: forall a . Sigs a => PortCtrl a -> GE [E]
getNamesCtrl :: forall a. Sigs a => PortCtrl a -> GE [E]
getNamesCtrl (PortCtrl GE E
ref) = do
    E
idx <- GE E
ref
    [E] -> GE [E]
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([E] -> GE [E]) -> [E] -> GE [E]
forall a b. (a -> b) -> a -> b
$ (Int -> E) -> [Int] -> [E]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> E -> E) -> E -> Int -> E
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> E -> E
chnName E
idx) [Int
1 .. (Proxy a -> Int
forall a. Tuple a => Proxy a -> Int
tupleArity (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))]