-- | Open sound control
{-# Language ScopedTypeVariables #-}
module Csound.Typed.Control.Osc(
    OscRef, OscHost, OscPort, OscAddress, OscType,
    initOsc, listenOsc, sendOsc,
    OscVal, listenOscVal
) where

import Data.Boolean ((==*))
import Csound.Dynamic(Rate(..))

import Csound.Typed.Types
import Csound.Typed.GlobalState hiding (oscInit, oscListen, oscSend)
import qualified Csound.Typed.GlobalState as C(oscListen, oscSend)

import Csound.Typed.Control.Ref


newtype OscRef = OscRef { OscRef -> D
unOscRef :: D }

-- | Port to listen OSC-messages.
type OscPort = Int

-- | Path-like string ("/foo/bar/baz")
type OscAddress = String


-- | The string specifies the type of expected arguments.
-- The string can contain the characters "bcdfilmst" which stand for
-- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI,
-- string and timestamp.
type OscType = String

-- | The hostname of the computer. An empty string is for local machine.
type OscHost = String

-- | Initializes host client. The process starts to run in the background.
initOsc :: OscPort -> OscRef
initOsc :: OscPort -> OscRef
initOsc OscPort
port = D -> OscRef
OscRef (D -> OscRef) -> D -> OscRef
forall a b. (a -> b) -> a -> b
$ GE E -> D
forall a. Val a => GE E -> a
fromGE (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ OscPort -> GE E
getOscPortHandle OscPort
port

-- | Listens for the OSC-messages. The first argument is OSC-reference.
-- We can create it with the function @initOsc@. The next two arguments are strings.
-- The former specifies the path-like address to listen the messages. It can be:
--
-- > /foo/bar/baz
--
-- The latter specifies the type of expected arguments.
-- The string can contain the characters "bcdfilmst" which stand for
-- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI,
-- string and timestamp.
--
-- The result is an event of messages. We can run a callback on it
-- with standard function @runEvt@:
--
-- > runEvt :: Evt a -> (a -> SE ()) -> SE ()
listenOsc :: forall a . Tuple a => OscRef -> OscAddress -> OscType -> Evt a
listenOsc :: OscRef -> OscAddress -> OscAddress -> Evt a
listenOsc OscRef
oscRef OscAddress
oscAddr OscAddress
oscType = (Bam a -> SE ()) -> Evt a
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam a -> SE ()) -> Evt a) -> (Bam a -> SE ()) -> Evt a
forall a b. (a -> b) -> a -> b
$ \Bam a
bam -> do
    Ref a
resRef <- OscAddress -> SE (Ref a)
initOscRef OscAddress
oscType
    BoolSig
cond <- Tuple a => Ref a -> SE BoolSig
Ref a -> SE BoolSig
listen Ref a
resRef
    BoolSig -> SE () -> SE ()
when1 BoolSig
cond (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Bam a
bam Bam a -> SE a -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
resRef
    where
        listen :: Tuple a => Ref a -> SE BoolSig
        listen :: Ref a -> SE BoolSig
listen Ref a
ref = (Sig -> BoolSig) -> SE Sig -> SE BoolSig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE Sig -> SE BoolSig) -> SE Sig -> SE BoolSig
forall a b. (a -> b) -> a -> b
$ Tuple a => Ref a -> OscRef -> OscAddress -> OscAddress -> SE Sig
Ref a -> OscRef -> OscAddress -> OscAddress -> SE Sig
csdOscListen Ref a
ref OscRef
oscRef OscAddress
oscAddr OscAddress
oscType

        csdOscListen :: Tuple a => Ref a -> OscRef -> OscAddress -> OscType -> SE Sig
        csdOscListen :: Ref a -> OscRef -> OscAddress -> OscAddress -> SE Sig
csdOscListen (Ref [Var]
refVars) OscRef
oscHandle OscAddress
addr OscAddress
ty =
            (GE E -> Sig) -> SE (GE E) -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GE E -> Sig
forall a. Val a => GE E -> a
fromGE (SE (GE E) -> SE Sig) -> SE (GE E) -> SE Sig
forall a b. (a -> b) -> a -> b
$ Dep E -> SE (GE E)
forall a. Dep a -> SE (GE a)
fromDep (Dep E -> SE (GE E)) -> Dep E -> SE (GE E)
forall a b. (a -> b) -> a -> b
$ GE (Dep E) -> Dep E
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep E) -> Dep E) -> GE (Dep E) -> Dep E
forall a b. (a -> b) -> a -> b
$ do
                E
