module Csound.Typed.Opcode.InstrumentControl (
    
    
    -- * Clock Control.
    clockoff, clockon,
    
    -- * Compilation.
    compilecsd, compileorc, compilestr, evalstr,
    
    -- * Duration Control.
    ihold, turnoff, turnon,
    
    -- * Invocation.
    event, event_i, mute, nstance, readscore, remove, schedkwhen, schedkwhennamed, schedule, schedwhen, scoreline, scoreline_i,
    
    -- * Realtime Performance Control.
    active, cpumeter, cpuprc, exitnow, jacktransport, maxalloc, prealloc,
    
    -- * Sensing and Control.
    button, changed, changed2, checkbox, control, follow, follow2, getcfg, joystick, metro, midifilestatus, miditempo, p5gconnect, p5gdata, pcount, peak, pindex, pitch, pitchamdf, plltrack, ptrack, readscratch, rewindscore, rms, sensekey, seqtime, seqtime2, setctrl, setscorepos, splitrig, tempest, tempo, tempoval, timedseq, trigger, trigseq, vactrol, wiiconnect, wiidata, wiirange, wiisend, writescratch, xyin,
    
    -- * Stacks.
    pop, pop_f, push, push_f, stack,
    
    -- * Subinstrument Control.
    subinstr, subinstrinit,
    
    -- * Time Reading.
    date, dates, readclock, rtclock, timeinstk, timeinsts, timek, times) where

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

-- Clock Control.

-- | 
-- Stops one of a number of internal clocks.
--
-- >  clockoff  inum
--
-- csound doc: <http://csound.com/docs/manual/clockoff.html>
clockoff ::  D -> SE ()
clockoff :: D -> SE ()
clockoff D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"clockoff" [(Rate
Xr,[Rate
Ir])] [E
a1]

-- | 
-- Starts one of a number of internal clocks.
--
-- >  clockon  inum
--
-- csound doc: <http://csound.com/docs/manual/clockon.html>
clockon ::  D -> SE ()
clockon :: D -> SE ()
clockon D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"clockon" [(Rate
Xr,[Rate
Ir])] [E
a1]

-- Compilation.

-- | 
-- compiles a new orchestra from an ASCII file
--
-- Compilecsd will read a CSD file and compile one or more instruments at init time, which will be added to the running engine. In case of existing instrument numbers or names, these will be replaced, but any instance still running of the old instrument definition will still perform until it terminates. In addition, it will read the score (if it exists) contained in the CSD file and add it to the list of events to be performed by Csound. The opcode ignores any section in the CSD file that is not the orchestra or the score.
--
-- > ires  compilecsd  Sfilename
--
-- csound doc: <http://csound.com/docs/manual/compilecsd.html>
compilecsd ::  Str -> D
compilecsd :: Str -> D
compilecsd Str
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
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
"compilecsd" [(Rate
Ir,[Rate
Sr])] [E
a1]

-- | 
-- compiles a new orchestra from an ASCII file
--
-- Compileorc will compile one or more instruments at init time, which will be added to the running engine. In case of
-- existing instrument numbers or names, these will be replaced, but any instance still running of the old instrument
-- definition will still perform until it terminates.
--
-- > ires  compileorc  Sfilename
--
-- csound doc: <http://csound.com/docs/manual/compileorc.html>
compileorc ::  Str -> D
compileorc :: Str -> D
compileorc Str
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
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
"compileorc" [(Rate
Ir,[Rate
Sr])] [E
a1]

-- | 
-- compiles a new orchestra passed in as an ASCII string
--
-- Compilestr will compile one or more instruments at init time, which will be added to the running engine. In case of
-- existing instrument numbers or names, these will be replaced, but any instance still running of the old instrument
-- definition will still perform until it terminates. Only new instances will use the new definition.
-- Multi-line strings are accepted, using {{  }} to enclose the string.
--
-- > ires  compilestr  Sorch
--
-- csound doc: <http://csound.com/docs/manual/compilestr.html>
compilestr ::  Str -> D
compilestr :: Str -> D
compilestr Str
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
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
"compilestr" [(Rate
Ir,[Rate
Sr])] [E
a1]

-- | 
-- Evalstrs evaluates a string containing Csound code, returning a value.
--
-- Evalstr compiles and runs Csound code and returns a value from the global space (instr 0). This opcode can be
-- also used to compile new instruments (as compilestr).
--
-- > ires  evalstr  Scode 
-- > kres  evalstr  Scode, ktrig 
--
-- csound doc: <http://csound.com/docs/manual/evalstr.html>
evalstr ::  Str -> Sig
evalstr :: Str -> Sig
evalstr Str
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"evalstr" [(Rate
Ir,[Rate
Sr]),(Rate
Kr,[Rate
Sr,Rate
Kr])] [E
a1]

-- Duration Control.

-- | 
-- Creates a held note.
--
-- Causes a finite-duration note to become a “held” note
--
-- >  ihold 
--
-- csound doc: <http://csound.com/docs/manual/ihold.html>
ihold ::   SE ()
ihold :: SE ()
ihold  = 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 -> 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
"ihold" [(Rate
Xr,[])] []

-- | 
-- Enables an instrument to turn itself off or to turn an instance of another instrument off.
--
-- >  turnoff 
-- >  turnoff  inst
-- >  turnoff  knst
--
-- csound doc: <http://csound.com/docs/manual/turnoff.html>
turnoff ::   SE ()
turnoff :: SE ()
turnoff  = 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 -> 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
"turnoff" [(Rate
Xr,[])] []

-- | 
-- Activate an instrument for an indefinite time.
--
-- >  turnon  insnum [, itime]
--
-- csound doc: <http://csound.com/docs/manual/turnon.html>
turnon ::  D -> SE ()
turnon :: D -> SE ()
turnon D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"turnon" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1]

-- Invocation.

