module Csound.Typed.Opcode.JackoOpcodes (
    
    
    
    jackoAudioIn, jackoAudioInConnect, jackoAudioOut, jackoAudioOutConnect, jackoInit, jackoMidiInConnect, jackoMidiOut, jackoMidiOutConnect, jackoNoteOut, jackoOn, jackoTransport) where

import Control.Monad.Trans.Class
import Csound.Dynamic
import Csound.Typed

-- 

-- | 
-- Receives an audio signal from a Jack port.
--
-- Receives an audio signal from a Jack audio input port 
--       inside this instance of Csound, which in turn has 
--       received the signal from its connected external Jack 
--       audio output port.
--
-- > asignal  JackoAudioIn ScsoundPortName
--
-- csound doc: <http://csound.com/docs/manual/JackoAudioIn.html>
jackoAudioIn ::  Str -> SE Sig
jackoAudioIn :: Str -> SE Sig
jackoAudioIn Str
b1 = (E -> Sig) -> SE E -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( GE E -> Sig
Sig (GE E -> Sig) -> (E -> GE E) -> E -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE Sig) -> SE E -> SE Sig
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoAudioIn" [(Rate
Ar,[Rate
Sr])] [E
a1]

-- | 
-- Creates an audio connection from a Jack port to Csound.
--
-- In the orchestra header, creates an audio connection 
--       from an external Jack audio output port to a 
--       Jack audio input port inside this instance of Csound.
--
-- >  JackoAudioInConnect SexternalPortName, ScsoundPortName
--
-- csound doc: <http://csound.com/docs/manual/JackoAudioInConnect.html>
jackoAudioInConnect ::  Str -> Str -> SE ()
jackoAudioInConnect :: Str -> Str -> SE ()
jackoAudioInConnect Str
b1 Str
b2 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoAudioInConnect" [(Rate
Xr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Sends an audio signal to a Jack port.
--
-- Sends an audio signal to an internal Jack audio 
--       output port, and in turn to its connected external 
--       Jack audio input port.
--
-- >  JackoAudioOut  ScsoundPortName, asignal
--
-- csound doc: <http://csound.com/docs/manual/JackoAudioOut.html>
jackoAudioOut ::  Str -> Sig -> SE ()
jackoAudioOut :: Str -> Sig -> SE ()
jackoAudioOut Str
b1 Sig
b2 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoAudioOut" [(Rate
Xr,[Rate
Sr,Rate
Ar])] [E
a1,E
a2]

-- | 
-- Creates an audio connection from Csound to a Jack port.
--
-- In the orchestra header, creates an audio connection 
--       from a Jack audio output port inside this instance 
--       of Csound to an external Jack audio input port.
--
-- >  JackoAudioOutConnect ScsoundPortName, SexternalPortName
--
-- csound doc: <http://csound.com/docs/manual/JackoAudioOutConnect.html>
jackoAudioOutConnect ::  Str -> Str -> SE ()
jackoAudioOutConnect :: Str -> Str -> SE ()
jackoAudioOutConnect Str
b1 Str
b2 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoAudioOutConnect" [(Rate
Xr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Initializes Csound as a Jack client.
--
-- Initializes this instance of Csound as a Jack client.
--
-- >  JackoInit ServerName, SclientName
--
-- csound doc: <http://csound.com/docs/manual/JackoInit.html>
jackoInit ::  Str -> Str -> SE ()
jackoInit :: Str -> Str -> SE ()
jackoInit Str
b1 Str
b2 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoInit" [(Rate
Xr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Creates a MIDI  connection from a Jack port to Csound.
--
-- In the orchestra header, creates a MIDI connection 
--       from an external Jack MIDI output port to this instance of Csound.
--
-- >  JackoMidiInConnect SexternalPortName, ScsoundPortName
--
-- csound doc: <http://csound.com/docs/manual/JackoMidiInConnect.html>
jackoMidiInConnect ::  Str -> Str -> SE ()
jackoMidiInConnect :: Str -> Str -> SE ()
jackoMidiInConnect Str
b1 Str
b2 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoMidiInConnect" [(Rate
Xr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Sends a MIDI channel message to a Jack port.
--
-- Sends a MIDI channel message to a Jack MIDI output port
--       inside this instance of Csound, and in turn to its 
--       connected external Jack MIDI input port.
--
-- >  JackoMidiOut  ScsoundPortName, kstatus, kchannel, kdata1[, kdata2]
--
-- csound doc: <http://csound.com/docs/manual/JackoMidiOut.html>
jackoMidiOut ::  Str -> Sig -> Sig -> Sig -> SE ()
jackoMidiOut :: Str -> Sig -> Sig -> Sig -> SE ()
jackoMidiOut Str
b1 Sig
b2 Sig
b3 Sig
b4 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E
f (E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E -> E -> E) -> GE E -> GE (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) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b3 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b4
    where f :: E -> E -> E -> E -> E