expOscHandle <- D -> GE E
forall a. Val a => a -> GE E
toGE (D -> GE E) -> D -> GE E
forall a b. (a -> b) -> a -> b
$ OscRef -> D
unOscRef OscRef
oscHandle
                E
expAddr <- Str -> GE E
forall a. Val a => a -> GE E
toGE (Str -> GE E) -> Str -> GE E
forall a b. (a -> b) -> a -> b
$ OscAddress -> Str
text OscAddress
addr
                E
expOscType <- Str -> GE E
forall a. Val a => a -> GE E
toGE (Str -> GE E) -> Str -> GE E
forall a b. (a -> b) -> a -> b
$ OscAddress -> Str
text OscAddress
ty
                Dep E -> GE (Dep E)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep E -> GE (Dep E)) -> Dep E -> GE (Dep E)
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> [Var] -> Dep E
forall (m :: * -> *). Monad m => E -> E -> E -> [Var] -> DepT m E
C.oscListen E
expOscHandle E
expAddr E
expOscType [Var]
refVars

        initOscRef :: OscType -> SE (Ref a)
        initOscRef :: OscAddress -> SE (Ref a)
initOscRef OscAddress
typeStr = ([Var] -> Ref a) -> SE [Var] -> SE (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Var] -> Ref a
forall a. [Var] -> Ref a
Ref (SE [Var] -> SE (Ref a)) -> SE [Var] -> SE (Ref a)
forall a b. (a -> b) -> a -> b
$ [Rate] -> GE [E] -> SE [Var]
newLocalVars ((Char -> Rate) -> OscAddress -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Rate
getOscRate OscAddress
typeStr) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple (a -> GE [E]) -> a -> GE [E]
forall a b. (a -> b) -> a -> b
$ (a
forall a. Tuple a => a
defTuple :: a))

        getOscRate :: Char -> Rate
        getOscRate :: Char -> Rate
getOscRate Char
x = case Char
x of
            Char
'a' -> Rate
Ar
            Char
's' -> Rate
Sr
            Char
'i' -> Rate
Kr
            Char
'f' -> Rate
Kr
            Char
_   -> Rate
Kr

-- | Sends OSC-messages. It takes in a name of the host computer
-- (empty string is alocal machine), port on which the target
-- machine is listening, OSC-addres and type. The last argument
-- produces the values for OSC-messages.
sendOsc :: forall a . Tuple a => OscHost -> OscPort -> OscAddress -> OscType -> Evt a -> SE ()
sendOsc :: OscAddress -> OscPort -> OscAddress -> OscAddress -> Evt a -> SE ()
sendOsc OscAddress
host OscPort
port OscAddress
addr OscAddress
ty Evt a
evts = do
    Ref Sig
flagRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newRef (Sig
0 :: Sig)
    Ref a