-- | 
-- Generates a score event from an instrument.
--
-- >  event  "scorechar", kinsnum, kdelay, kdur, [, kp4] [, kp5] [, ...]
-- >  event  "scorechar", "insname", kdelay, kdur, [, kp4] [, kp5] [, ...]
--
-- csound doc: <http://csound.com/docs/manual/event.html>
event ::  Str -> Sig -> Sig -> Sig -> [Sig] -> SE ()
event :: Str -> Sig -> Sig -> Sig -> [Sig] -> SE ()
event Str
b1 Sig
b2 Sig
b3 Sig
b4 [Sig]
b5 = 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
f (E -> E -> E -> E -> [E] -> E)
-> GE E -> GE (E -> 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] -> E) -> GE E -> GE (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) -> GE E -> GE (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) -> GE E -> GE ([E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b4 GE ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Sig -> GE E) -> [Sig] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> GE E
unSig [Sig]
b5
    where f :: E -> E -> E -> E -> [E] -> E
f E
a1 E
a2 E
a3 E
a4 [E]
a5 = Name -> Spec1 -> [E] -> E
opcs Name
"event" [(Rate
Xr,[Rate
Sr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Kr))] ([E
a1,E
a2,E
a3,E
a4] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a5)

-- | 
-- Generates a score event from an instrument.
--
-- >  event_i  "scorechar", iinsnum, idelay, idur, [, ip4] [, ip5] [, ...]
-- >  event_i  "scorechar", "insname", idelay, idur, [, ip4] [, ip5] [, ...]
--
-- csound doc: <http://csound.com/docs/manual/event_i.html>
event_i ::  Str -> D -> D -> D -> [D] -> SE ()
event_i :: Str -> D -> D -> D -> [D] -> SE ()
event_i Str
b1 D
b2 D
b3 D
b4 [D]
b5 = 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
f (E -> E -> E -> E -> [E] -> E)
-> GE E -> GE (E -> 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] -> 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
b2 GE (E -> E -> [E] -> E) -> GE E -> GE (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) -> GE E -> GE ([E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b4 GE ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (D -> GE E) -> [D] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM D -> GE E
unD [D]
b5
    where f :: E -> E -> E -> E -> [E] -> E
f E
a1 E
a2 E
a3 E
a4 [E]
a5 = Name -> Spec1 -> [E] -> E
opcs Name
"event_i" [(Rate
Xr,[Rate
Sr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] ([E
a1,E
a2,E
a3,E
a4] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a5)

-- | 
-- Mutes/unmutes new instances of a given instrument.
--
-- >  mute  insnum [, iswitch]
-- >  mute  "insname" [, iswitch]
--
-- csound doc: <http://csound.com/docs/manual/mute.html>
mute ::  D -> SE ()
mute :: D -> SE ()
mute D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"mute" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1]

-- | 
-- Schedules a new instrument instance, storing the instance handle in a variable.
--
-- Schedules a new instrument nstance, returning a handle that can be used later to
-- refer directly to the running nstance. This opcode is similar to schedule, but has the added
-- facility of retrieving the nstance handle.
--
-- > iHandle  nstance  insnum, iwhen, idur [, ip4] [, ip5] [...]
-- > iHandle  nstance  "insname", iwhen, idur [, ip4] [, ip5] [...]
--
-- csound doc: <http://csound.com/docs/manual/nstance.html>
nstance ::  D -> D -> D -> D
nstance :: D -> D -> D -> D
nstance D
b1 D
b2 D
b3 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"nstance" [(Rate
Ir,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir)),(Rate
Ir,[Rate
Sr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] [E
a1,E
a2,E
a3]

-- | 
-- Read, preprocess and schedule a score from an input string.
--
-- Readscore will issue one or more score events. 
-- 	  It can handle strings in the same conditions as
-- 	  the standard score, including preprocessing (carry, sort, ramp, etc). 
-- Multi-line strings are accepted, using {{  }} to enclose the string.
--
-- >  readscore  Sin 
--
-- csound doc: <http://csound.com/docs/manual/readscore.html>
readscore ::  Str -> SE ()
readscore :: Str -> SE ()
readscore Str
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 ()) -> 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
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
"readscore" [(Rate
Xr,[Rate
Sr])] [E
a1]

-- | 
-- Removes the definition of an instrument.
--
-- Removes the definition of an instrument as long as it is not in use.
--
-- >  remove  insnum
--
-- csound doc: <http://csound.com/docs/manual/remove.html>
remove ::  D -> SE ()
remove :: D -> SE ()
remove D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"remove" [(Rate
Xr,[Rate
Ir])] [E
a1]

-- | 
-- Adds a new score event generated by a k-rate trigger.
--
-- >  schedkwhen  ktrigger, kmintim, kmaxnum, kinsnum, kwhen, kdur \
-- >           [, ip4] [, ip5] [...]
-- >  schedkwhen  ktrigger, kmintim, kmaxnum, "insname", kwhen, kdur \
-- >           [, ip4] [, ip5] [...]
--
-- csound doc: <http://csound.com/docs/manual/schedkwhen.html>
schedkwhen ::  Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> SE ()
schedkwhen :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> SE ()
schedkwhen Sig
b1 Sig
b2 Sig
b3 Sig
b4 Sig
b5 Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> Sig -> GE E
unSig Sig
b4 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
b5 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
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
"schedkwhen" [(Rate
Xr,[Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] [E
a1
                                                                                            ,E
a2
                                                                                            ,E
a3
                                                                                            ,E
a4
                                                                                            ,E
a5
                                                                                            ,E
a6]

-- | 
-- Similar to schedkwhen but uses a named instrument at init-time.
--
-- >  schedkwhennamed  ktrigger, kmintim, kmaxnum, "name", kwhen, kdur \
-- >           [, ip4] [, ip5] [...]
--
-- csound doc: <http://csound.com/docs/manual/schedkwhennamed.html>
schedkwhennamed ::  Sig -> Sig -> Sig -> Str -> Sig -> Sig -> SE ()
schedkwhennamed :: Sig -> Sig -> Sig -> Str -> Sig -> Sig -> SE ()
schedkwhennamed Sig
b1 Sig
b2 Sig
b3 Str
b4 Sig
b5 Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> Str -> GE E
unStr Str
b4 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
b5 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
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
"schedkwhennamed" [(Rate
Xr,[Rate
Kr,Rate
Kr,Rate
Kr,Rate
Sr,Rate
Kr,Rate
Kr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] [E
a1
                                                                                                 ,E
a2
                                                                                                 ,E
a3
                                                                                                 ,E
a4
                                                                                                 ,E
a5
                                                                                                 ,E
a6]

-- | 
-- Adds a new score event.
--
-- >  schedule  insnum, iwhen, idur [, ip4] [, ip5] [...]
-- >  schedule  "insname", iwhen, idur [, ip4] [, ip5] [...]
--
-- csound doc: <http://csound.com/docs/manual/schedule.html>
schedule ::  D -> D -> D -> SE ()
schedule :: D -> D -> D -> SE ()
schedule D
b1 D
b2 D
b3 = 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
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"schedule" [(Rate
Xr,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] [E
a1,E
a2,E
a3]

-- | 
-- Adds a new score event.
--
-- >  schedwhen  ktrigger, kinsnum, kwhen, kdur [, ip4] [, ip5] [...]
-- >  schedwhen  ktrigger, "insname", kwhen, kdur [, ip4] [, ip5] [...]
--
-- csound doc: <http://csound.com/docs/manual/schedwhen.html>
schedwhen ::  Sig -> Sig -> Sig -> Sig -> SE ()
schedwhen :: Sig -> Sig -> Sig -> Sig -> SE ()
schedwhen Sig
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 ()) -> 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
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
<$> Sig -> GE E
unSig Sig
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
"schedwhen" [(Rate
Xr,[Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] [E
a1,E
a2,E
a3,E
a4]

-- | 
-- Issues one or more score line events from an instrument.
--
-- Scoreline will issue one or more score events, if ktrig is 1 every k-period. 
-- 	  It can handle strings in the same conditions as
-- 	  the standard score. Multi-line strings are accepted, using {{  }} to enclose the string.
--
-- >  scoreline  Sin, ktrig
--
-- csound doc: <http://csound.com/docs/manual/scoreline.html>
scoreline ::  Str -> Sig -> SE ()
scoreline :: Str -> Sig -> SE ()
scoreline 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 ()) -> 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
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
"scoreline" [(Rate
Xr,[Rate
Sr,Rate
Kr])] [E
a1,E
a2]

-- | 
-- Issues one or more score line events from an instrument at i-time.
--
-- scoreline_i will issue score events at i-time.  It can handle strings in the same conditions as the standard score. Multi-line strings are accepted, using {{  }} to enclose the string.
--
-- >  scoreline_i  Sin
--
-- csound doc: <http://csound.com/docs/manual/scoreline_i.html>
scoreline_i ::  Str -> SE ()
scoreline_i :: Str -> SE ()
scoreline_i Str
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 ()) -> 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
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
"scoreline_i" [(Rate
Xr,[Rate
Sr])] [E
a1]

-- Realtime Performance Control.

-- | 
-- Returns the number of active instances of an instrument.
--
-- Returns the number of active instances of an instrument with
--       options to ignore releasing instances.
--
-- > ir  active  insnum [,iopt [,inorel]]
-- > ir  active  Sinsname [,iopt [,inorel]]
-- > kres  active  kinsnum [,iopt [,inorel]]
--
-- csound doc: <http://csound.com/docs/manual/active.html>
active ::  D -> Sig
active :: D -> Sig
active D
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"active" [(Rate
Ir,[Rate
Ir,Rate
Ir,Rate
Ir]),(Rate
Ir,[Rate
Sr,Rate
Ir,Rate
Ir]),(Rate
Kr,[Rate
Kr,Rate
Ir,Rate
Ir])] [E
a1]

-- | 
-- Reports the usage of cpu either total or per core.
--
-- Reports the usage of cpu either total or per core to monitor how
--       close to max-out the processing is.
--
-- > ktot[,kcpu1, kcpu2,...] cpumeter  ifreq
--
-- csound doc: <http://csound.com/docs/manual/cpumeter.html>
cpumeter :: Tuple a => D -> a
cpumeter :: D -> a
cpumeter D
b1 = GE (MultiOut [E]) -> a
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> a) -> GE (MultiOut [E]) -> a
forall a b. (a -> b) -> a -> b
$ E -> MultiOut [E]
f (E -> MultiOut [E]) -> GE E -> GE (MultiOut [E])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> MultiOut [E]
f E
a1 = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"cpumeter" ((Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Kr),[Rate
Ir]) [E
a1]

-- | 
-- Control allocation of cpu resources on a per-instrument basis, to optimize realtime output.
--
-- >  cpuprc  insnum, ipercent
-- >  cpuprc  Sinsname, ipercent
--
-- csound doc: <http://csound.com/docs/manual/cpuprc.html>
cpuprc ::  D -> D -> SE ()
cpuprc :: D -> D -> SE ()
cpuprc D
b1 D
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 ()) -> 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
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"cpuprc" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- | 
-- Exit Csound as fast as possible, with no cleaning up.
--
-- In Csound4 calls an exit function to leave Csound as fast as
--     possible. On Csound5 exits back to the driving code.
--
-- >  exitnow  [ivalue]
--
-- csound doc: <http://csound.com/docs/manual/exitnow.html>
exitnow ::   SE ()
exitnow :: SE ()
exitnow  = 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 -> 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
"exitnow" [(Rate
Xr,[Rate
Ir])] []

-- | 
-- Start/stop jack_transport and can optionally relocate the playback head.
--
-- >  jacktransport  icommand [, ilocation]
--
-- csound doc: <http://csound.com/docs/manual/jacktransport.html>
jacktransport ::  D -> SE ()
jacktransport :: D -> SE ()
jacktransport D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"jacktransport" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1]

-- | 
-- Limits the number of allocations of an instrument.
--
-- >  maxalloc  insnum, icount
-- >  maxalloc  Sinsname, icount
--
-- csound doc: <http://csound.com/docs/manual/maxalloc.html>
maxalloc ::  D -> D -> SE ()
maxalloc :: D -> D -> SE ()
maxalloc D
b1 D
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 ()) -> 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
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"maxalloc" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- | 
-- Creates space for instruments but does not run them.
--
-- >  prealloc  insnum, icount
-- >  prealloc  "insname", icount
--
-- csound doc: <http://csound.com/docs/manual/prealloc.html>
prealloc ::  D -> D -> SE ()
prealloc :: D -> D -> SE ()
prealloc D
b1 D
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 ()) -> 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
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"prealloc" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- Sensing and Control.

-- | 
-- Sense on-screen controls.
--
-- Sense on-screen controls. Requires Winsound or TCL/TK.
--
-- > kres  button  knum
--
-- csound doc: <http://csound.com/docs/manual/button.html>
button ::  Sig -> Sig
button :: Sig -> Sig
button Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"button" [(Rate
Kr,[Rate
Kr])] [E
a1]

-- | 
-- k-rate signal change detector.
--
-- This opcode outputs a trigger signal that informs when any one of its k-rate arguments has changed. Useful with valuator widgets or MIDI controllers.
--
-- > ktrig  changed  kvar1 [, kvar2,..., kvarN]
--
-- csound doc: <http://csound.com/docs/manual/changed.html>
changed ::  [Sig] -> Sig
changed :: [Sig] -> Sig
changed [Sig]
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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) -> [Sig] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> GE E
unSig [Sig]
b1
    where f :: [E] -> E
f [E]
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"changed" [(Rate
Kr,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Kr))] [E]
a1

-- | 
-- k-rate signal change detector.
--
-- This opcode outputs a trigger signal that informs when any one
--         of its k-rate arguments has changed, or a value in an array. Useful with valuator widgets or MIDI controllers.
--
-- > ktrig  changed2  kvar1 [, kvar2,..., kvarN]
-- > ktrig  changed2  karr[]
-- > ktrig  changed2  aarr[]
--
-- csound doc: <http://csound.com/docs/manual/changed2.html>
changed2 ::  Sig -> Sig
changed2 :: Sig -> Sig
changed2 Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"changed2" [(Rate
Kr,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Kr)),(Rate
Kr,[Rate
Kr]),(Rate
Kr,[Rate
Ar])] [E
a1]

-- | 
-- Sense on-screen controls.
--
-- Sense on-screen controls. Requires Winsound or TCL/TK.
--
-- > kres  checkbox  knum
--
-- csound doc: <http://csound.com/docs/manual/checkbox.html>
checkbox ::  Sig -> Sig
checkbox :: Sig -> Sig
checkbox Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"checkbox" [(Rate
Kr,[Rate
Kr])] [E
a1]

-- | 
-- Configurable slider controls for realtime user input.
--
-- Configurable slider controls for realtime user input. Requires Winsound or TCL/TK. control reads a slider's value.
--
-- > kres  control  knum
--
-- csound doc: <http://csound.com/docs/manual/control.html>
control ::  Sig -> Sig
control :: Sig -> Sig
control Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"control" [(Rate
Kr,[Rate
Kr])] [E
a1]

-- | 
-- Envelope follower unit generator.
--
-- > ares  follow  asig, idt
--
-- csound doc: <http://csound.com/docs/manual/follow.html>
follow ::  Sig -> D -> Sig
follow :: Sig -> D -> Sig
follow Sig
b1 D
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"follow" [(Rate
Ar,[Rate
Ar,Rate
Ir])] [E
a1,E
a2]

-- | 
-- Another controllable envelope extractor.
--
-- A controllable envelope extractor using the algorithm attributed to Jean-Marc Jot.
--
-- > ares  follow2  asig, katt, krel
--
-- csound doc: <http://csound.com/docs/manual/follow2.html>
follow2 ::  Sig -> Sig -> Sig -> Sig
follow2 :: Sig -> Sig -> Sig -> Sig
follow2 Sig
b1 Sig
b2 Sig
b3 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E
f (E -> E -> E -> E) -> GE E -> GE (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) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2 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
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"follow2" [(Rate
Ar,[Rate
Ar,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3]

-- | 
-- Return Csound settings.
--
-- Return various configuration settings in Svalue as a string at init time.
--
-- > Svalue  getcfg  iopt
--
-- csound doc: <http://csound.com/docs/manual/getcfg.html>
getcfg ::  D -> Str
getcfg :: D -> Str
getcfg D
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
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
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"getcfg" [(Rate
Sr,[Rate
Ir])] [E
a1]

-- | 
-- Reads data from a joystick controller.
--
-- Reads data from a Linux joystick controller
--
-- > kres  joystick  kdevice ktab
--
-- csound doc: <http://csound.com/docs/manual/joystick.html>
joystick ::  Sig -> Tab -> Sig
joystick :: Sig -> Tab -> Sig
joystick Sig
b1 Tab
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
<$> Sig -> GE E
unSig Sig
b1 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
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"joystick" [(Rate
Kr,[Rate
Kr,Rate
Kr])] [E
a1,E
a2]

-- | 
-- Trigger Metronome
--
-- Generate a metronomic signal to be used in any circumstance an isochronous trigger is needed.
--
-- > ktrig   metro   kfreq [, initphase]
--
-- csound doc: <http://csound.com/docs/manual/metro.html>
metro ::  Sig -> Sig
metro :: Sig -> Sig
metro Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"metro" [(Rate
Kr,[Rate
Kr,Rate
Ir])] [E
a1]

-- | 
-- Returns the playback status of MIDI file input.
--
-- Returns the current playback status at k-rate, of the input MIDI file, 1 if file is playing, 0 if the end-of-the file
-- has been reached.
--
-- > ksig   midifilestatus 
--
-- csound doc: <http://csound.com/docs/manual/midifilestatus.html>
midifilestatus ::   Sig
midifilestatus :: Sig
midifilestatus  = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"midifilestatus" [(Rate
Kr,[])] []

-- | 
-- Returns the current tempo at k-rate, of either the MIDI file (if available) or the score
--
-- > ksig   miditempo 
--
-- csound doc: <http://csound.com/docs/manual/miditempo.html>
miditempo ::   Sig
miditempo :: Sig
miditempo  = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"miditempo" [(Rate
Kr,[])] []

-- | 
-- Reads data from a P5 Glove controller.
--
-- Opens and at control-rate polls a P5 Glove controller.
--
-- >  p5gconnect 
--
-- csound doc: <http://csound.com/docs/manual/p5gconnect.html>
p5gconnect ::   SE ()
p5gconnect :: SE ()
p5gconnect  = 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 -> 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
"p5gconnect" [(Rate
Xr,[])] []

-- | 
-- Reads data fields from an external P5 Glove.
--
-- Reads data fields from a P5 Glove controller.
--
-- > kres  p5gdata  kcontrol
--
-- csound doc: <http://csound.com/docs/manual/p5gdata.html>
p5gdata ::  Sig -> Sig
p5gdata :: Sig -> Sig
p5gdata Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"p5gdata" [(Rate
Kr,[Rate
Kr])] [E
a1]

-- | 
-- Returns the number of pfields belonging to a note event.
--
-- pcount returns the number of pfields belonging to a note event.
--
-- > icount  pcount 
--
-- csound doc: <http://csound.com/docs/manual/pcount.html>
pcount ::   D
pcount :: D
pcount  = GE E -> D
D (GE E -> D) -> GE E -> D
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
"pcount" [(Rate
Ir,[])] []

-- | 
-- Maintains the output equal to the highest absolute value received.
--
-- These opcodes maintain the output k-rate variable as the peak absolute level so far received.
--
-- > kres  peak  asig
-- > kres  peak  ksig
--
-- csound doc: <http://csound.com/docs/manual/peak.html>
peak ::  Sig -> Sig
peak :: Sig -> Sig
peak Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"peak" [(Rate
Kr,[Rate
Ar]),(Rate
Kr,[Rate
Kr])] [E
a1]

-- | 
-- Returns the value of a specified pfield.
--
-- pindex returns the value of a specified pfield.
--
-- > ivalue  pindex  ipfieldIndex
--
-- csound doc: <http://csound.com/docs/manual/pindex.html>
pindex ::  D -> D
pindex :: D -> D
pindex D
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
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
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"pindex" [(Rate
Ir,[Rate
Ir])] [E
a1]

-- | 
-- Tracks the pitch of a signal.
--
-- Using the same techniques as spectrum and specptrk, pitch tracks the pitch of the signal in octave point decimal form, and amplitude in dB.
--
-- > koct, kamp  pitch  asig, iupdte, ilo, ihi, idbthresh [, ifrqs] [, iconf] \
-- >           [, istrt] [, iocts] [, iq] [, inptls] [, irolloff] [, iskip]
--
-- csound doc: <http://csound.com/docs/manual/pitch.html>
pitch ::  Sig -> D -> D -> D -> D -> (Sig,Sig)
pitch :: Sig -> D -> D -> D -> D -> (Sig, Sig)
pitch Sig
b1 D
b2 D
b3 D
b4 D
b5 = GE (MultiOut [E]) -> (Sig, Sig)
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> (Sig, Sig))
-> GE (MultiOut [E]) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> MultiOut [E]
f (E -> E -> E -> E -> E -> MultiOut [E])
-> GE E -> GE (E -> E -> E -> E -> MultiOut [E])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E -> E -> E -> MultiOut [E])
-> GE E -> GE (E -> E -> E -> MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E -> E -> MultiOut [E])
-> GE E -> GE (E -> E -> MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3 GE (E -> E -> MultiOut [E]) -> GE E -> GE (E -> MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b4 GE (E -> MultiOut [E]) -> GE E -> GE (MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b5
    where f :: E -> E -> E -> E -> E -> MultiOut [E]
f E
a1 E
a2 E
a3 E
a4 E
a5 = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"pitch" ([Rate
Kr,Rate
Kr],[Rate
Ar,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,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]

-- | 
-- Follows the pitch of a signal based on the AMDF method.
--
-- Follows the pitch of a signal based on the AMDF method (Average Magnitude Difference Function). Outputs pitch and amplitude tracking signals. The method is quite fast and should run in realtime. This technique usually works best for monophonic signals.
--
-- > kcps, krms  pitchamdf  asig, imincps, imaxcps [, icps] [, imedi] \
-- >           [, idowns] [, iexcps] [, irmsmedi]
--
-- csound doc: <http://csound.com/docs/manual/pitchamdf.html>
pitchamdf ::  Sig -> D -> D -> (Sig,Sig)
pitchamdf :: Sig -> D -> D -> (Sig, Sig)
pitchamdf Sig
b1 D
b2 D
b3 = GE (MultiOut [E]) -> (Sig, Sig)
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> (Sig, Sig))
-> GE (MultiOut [E]) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> MultiOut [E]
f (E -> E -> E -> MultiOut [E])
-> GE E -> GE (E -> E -> MultiOut [E])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E -> MultiOut [E]) -> GE E -> GE (E -> MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> MultiOut [E]) -> GE E -> GE (MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3
    where f :: E -> E -> E -> MultiOut [E]
f E
a1 E
a2 E
a3 = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"pitchamdf" ([Rate
Kr,Rate
Kr],[Rate
Ar,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir]) [E
a1,E
a2,E
a3]

-- | 
-- Tracks the pitch of a signal.
--
-- plltrack, a pitch tracker based on a phase-locked loop algorithm, described in Zolzer, U, Sankarababu, S.V. and Moller, S, "PLL-based Pitch Detection and Tracking for Audio Signals. Proc. of IIH-MSP 2012".
--
-- > acps, alock  plltrack  asig, kd [, kloopf, kloopq, klf, khf, kthresh]
--
-- csound doc: <http://csound.com/docs/manual/plltrack.html>
plltrack ::  Sig -> Sig -> (Sig,Sig)
plltrack :: Sig -> Sig -> (Sig, Sig)
plltrack Sig
b1 Sig
b2 = GE (MultiOut [E]) -> (Sig, Sig)
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> (Sig, Sig))
-> GE (MultiOut [E]) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ E -> E -> MultiOut [E]
f (E -> E -> MultiOut [E]) -> GE E -> GE (E -> MultiOut [E])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> MultiOut [E]) -> GE E -> GE (MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2
    where f :: E -> E -> MultiOut [E]
f E
a1 E
a2 = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"plltrack" ([Rate
Ar,Rate
Ar],[Rate
Ar,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr]) [E
a1,E
a2]

-- | 
-- Tracks the pitch of a signal.
--
-- ptrack takes an input signal, splits it into ihopsize blocks and using a STFT method, extracts an estimated pitch for its fundamental frequency as well as estimating the total amplitude of the signal in dB, relative to full-scale (0dB). The method implies an analysis window size of 2*ihopsize samples (overlaping by 1/2 window), which has to be a power-of-two, between 128 and 8192 (hopsizes between 64 and 4096). Smaller windows will give better time precision, but worse frequency accuracy (esp. in low fundamentals).This opcode is based on an original algorithm by M. Puckette.
--
-- > kcps, kamp  ptrack  asig, ihopsize[,ipeaks]
--
-- csound doc: <http://csound.com/docs/manual/ptrack.html>
ptrack ::  Sig -> D -> (Sig,Sig)
ptrack :: Sig -> D -> (Sig, Sig)
ptrack Sig
b1 D
b2 = GE (MultiOut [E]) -> (Sig, Sig)
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> (Sig, Sig))
-> GE (MultiOut [E]) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ E -> E -> MultiOut [E]
f (E -> E -> MultiOut [E]) -> GE E -> GE (E -> MultiOut [E])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> MultiOut [E]) -> GE E -> GE (MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2
    where f :: E -> E -> MultiOut [E]
f E
a1 E
a2 = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"ptrack" ([Rate
Kr,Rate
Kr],[Rate
Ar,Rate
Ir,Rate
Ir]) [E
a1,E
a2]

-- | 
-- returns a value stored in the instance of an instrument.
--
-- The readscratch opcode returns one of four
--       scalar values stored in the instance of an instrument.
--
-- > ival  readscratch [index]
--
-- csound doc: <http://csound.com/docs/manual/readscratch.html>
readscratch ::   D
readscratch :: D
readscratch  = GE E -> D
D (GE E -> D) -> GE E -> D
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
"readscratch" [(Rate
Ir,[Rate
Ir])] []

-- | 
-- Rewinds the playback position of the current score performance.
--
-- Rewinds the playback position of the current score performance..
--
-- >   rewindscore 
--
-- csound doc: <http://csound.com/docs/manual/rewindscore.html>
rewindscore ::   SE ()
rewindscore :: SE ()
rewindscore  = 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 -> 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
"rewindscore" [(Rate
Xr,[])] []

-- | 
-- Determines the root-mean-square amplitude of an audio signal.
--
-- Determines the root-mean-square amplitude of an audio signal. It low-pass filters the actual value, to average in the manner of a VU meter.
--
-- > kres  rms  asig [, ihp] [, iskip]
--
-- csound doc: <http://csound.com/docs/manual/rms.html>
rms ::  Sig -> Sig
rms :: Sig -> Sig
rms Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"rms" [(Rate
Kr,[Rate
Ar,Rate
Ir,Rate
Ir])] [E
a1]

-- | 
-- Returns the ASCII code of a key that has been pressed.
--
-- Returns the ASCII code of a key that has been pressed, or -1 if no key has been pressed.
--
-- > kres[, kkeydown]  sensekey 
--
-- csound doc: <http://csound.com/docs/manual/sensekey.html>
sensekey :: Tuple a =>  a
sensekey :: a
sensekey  = GE (MultiOut [E]) -> a
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> a) -> GE (MultiOut [E]) -> a
forall a b. (a -> b) -> a -> b
$ MultiOut [E] -> GE (MultiOut [E])
forall (m :: * -> *) a. Monad m => a -> m a
return (MultiOut [E] -> GE (MultiOut [E]))
-> MultiOut [E] -> GE (MultiOut [E])
forall a b. (a -> b) -> a -> b
$ MultiOut [E]
f 
    where f :: MultiOut [E]
f  = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"sensekey" ([Rate
Kr,Rate
Kr],[]) []

-- | 
-- Generates a trigger signal according to the values stored in a table.
--
-- > ktrig_out  seqtime  ktime_unit, kstart, kloop, kinitndx, kfn_times
--
-- csound doc: <http://csound.com/docs/manual/seqtime.html>
seqtime ::  Sig -> Sig -> Sig -> Sig -> Tab -> Sig
seqtime :: Sig -> Sig -> Sig -> Sig -> Tab -> Sig
seqtime Sig
b1 Sig
b2 Sig
b3 Sig
b4 Tab
b5 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> E
f (E -> E -> E -> E -> E -> E) -> GE E -> GE (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) -> GE E -> GE (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) -> GE E -> GE (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) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b4 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
b5
    where f :: E -> E -> E -> E -> E -> E
f E
a1 E
a2 E
a3 E
a4 E
a5 = Name -> Spec1 -> [E] -> E
opcs Name
"seqtime" [(Rate
Kr,[Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3,E
a4,E
a5]

-- | 
-- Generates a trigger signal according to the values stored in a table.
--
-- > ktrig_out  seqtime2  ktrig_in, ktime_unit, kstart, kloop, kinitndx, kfn_times
--
-- csound doc: <http://csound.com/docs/manual/seqtime2.html>
seqtime2 ::  Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Sig
seqtime2 :: Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Sig
seqtime2 Sig
b1 Sig
b2 Sig
b3 Sig
b4 Sig
b5 Tab
b6 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> Sig -> GE E
unSig Sig
b4 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
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
"seqtime2" [(Rate
Kr,[Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3,E
a4,E
a5,E
a6]

-- | 
-- Configurable slider controls for realtime user input.
--
-- Configurable slider controls for realtime user input. Requires Winsound or TCL/TK. setctrl sets a slider to a specific value, or sets a minimum or maximum range.
--
-- >  setctrl  inum, ival, itype
--
-- csound doc: <http://csound.com/docs/manual/setctrl.html>
setctrl ::  D -> D -> D -> SE ()
setctrl :: D -> D -> D -> SE ()
setctrl D
b1 D
b2 D
b3 = 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
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"setctrl" [(Rate
Xr,[Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2,E
a3]

-- | 
-- Sets the playback position of the current score performance to a given position.
--
-- >   setscorepos  ipos
--
-- csound doc: <http://csound.com/docs/manual/setscorepos.html>
setscorepos ::  D -> SE ()
setscorepos :: D -> SE ()
setscorepos D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"setscorepos" [(Rate
Xr,[Rate
Ir])] [E
a1]

-- | 
-- Split a trigger signal
--
-- splitrig splits a trigger signal (i.e. a timed sequence of control-rate impulses) into several channels following a structure designed by the user.
--
-- >  splitrig  ktrig, kndx, imaxtics, ifn, kout1 [,kout2,...,koutN]
--
-- csound doc: <http://csound.com/docs/manual/splitrig.html>
splitrig ::  Sig -> Sig -> D -> Tab -> [Sig] -> SE ()
splitrig :: Sig -> Sig -> D -> Tab -> [Sig] -> SE ()
splitrig Sig
b1 Sig
b2 D
b3 Tab
b4 [Sig]
b5 = 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
f (E -> E -> E -> E -> [E] -> E)
-> GE E -> GE (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) -> GE E -> GE (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) -> GE E -> GE (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) -> GE E -> GE ([E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b4 GE ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Sig -> GE E) -> [Sig] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> GE E
unSig [Sig]
b5
    where f :: E -> E -> E -> E -> [E] -> E
f E
a1 E
a2 E
a3 E
a4 [E]
a5 = Name -> Spec1 -> [E] -> E
opcs Name
"splitrig" [(Rate
Xr,[Rate
Kr,Rate
Kr,Rate
Ir,Rate
Ir] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Kr))] ([E
a1
                                                                                  ,E
a2
                                                                                  ,E
a3
                                                                                  ,E
a4] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a5)

-- | 
-- Estimate the tempo of beat patterns in a control signal.
--
-- > ktemp  tempest  kin, iprd, imindur, imemdur, ihp, ithresh, ihtim, ixfdbak, \
-- >           istartempo, ifn [, idisprd] [, itweek]
--
-- csound doc: <http://csound.com/docs/manual/tempest.html>
tempest ::  Sig -> D -> D -> D -> D -> D -> D -> D -> D -> Tab -> Sig
tempest :: Sig -> D -> D -> D -> D -> D -> D -> D -> D -> Tab -> Sig
tempest Sig
b1 D
b2 D
b3 D
b4 D
b5 D
b6 D
b7 D
b8 D
b9 Tab
b10 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
<*> D -> GE E
unD D
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
<*> D -> GE E
unD D
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
<*> D -> GE E
unD D
b8 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
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
"tempest" [(Rate
Kr
                                                             ,[Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,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]

-- | 
-- Apply tempo control to an uninterpreted score.
--
-- >  tempo  ktempo, istartempo
--
-- csound doc: <http://csound.com/docs/manual/tempo.html>
tempo ::  Sig -> D -> SE ()
tempo :: Sig -> D -> SE ()
tempo Sig
b1 D
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 ()) -> 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
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"tempo" [(Rate
Xr,[Rate
Kr,Rate
Ir])] [E
a1,E
a2]

-- | 
-- Reads the current value of the tempo.
--
-- > kres  tempoval 
--
-- csound doc: <http://csound.com/docs/manual/tempoval.html>
tempoval ::   Sig
tempoval :: Sig
tempoval  = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"tempoval" [(Rate
Kr,[])] []

-- | 
-- Time Variant Sequencer
--
-- An event-sequencer in which time can be controlled by a
--     time-pointer. Sequence data are stored into a table.
--
-- > ktrig   timedseq   ktimpnt, ifn, kp1 [,kp2, kp3, ...,kpN]
--
-- csound doc: <http://csound.com/docs/manual/timedseq.html>
timedseq ::  Sig -> Tab -> [Sig] -> Sig
timedseq :: Sig -> Tab -> [Sig] -> Sig
timedseq Sig
b1 Tab
b2 [Sig]
b3 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> [E] -> E
f (E -> E -> [E] -> E) -> GE E -> GE (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) -> GE E -> GE ([E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2 GE ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Sig -> GE E) -> [Sig] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> GE E
unSig [Sig]
b3
    where f :: E -> E -> [E] -> E
f E
a1 E
a2 [E]
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"timedseq" [(Rate
Kr,[Rate
Kr,Rate
Ir] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Kr))] ([E
a1,E
a2] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a3)

-- | 
-- Informs when a krate signal crosses a threshold.
--
-- > kout  trigger  ksig, kthreshold, kmode
--
-- csound doc: <http://csound.com/docs/manual/trigger.html>
trigger ::  Sig -> Sig -> Sig -> Sig
trigger :: Sig -> Sig -> Sig -> Sig
trigger Sig
b1 Sig
b2 Sig
b3 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E
f (E -> E -> E -> E) -> GE E -> GE (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) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2 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
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"trigger" [(Rate
Kr,[Rate
Kr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3]

-- | 
-- Accepts a trigger signal as input and outputs a group of values.
--
-- >  trigseq  ktrig_in, kstart, kloop, kinitndx, kfn_values, kout1 [, kout2] [...]
--
-- csound doc: <http://csound.com/docs/manual/trigseq.html>
trigseq ::  Sig -> Sig -> Sig -> Sig -> Tab -> [Sig] -> SE ()
trigseq :: Sig -> Sig -> Sig -> Sig -> Tab -> [Sig] -> SE ()
trigseq Sig
b1 Sig
b2 Sig
b3 Sig
b4 Tab
b5 [Sig]
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
<*> Sig -> GE E
unSig Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> Sig -> GE E
unSig Sig
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
<*> (Sig -> GE E) -> [Sig] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> GE E
unSig [Sig]
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
"trigseq" [(Rate
Xr,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Kr))] ([E
a1,E
a2,E
a3,E
a4,E
a5] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a6)

-- | 
-- Envelope follower unit generator.
--
-- Envelope follower unit generator emmulating a Perkin Elmer
--       Vactrole VTL5C3/2.
--
-- > ares  vactrol  asig [iup, idown]
--
-- csound doc: <http://csound.com/docs/manual/vactrol.html>
vactrol ::  Sig -> Sig
vactrol :: Sig -> Sig
vactrol Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"vactrol" [(Rate
Ar,[Rate
Ar,Rate
Ir,Rate
Ir])] [E
a1]

-- | 
-- Reads data from a number of external Nintendo Wiimote controllers.
--
-- Opens and at control-rate polls up to four external Nintendo Wiimote controllers.
--
-- > ires  wiiconnect  [itimeout, imaxnum]
--
-- csound doc: <http://csound.com/docs/manual/wiiconnect.html>
wiiconnect ::   D
wiiconnect :: D
wiiconnect  = GE E -> D
D (GE E -> D) -> GE E -> D
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
"wiiconnect" [(Rate
Ir,[Rate
Ir,Rate
Ir])] []

-- | 
-- Reads data fields from a number of external Nintendo Wiimote controllers.
--
-- Reads data fields from upto four external Nintendo Wiimote controllers.
--
-- > kres  wiidata  kcontrol[, knum]
--
-- csound doc: <http://csound.com/docs/manual/wiidata.html>
wiidata ::  Sig -> Sig
wiidata :: Sig -> Sig
wiidata Sig
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"wiidata" [(Rate
Kr,[Rate
Kr,Rate
Kr])] [E
a1]

-- | 
-- Sets scaling and range limits for certain Wiimote fields.
--
-- >   wiirange  icontrol, iminimum, imaximum[, inum]
--
-- csound doc: <http://csound.com/docs/manual/wiirange.html>
wiirange ::  D -> D -> D -> SE ()
wiirange :: D -> D -> D -> SE ()
wiirange D
b1 D
b2 D
b3 = 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
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"wiirange" [(Rate
Xr,[Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2,E
a3]

-- | 
-- Sends data to one of a number of external Nintendo Wiimote controllers.
--
-- > kres  wiisend  kcontrol, kvalue[, knum]
--
-- csound doc: <http://csound.com/docs/manual/wiisend.html>
wiisend ::  Sig -> Sig -> Sig
wiisend :: Sig -> Sig -> Sig
wiisend Sig
b1 Sig
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
<$> Sig -> GE E
unSig Sig
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
"wiisend" [(Rate
Kr,[Rate
Kr,Rate
Kr,Rate
Kr])] [E
a1,E
a2]

-- | 
-- writes a value into the scratchpad of the instance of an instrument.
--
-- The writescratch opcode writes one of four
--       scalar values to be stored in the instance of an instrument.
--
-- >  writescratch ival[, index]
--
-- csound doc: <http://csound.com/docs/manual/writescratch.html>
writescratch ::  D -> SE ()
writescratch :: D -> SE ()
writescratch D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"writescratch" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1]

-- | 
-- Sense the cursor position in an output window
--
-- Sense the cursor position in an output window. When xyin is called the position of the mouse within the output window is used to reply to the request.  This simple mechanism does mean that only one xyin can be used accurately at once.  The position of the mouse is reported in the output window.
--
-- > kx, ky  xyin  iprd, ixmin, ixmax, iymin, iymax [, ixinit] [, iyinit]
--
-- csound doc: <http://csound.com/docs/manual/xyin.html>
xyin ::  D -> D -> D -> D -> D -> (Sig,Sig)
xyin :: D -> D -> D -> D -> D -> (Sig, Sig)
xyin D
b1 D
b2 D
b3 D
b4 D
b5 = GE (MultiOut [E]) -> (Sig, Sig)
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> (Sig, Sig))
-> GE (MultiOut [E]) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> MultiOut [E]
f (E -> E -> E -> E -> E -> MultiOut [E])
-> GE E -> GE (E -> E -> E -> E -> MultiOut [E])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E -> E -> E -> MultiOut [E])
-> GE E -> GE (E -> E -> E -> MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E -> E -> MultiOut [E])
-> GE E -> GE (E -> E -> MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3 GE (E -> E -> MultiOut [E]) -> GE E -> GE (E -> MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b4 GE (E -> MultiOut [E]) -> GE E -> GE (MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b5
    where f :: E -> E -> E -> E -> E -> MultiOut [E]
f E
a1 E
a2 E
a3 E
a4 E
a5 = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"xyin" ([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]

-- Stacks.

-- | 
-- Pops values from the global stack.  Deprecated.
--
-- Pops values from the global stack.
--
-- > xval1, [xval2, ... , xval31]  pop 
-- > ival1, [ival2, ... , ival31]  pop 
--
-- csound doc: <http://csound.com/docs/manual/pop.html>
pop :: Tuple a =>  a
pop :: a
pop  = GE (MultiOut [E]) -> a
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> a) -> GE (MultiOut [E]) -> a
forall a b. (a -> b) -> a -> b
$ MultiOut [E] -> GE (MultiOut [E])
forall (m :: * -> *) a. Monad m => a -> m a
return (MultiOut [E] -> GE (MultiOut [E]))
-> MultiOut [E] -> GE (MultiOut [E])
forall a b. (a -> b) -> a -> b
$ MultiOut [E]
f 
    where f :: MultiOut [E]
f  = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"pop" ((Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir),[]) []

-- | 
-- Pops an f-sig frame from the global stack.  Deprecated.
--
-- Pops an f-sig frame from the global stack.
--
-- > fsig  pop_f 
--
-- csound doc: <http://csound.com/docs/manual/pop_f.html>
pop_f ::   Spec
pop_f :: Spec
pop_f  = GE E -> Spec
Spec (GE E -> Spec) -> GE E -> Spec
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
"pop_f" [(Rate
Fr,[])] []

-- | 
-- Pushes a value into the global stack.  Deprecated.
--
-- Pushes a value into the global stack.
--
-- >  push   xval1, [xval2, ... , xval31]
-- >  push   ival1, [ival2, ... , ival31]
--
-- csound doc: <http://csound.com/docs/manual/push.html>
push ::  [Sig] -> SE ()
push :: [Sig] -> SE ()
push [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 ()) -> 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
f ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sig -> GE E) -> [Sig] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> GE E
unSig [Sig]
b1
    where f :: [E] -> E
f [E]
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"push" [(Rate
Xr,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Xr))] [E]
a1

-- | 
-- Pushes an f-sig frame into the global stack.  Deprecated.
--
-- Pushes an f-sig frame into the global stack.
--
-- >  push_f   fsig
--
-- csound doc: <http://csound.com/docs/manual/push_f.html>
push_f ::  Spec -> SE ()
push_f :: Spec -> SE ()
push_f Spec
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Spec -> GE E
unSpec Spec
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"push_f" [(Rate
Xr,[Rate
Fr])] [E
a1]

-- | 
-- Initializes the stack.  Deprecated.
--
-- Initializes and sets the size of the global stack.
--
-- >  stack   iStackSize
--
-- csound doc: <http://csound.com/docs/manual/stack.html>
stack ::  D -> SE ()
stack :: D -> SE ()
stack D
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 ()) -> 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
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"stack" [(Rate
Xr,[Rate
Ir])] [E
a1]

-- Subinstrument Control.

-- | 
-- Creates and runs a numbered instrument instance.
--
-- Creates an instance of another instrument and is used as if it were an opcode.
--
-- > a1, [...] [, a8]  subinstr  instrnum [, p4] [, p5] [...]
-- > a1, [...] [, a8]  subinstr  "insname" [, p4] [, p5] [...]
--
-- csound doc: <http://csound.com/docs/manual/subinstr.html>
subinstr :: Tuple a => D -> [D] -> a
subinstr :: D -> [D] -> a
subinstr D
b1 [D]
b2 = GE (MultiOut [E]) -> a
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> a) -> GE (MultiOut [E]) -> a
forall a b. (a -> b) -> a -> b
$ E -> [E] -> MultiOut [E]
f (E -> [E] -> MultiOut [E]) -> GE E -> GE ([E] -> MultiOut [E])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE ([E] -> MultiOut [E]) -> GE [E] -> GE (MultiOut [E])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (D -> GE E) -> [D] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM D -> GE E
unD [D]
b2
    where f :: E -> [E] -> MultiOut [E]
f E
a1 [E]
a2 = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"subinstr" ((Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ar),[Rate
Sr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir)) ([E
a1] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a2)

-- | 
-- Creates and runs a numbered instrument instance at init-time.
--
-- Same as subinstr, but init-time only and has no output arguments.
--
-- >  subinstrinit  instrnum [, p4] [, p5] [...]
-- >  subinstrinit  "insname" [, p4] [, p5] [...]
--
-- csound doc: <http://csound.com/docs/manual/subinstrinit.html>
subinstrinit ::  D -> [D] -> SE ()
subinstrinit :: D -> [D] -> SE ()
subinstrinit D
b1 [D]
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 ()) -> 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
f (E -> [E] -> E) -> GE E -> GE ([E] -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (D -> GE E) -> [D] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM D -> GE E
unD [D]
b2
    where f :: E -> [E] -> E
f E
a1 [E]
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"subinstrinit" [(Rate
Xr,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] ([E
a1] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a2)

-- Time Reading.

-- | 
-- Returns the number seconds since a base date.
--
-- Returns the number seconds since a base date, using the
--       operating system's clock.  The base is 1 January 1970 for Csound
--       using doubles, and 1 January 2010 for versions using floats.
--       On operating systemms with sufficient resolution the date
--       includes fractional seconds.
--
-- > ir[, inano]  date 
-- > kr[, knano]  date 
--
-- csound doc: <http://csound.com/docs/manual/date.html>
date :: Tuple a =>  a
date :: a
date  = GE (MultiOut [E]) -> a
forall a. Tuple a => GE (MultiOut [E]) -> a
pureTuple (GE (MultiOut [E]) -> a) -> GE (MultiOut [E]) -> a
forall a b. (a -> b) -> a -> b
$ MultiOut [E] -> GE (MultiOut [E])
forall (m :: * -> *) a. Monad m => a -> m a
return (MultiOut [E] -> GE (MultiOut [E]))
-> MultiOut [E] -> GE (MultiOut [E])
forall a b. (a -> b) -> a -> b
$ MultiOut [E]
f 
    where f :: MultiOut [E]
f  = Name -> Specs -> [E] -> MultiOut [E]
mopcs Name
"date" ([Rate
Kr,Rate
Kr],[]) []

-- | 
-- Returns as a string the date and time specified.
--
-- > Sir  dates  [ itime]
--
-- csound doc: <http://csound.com/docs/manual/dates.html>
dates ::   Str
dates :: Str
dates  = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
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
"dates" [(Rate
Sr,[Rate
Ir])] []

-- | 
-- Reads the value of an internal clock.
--
-- > ir  readclock  inum
--
-- csound doc: <http://csound.com/docs/manual/readclock.html>
readclock ::  D -> D
readclock :: D -> D
readclock D
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
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
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"readclock" [(Rate
Ir,[Rate
Ir])] [E
a1]

-- | 
-- Read the real time clock from the operating system.
--
-- Read the real-time clock from the operating system.
--
-- > ires  rtclock 
-- > kres  rtclock 
--
-- csound doc: <http://csound.com/docs/manual/rtclock.html>
rtclock ::   Sig
rtclock :: Sig
rtclock  = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"rtclock" [(Rate
Ir,[]),(Rate
Kr,[])] []

-- | 
-- Read absolute time in k-rate cycles.
--
-- Read absolute time, in k-rate cycles, since the start of an
--     	instance of an instrument. Called at both i-time as well as
--     	k-time.
--
-- > kres  timeinstk 
--
-- csound doc: <http://csound.com/docs/manual/timeinstk.html>
timeinstk ::   Sig
timeinstk :: Sig
timeinstk  = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"timeinstk" [(Rate
Kr,[])] []

-- | 
-- Read absolute time in seconds.
--
-- Read absolute time, in seconds, since the start of an instance of an instrument.
--
-- > kres  timeinsts 
--
-- csound doc: <http://csound.com/docs/manual/timeinsts.html>
timeinsts ::   Sig
timeinsts :: Sig
timeinsts  = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
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
"timeinsts" [(Rate
Kr,[])] []

-- | 
-- Read absolute time in k-rate cycles.
--
-- Read absolute time, in k-rate cycles, since the start of the performance.
--
-- > ires  timek 
-- > kres  timek 
--
-- csound doc: <http://csound.com/docs/manual/timek.html>
timek ::   SE Sig
timek :: SE Sig
timek  = (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
$ DepT GE E -> SE E
forall a. Dep a -> SE a
SE (DepT GE E -> SE E) -> DepT GE E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> DepT GE E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> DepT GE E) -> DepT GE E -> DepT GE E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> DepT GE E) -> DepT GE E -> DepT GE E
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 -> 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
"timek" [(Rate
Ir,[]),(Rate
Kr,[])] []

-- | 
-- Read absolute time in seconds.
--
-- Read absolute time, in seconds, since the start of the performance.
--
-- > ires  times 
-- > kres  times 
--
-- csound doc: <http://csound.com/docs/manual/times.html>
times ::   SE Sig
times :: SE Sig
times  = (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
$ DepT GE E -> SE E
forall a. Dep a -> SE a
SE (DepT GE E -> SE E) -> DepT GE E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> DepT GE E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> DepT GE E) -> DepT GE E -> DepT GE E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> DepT GE E) -> DepT GE E -> DepT GE E
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 -> 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
"times" [(Rate
Ir,[]),(Rate
Kr,[])] []