f E
a1 E
a2 E
a3 E
a4 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoMidiOut" [(Rate
Xr,[Rate
Sr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3,E
a4]

-- | 
-- Creates a MIDI connection from Csound to a Jack port.
--
-- In the orchestra header, creates a connection 
--       from a Jack MIDI output port inside this instance 
--       of Csound to an external Jack MIDI input port.
--
-- >  JackoMidiOutConnect ScsoundPortName, SexternalPortName
--
-- csound doc: <http://csound.com/docs/manual/JackoMidiOutConnect.html>
jackoMidiOutConnect ::  Str -> Str -> SE ()
jackoMidiOutConnect :: Str -> Str -> SE ()
jackoMidiOutConnect Str
b1 Str
b2 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoMidiOutConnect" [(Rate
Xr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Sends a MIDI channel message to a Jack port.
--
-- Sends a MIDI channel message to a Jack MIDI output port
--       inside this instance of Csound, and in turn to its 
--       connected external Jack MIDI input port.
--
-- >  JackoNoteOut  ScsoundPortName, kstatus, kchannel, kdata1[, kdata2]
--
-- csound doc: <http://csound.com/docs/manual/JackoNoteOut.html>
jackoNoteOut ::  Str -> Sig -> Sig -> Sig -> SE ()
jackoNoteOut :: Str -> Sig -> Sig -> Sig -> SE ()
jackoNoteOut Str
b1 Sig
b2 Sig
b3 Sig
b4 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E
f (E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E -> E -> E) -> GE E -> GE (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) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b3 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b4
    where f :: E -> E -> E -> E -> E
f E
a1 E
a2 E
a3 E
a4 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoNoteOut" [(Rate
Xr,[Rate
Sr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3,E
a4]

-- | 
-- Enables or disables all Jack ports.
--
-- In the orchestra header, after all Jack connections have been created, enables
--       or disables all Jack input and output opcodes 
--       inside this instance of Csound to read or write data.
--
-- >  JackoOn [iactive] 
--
-- csound doc: <http://csound.com/docs/manual/JackoOn.html>
jackoOn ::   SE ()
jackoOn :: SE ()
jackoOn  = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return (E -> GE E) -> E -> GE E
forall a b. (a -> b) -> a -> b
$ E
f 
    where f :: E
f  = Name -> Spec1 -> [E] -> E
opcs Name
"JackoOn" [(Rate
Xr,[Rate
Ir])] []

-- | 
-- Control the Jack transport.
--
-- Starts, stops, or repositions the Jack transport.
--       This is useful, e.g., for starting an external sequencer
--       playing to send MIDI messages to Csound.
--
-- >  JackoTransport  kcommand, [kposition]
--
-- csound doc: <http://csound.com/docs/manual/JackoTransport.html>
jackoTransport ::  Sig -> SE ()
jackoTransport :: Sig -> SE ()
jackoTransport Sig
b1 = 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 ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"JackoTransport" [(Rate
Xr,[Rate
Kr,Rate
Kr])] [E
a1]