valRef  <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
forall a. Tuple a => a
defTuple
    Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evts (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do
        Sig
flag <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
flagRef
        Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
flagRef (Sig
flag Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1)
        Ref a -> Bam a
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
valRef  a
a

    Sig
flag <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
flagRef
    a
value <- Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
valRef
    Sig -> Bam a
Tuple a => Sig -> Bam a
send Sig
flag a
value
    where
        send :: Tuple a => Sig -> a -> SE ()
        send :: Sig -> Bam a
send Sig
trig a
as = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ do
            [E]
args <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
as
            E
expTrig <- Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
trig
            E
expHost <- Str -> GE E
forall a. Val a => a -> GE E
toGE (Str -> GE E) -> Str -> GE E
forall a b. (a -> b) -> a -> b
$ OscAddress -> Str
text (OscAddress -> Str) -> OscAddress -> Str
forall a b. (a -> b) -> a -> b
$ OscAddress
host
            E
expPort <- D -> GE E
forall a. Val a => a -> GE E
toGE (D -> GE E) -> D -> GE E
forall a b. (a -> b) -> a -> b
$ OscPort -> D
int  (OscPort -> D) -> OscPort -> D
forall a b. (a -> b) -> a -> b
$ OscPort
port
            E
expAddr <- Str -> GE E
forall a. Val a => a -> GE E
toGE (Str -> GE E) -> Str -> GE E
forall a b. (a -> b) -> a -> b
$ OscAddress -> Str
text (OscAddress -> Str) -> OscAddress -> Str
forall a b. (a -> b) -> a -> b
$ OscAddress
addr
            E
expTy   <- Str -> GE E
forall a. Val a => a -> GE E
toGE (Str -> GE E) -> Str -> GE E
forall a b. (a -> b) -> a -> b
$ OscAddress -> Str
text (OscAddress -> Str) -> OscAddress -> Str
forall a b. (a -> b) -> a -> b
$ OscAddress
ty
            Dep () -> GE (Dep ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep () -> GE (Dep ())) -> Dep () -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ [E] -> Dep ()
forall (m :: * -> *). Monad m => [E] -> DepT m ()
C.oscSend ([E] -> Dep ()) -> [E] -> Dep ()
forall a b. (a -> b) -> a -> b
$ E
expTrig E -> [E] -> [E]
forall a. a -> [a] -> [a]
: E
expHost E -> [E] -> [E]
forall a. a -> [a] -> [a]
: E
expPort E -> [E] -> [E]
forall a. a -> [a] -> [a]
: E
expAddr E -> [E] -> [E]
forall a. a -> [a] -> [a]
: E
expTy E -> [E] -> [E]
forall a. a -> [a] -> [a]
: [E]
args

class Tuple a => OscVal a where
    getOscTypes :: a -> String
    getOscRef :: a -> SE (Ref a)

instance OscVal Sig where
    getOscTypes :: Sig -> OscAddress
getOscTypes = OscAddress -> Sig -> OscAddress
forall a b. a -> b -> a
const OscAddress
"f"
    getOscRef :: Sig -> SE (Ref Sig)
getOscRef = Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef

instance OscVal Str where
    getOscTypes :: Str -> OscAddress
getOscTypes = OscAddress -> Str -> OscAddress
forall a b. a -> b -> a
const OscAddress
"s"
    getOscRef :: Str -> SE (Ref Str)
getOscRef = Str -> SE (Ref Str)
forall a. Tuple a => a -> SE (Ref a)
newRef

instance (OscVal a, OscVal b) => OscVal (a, b) where
    getOscTypes :: (a, b) -> OscAddress
getOscTypes (a
a, b
b) = a -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes a
a OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ b -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes b
b
    getOscRef :: (a, b) -> SE (Ref (a, b))
getOscRef (a
a, b
b) = do
        Ref a
refA <- a -> SE (Ref a)
forall a. OscVal a => a -> SE (Ref a)
getOscRef a
a
        Ref b
refB <- b -> SE (Ref b)
forall a. OscVal a => a -> SE (Ref a)
getOscRef b
b
        Ref (a, b) -> SE (Ref (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref (a, b) -> SE (Ref (a, b))) -> Ref (a, b) -> SE (Ref (a, b))
forall a b. (a -> b) -> a -> b
$ Ref a -> Ref b -> Ref (a, b)
forall a b. (Tuple a, Tuple b) => Ref a -> Ref b -> Ref (a, b)
concatRef Ref a
refA Ref b
refB

instance (OscVal a, OscVal b, OscVal c) => OscVal (a, b, c) where
    getOscTypes :: (a, b, c) -> OscAddress
getOscTypes (a
a, b
b, c
c) = a -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes a
a OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ b -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes b
b OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ c -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes c
c
    getOscRef :: (a, b, c) -> SE (Ref (a, b, c))
getOscRef (a
a, b
b, c
c) = do
        Ref a
refA <- a -> SE (Ref a)
forall a. OscVal a => a -> SE (Ref a)
getOscRef a
a
        Ref b
refB <- b -> SE (Ref b)
forall a. OscVal a => a -> SE (Ref a)
getOscRef b
b
        Ref c
refC <- c -> SE (Ref c)
forall a. OscVal a => a -> SE (Ref a)
getOscRef c
c
        Ref (a, b, c) -> SE (Ref (a, b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref (a, b, c) -> SE (Ref (a, b, c)))
-> Ref (a, b, c) -> SE (Ref (a, b, c))
forall a b. (a -> b) -> a -> b
$ Ref a -> Ref b -> Ref c -> Ref (a, b, c)
forall a b c.
(Tuple a, Tuple b, Tuple c) =>
Ref a -> Ref b -> Ref c -> Ref (a, b, c)
concatRef3 Ref a
refA Ref b
refB Ref c
refC

instance (OscVal a, OscVal b, OscVal c, OscVal d) => OscVal (a, b, c, d) where
    getOscTypes :: (a, b, c, d) -> OscAddress
getOscTypes (a
a, b
b, c
c, d
d) = a -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes a
a OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ b -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes b
b OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ c -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes c
c OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ d -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes d
d
    getOscRef :: (a, b, c, d) -> SE (Ref (a, b, c, d))
getOscRef (a
a, b
b, c
c, d
d) = do
        Ref a
refA <- a -> SE (Ref a)
forall a. OscVal a => a -> SE (Ref a)
getOscRef a
a
        Ref b
refB <- b -> SE (Ref b)
forall a. OscVal a => a -> SE (Ref a)
getOscRef b
b
        Ref c
refC <- c -> SE (Ref c)
forall a. OscVal a => a -> SE (Ref a)
getOscRef c
c
        Ref d
refD <- d -> SE (Ref d)
forall a. OscVal a => a -> SE (Ref a)
getOscRef d
d
        Ref (a, b, c, d) -> SE (Ref (a, b, c, d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref (a, b, c, d) -> SE (Ref (a, b, c, d)))
-> Ref (a, b, c, d) -> SE (Ref (a, b, c, d))
forall a b. (a -> b) -> a -> b
$ Ref a -> Ref b -> Ref c -> Ref d -> Ref (a, b, c, d)
forall a b c d.
(Tuple a, Tuple b, Tuple c, Tuple d) =>
Ref a -> Ref b -> Ref c -> Ref d -> Ref (a, b, c, d)
concatRef4 Ref a
refA Ref b
refB Ref c
refC Ref d
refD

instance (OscVal a, OscVal b, OscVal c, OscVal d, OscVal e) => OscVal (a, b, c, d, e) where
    getOscTypes :: (a, b, c, d, e) -> OscAddress
getOscTypes (a
a, b
b, c
c, d
d, e
e) = a -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes a
a OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ b -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes b
b OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ c -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes c
c OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ d -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes d
d OscAddress -> OscAddress -> OscAddress
forall a. [a] -> [a] -> [a]
++ e -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes e
e
    getOscRef :: (a, b, c, d, e) -> SE (Ref (a, b, c, d, e))
getOscRef (a
a, b
b, c
c, d
d, e
e) = do
        Ref a
refA <- a -> SE (Ref a)
forall a. OscVal a => a -> SE (Ref a)
getOscRef a
a
        Ref b
refB <- b -> SE (Ref b)
forall a. OscVal a => a -> SE (Ref a)
getOscRef b
b
        Ref c
refC <- c -> SE (Ref c)
forall a. OscVal a => a -> SE (Ref a)
getOscRef c
c
        Ref d
refD <- d -> SE (Ref d)
forall a. OscVal a => a -> SE (Ref a)
getOscRef d
d
        Ref e
refE <- e -> SE (Ref e)
forall a. OscVal a => a -> SE (Ref a)
getOscRef e
e
        Ref (a, b, c, d, e) -> SE (Ref (a, b, c, d, e))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref (a, b, c, d, e) -> SE (Ref (a, b, c, d, e)))
-> Ref (a, b, c, d, e) -> SE (Ref (a, b, c, d, e))
forall a b. (a -> b) -> a -> b
$ Ref a -> Ref b -> Ref c -> Ref d -> Ref e -> Ref (a, b, c, d, e)
forall a b c d e.
(Tuple a, Tuple b, Tuple c, Tuple d, Tuple e) =>
Ref a -> Ref b -> Ref c -> Ref d -> Ref e -> Ref (a, b, c, d, e)
concatRef5 Ref a
refA Ref b
refB Ref c
refC Ref d
refD Ref e
refE

-- | Listens for tuples of continuous signals read from OSC-channel.
--
-- > listenOscVal ref address initValue
listenOscVal :: (Tuple a, OscVal a) => OscRef -> String -> a -> SE a
listenOscVal :: OscRef -> OscAddress -> a -> SE a
listenOscVal OscRef
port OscAddress
path a
initVal = do
    Ref a
ref <- a -> SE (Ref a)
forall a. OscVal a => a -> SE (Ref a)
getOscRef a
initVal
    Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (OscRef -> OscAddress -> OscAddress -> Evt a
forall a. Tuple a => OscRef -> OscAddress -> OscAddress -> Evt a
listenOsc OscRef
port OscAddress
path (a -> OscAddress
forall a. OscVal a => a -> OscAddress
getOscTypes a
initVal)) (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> Ref a -> Bam a
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
a
    Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref