{-# Language TypeFamilies, FlexibleContexts, FlexibleInstances, ScopedTypeVariables #-}
-- | We can convert notes to sound signals with instruments.
-- An instrument is a function:
--
-- > (Arg a, Sigs b) => a -> SE b
--
-- It takes a tuple of primitive Csound values (number, string or array) and converts
-- it to the tuple of signals and it makes some side effects along the way so
-- the output is wrapped in the 'Csound.Base.SE'-monad.
--
-- There are only three ways of making a sound with an instrument:
--
-- * Suplpy an instrument with notes (@Mix@-section).
--
-- * Trigger an instrument with event stream (@Evt@-section).
--
-- * By using midi-instruments (see @Csound.Control.Midi@).
--
-- Sometimes we don't want to produce any sound. Our instrument is just
-- a procedure that makes something useful without being noisy about it.
-- It's type is:
--
-- > (Arg a) => a -> SE ()
--
-- To invoke the procedures there are functions with trailing underscore.
-- For example we have the function @trig@ to convert event stream to sound:
--
-- > trig :: (Arg a, Sigs b) => (a -> SE b) -> Evts (D, D, a) -> b
--
-- and we have a @trig@ with underscore to convert the event stream to
-- the sequence of the procedure invkations:
--
-- > trig_ :: (Arg a) => (a -> SE ()) -> Evts (D, D, a) -> SE ()
--
-- To invoke instruments from another instrumetnts we use artificial closures
-- made with functions with trailing xxxBy. For example:
--
-- > trigBy :: (Arg a, Arg c, Sigs b) => (a -> SE b) -> (c -> Evts (D, D, a)) -> (c -> b)
--
-- Notice that the event stream depends on the argument of the type c. Here goes
-- all the parameters that we want to pass from the outer instrument. Unfortunately
-- we can not just create the closure, because our values are not the real values.
-- It's a text of the programm (a tiny snippet of it) to be executed. For a time being
-- I don't know how to make it better. So we need to pass the values explicitly.
--
-- For example, if we want to make an arpeggiator:
--
-- > pureTone :: D -> SE Sig
-- > pureTone cps = return $ mul env $ osc $ sig cps
-- >    where env = linseg [0, 0.01, 1, 0.25, 0]
-- >
-- > majArpeggio :: D -> SE Sig
-- > majArpeggio = return . schedBy pureTone evts
-- >     where evts cps = withDur 0.5 $ fmap (* cps) $ cycleE [1, 5/3, 3/2, 2] $ metroE 5
-- >
-- > main = dac $ mul 0.5 $ midi $ onMsg majArpeggio
--
-- We should use 'Csound.Base.schedBy' to pass the frequency as a parameter to the event stream.
module Csound.Control.Instr(
    -- * Mix
    -- | We can invoke instrument with specified notes.
    -- Eqch note happens at some time and lasts for some time. It contains
    -- the argument for the instrument.
    --
    -- We can invoke the instrument on the sequence of notes (@sco@), process
    -- the sequence of notes with an effect (@eff@) and convert everything in
    -- the plain sound signals (to send it to speakers or write to file or
    -- use it in some another instrument).
    --
    -- The sequence of notes is represented with type class @CsdSco@. Wich
    -- has a very simple methods. So you can use your own favorite library
    -- to describe the list of notes. If your type supports the scaling in
    -- the time domain (stretching the timeline) you can do it in the Mix-version
    -- (after the invokation of the instrument). All notes are rescaled all the
    -- way down the Score-structure.
    Sco, Mix, sco, mix, eff, monoSco,
    mixLoop, sco_, mix_, mixLoop_, mixBy,
    infiniteDur,

    module Temporal.Media,

    -- * Evt

    sched, retrig, schedHarp, schedUntil, schedToggle,
    sched_, schedUntil_,
    schedBy, schedHarpBy,
    schedStream,
    withDur, monoSched,

    -- * Api
    -- | We can create named instruments. then we can trigger the named instruments with Csound API.
    -- Csound can be used not as a text to audio converter but also as a shared C-library. There are
    -- many bindings to many languages. For example we can use Python or Android SDK to create UI
    -- and under the hood we can use the audio engine created with Haskell. The concept of named instruments
    -- is the bridge for other lnguages to use our haskell-generated code.
    trigByName, trigByName_,
    trigByNameMidi, trigByNameMidi_,
    turnoffByName,

    -- ** Misc
    alwaysOn, playWhen,

    -- * Overload
    -- | Converters to make it easier a construction of the instruments.
    Outs(..), onArg, AmpInstr(..), CpsInstr(..),

    -- * Imperative instruments
    InstrRef, newInstr, scheduleEvent, turnoff2, negateInstrRef, addFracInstrRef,
    newOutInstr, noteOn, noteOff
) where

import Control.Monad.Trans.Class
import Csound.Dynamic hiding (str, Sco(..), when1, alwaysOn)

import Csound.Typed
import Csound.Typed.Opcode hiding (initc7, metro)
import Csound.Control.Overload
import Temporal.Media(Event(..), mapEvents, temp, str, dur)

import Csound.Control.Evt(metro, repeatE, splitToggle, loadbang)

-- | Mixes the scores and plays them in the loop.
mixLoop :: (Sigs a) => Sco (Mix a) -> a
mixLoop :: Sco (Mix a) -> a
mixLoop Sco (Mix a)
a = (Unit -> SE a) -> Evt (Sco Unit) -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched Unit -> SE a
instr (Evt (Sco Unit) -> a) -> Evt (Sco Unit) -> a
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit -> Evt (Sco Unit)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
DurOf (Sco (Mix a))
dt (Evt Unit -> Evt (Sco Unit)) -> Evt Unit -> Evt (Sco Unit)
forall a b. (a -> b) -> a -> b
$ Unit -> Evt Unit -> Evt Unit
forall a b. Tuple a => a -> Evt b -> Evt a
repeatE Unit
unit (Evt Unit -> Evt Unit) -> Evt Unit -> Evt Unit
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit
metro (Sig -> Evt Unit) -> Sig -> Evt Unit
forall a b. (a -> b) -> a -> b
$ Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
DurOf (Sco (Mix a))
dt
    where
        dt :: DurOf (Sco (Mix a))
dt = Sco (Mix a) -> DurOf (Sco (Mix a))
forall a. Duration a => a -> DurOf a
dur Sco (Mix a)
a
        instr :: Unit -> SE a
instr Unit
_ = a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ Sco (Mix a) -> a
forall a. Sigs a => Sco (Mix a) -> a
mix Sco (Mix a)
a

-- | Mixes the procedures and plays them in the loop.
mixLoop_ :: Sco (Mix Unit) -> SE ()
mixLoop_ :: Sco (Mix Unit) -> SE ()
mixLoop_ Sco (Mix Unit)
a = (Unit -> SE ()) -> Evt (Sco Unit) -> SE ()
forall a. Arg a => (a -> SE ()) -> Evt (Sco a) -> SE ()
sched_ Unit -> SE ()
instr (Evt (Sco Unit) -> SE ()) -> Evt (Sco Unit) -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit -> Evt (Sco Unit)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
DurOf (Sco (Mix Unit))
dt (Evt Unit -> Evt (Sco Unit)) -> Evt Unit -> Evt (Sco Unit)
forall a b. (a -> b) -> a -> b
$ Unit -> Evt Unit -> Evt Unit
forall a b. Tuple a => a -> Evt b -> Evt a
repeatE Unit
unit (Evt Unit -> Evt Unit) -> Evt Unit -> Evt Unit
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit
metro (Sig -> Evt Unit) -> Sig -> Evt Unit
forall a b. (a -> b) -> a -> b
$ Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
DurOf (Sco (Mix Unit))
dt
    where
        dt :: DurOf (Sco (Mix Unit))
dt = Sco (Mix Unit) -> DurOf (Sco (Mix Unit))
forall a. Duration a => a -> DurOf a
dur Sco (Mix Unit)
a
        instr :: Unit -> SE ()
instr Unit
_ = Sco (Mix Unit) -> SE ()
mix_ Sco (Mix Unit)
a


-- | Invokes an instrument with first event stream and
-- holds the note until the second event stream is active.
schedUntil :: (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b
schedUntil :: (a -> SE b) -> Evt a -> Evt c -> b
schedUntil a -> SE b
instr Evt a
onEvt Evt c
offEvt = (a -> SE b) -> Evt (Sco a) -> b
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched a -> SE b
instr' (Evt (Sco a) -> b) -> Evt (Sco a) -> b
forall a b. (a -> b) -> a -> b
$ Sig -> Evt a -> Evt (Sco a)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
forall a. Num a => a
infiniteDur Evt a
onEvt
    where
        instr' :: a -> SE b
instr' a
x = do
            b
res <- a -> SE b
instr a
x
            Evt c -> Bam c -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt c
offEvt (Bam c -> SE ()) -> Bam c -> SE ()
forall a b. (a -> b) -> a -> b
$ SE () -> Bam c
forall a b. a -> b -> a
const (SE () -> Bam c) -> SE () -> Bam c
forall a b. (a -> b) -> a -> b
$ SE ()
turnoff
            b -> SE b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res

-- | Invokes an instrument with toggle event stream (1 stands for on and 0 stands for off).
schedToggle :: (Sigs b) => SE b -> Evt D -> b
schedToggle :: SE b -> Evt D -> b
schedToggle SE b
res Evt D
evt = (D -> SE b) -> Evt D -> Evt D -> b
forall a b c. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b
schedUntil D -> SE b
instr Evt D
ons Evt D
offs
    where
        instr :: D -> SE b
instr = SE b -> D -> SE b
forall a b. a -> b -> a
const SE b
res
        (Evt D
ons, Evt D
offs) = Evt D -> (Evt D, Evt D)
splitToggle Evt D
evt

-- | Invokes an instrument with first event stream and
-- holds the note until the second event stream is active.
schedUntil_ :: (Arg a) => (a -> SE ()) -> Evt a -> Evt c -> SE ()
schedUntil_ :: (a -> SE ()) -> Evt a -> Evt c -> SE ()
schedUntil_ a -> SE ()
instr Evt a
onEvt Evt c
offEvt = (a -> SE ()) -> Evt (Sco a) -> SE ()
forall a. Arg a => (a -> SE ()) -> Evt (Sco a) -> SE ()
sched_ a -> SE ()
instr' (Evt (Sco a) -> SE ()) -> Evt (Sco a) -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig -> Evt a -> Evt (Sco a)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
forall a. Num a => a
infiniteDur Evt a
onEvt
    where
        instr' :: a -> SE ()
instr' a
x = do
            ()
res <- a -> SE ()
instr a
x
            Evt c -> Bam c -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt c
offEvt (Bam c -> SE ()) -> Bam c -> SE ()
forall a b. (a -> b) -> a -> b
$ SE () -> Bam c
forall a b. a -> b -> a
const (SE () -> Bam c) -> SE () -> Bam c
forall a b. (a -> b) -> a -> b
$ SE ()
turnoff
            () -> SE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
res

-- | Transforms an instrument from always on to conditional one.
-- The routput instrument plays only when condition is true otherwise
-- it produces silence.
playWhen :: forall a b. Sigs a => BoolSig -> (b -> SE a) -> (b -> SE a)
playWhen :: BoolSig -> (b -> SE a) -> b -> SE a
playWhen BoolSig
onSig b -> SE a
instr b
msg = do
    Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef (a
0 :: a)
    Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
0
    BoolSig -> SE () -> SE ()
when1 BoolSig
onSig (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref (a -> SE ()) -> SE a -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> SE a
instr b
msg
    Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref


-- | Plays infinite notes for a given instrument with event stream.
-- It allows for note overlap on release. We can specify release time on seconds
-- in the first argument.
--
-- > schedStream releaseTime instr evt
schedStream :: (Arg a, Sigs b) => D -> D -> (a -> SE b) -> Evt a -> SE b
schedStream :: D -> D -> (a -> SE b) -> Evt a -> SE b
schedStream D
start D
rel a -> SE b
ins Evt a
evt = do
  (InstrRef a
insId, b
res) <- (a -> SE b) -> SE (InstrRef a, b)
forall a b. (Arg a, Sigs b) => (a -> SE b) -> SE (InstrRef a, b)
newOutInstr a -> SE b
ins
  Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    InstrRef a -> D -> D -> Bam a
forall a. Arg a => InstrRef a -> D -> D -> a -> SE ()
scheduleEvent (InstrRef a -> InstrRef a
forall a. InstrRef a -> InstrRef a
negateInstrRef InstrRef a
insId) D
0 D
rel a
x
    InstrRef a -> D -> D -> Bam a
forall a. Arg a => InstrRef a -> D -> D -> a -> SE ()
scheduleEvent InstrRef a
insId D
start (-D
1) a
x
  b -> SE b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res

-------------------------------------------------------------------------
-------------------------------------------------------------------------
-- singular

-- | Sets the same duration for all events. It's useful with the functions @sched@, @schedBy@, @sched_@.
withDur :: Sig -> Evt a -> Evt (Sco a)
withDur :: Sig -> Evt a -> Evt (Sco a)
withDur Sig
dt = (a -> Sco a) -> Evt a -> Evt (Sco a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DurOf (Sco a) -> Sco a -> Sco a
forall a. Stretch a => DurOf a -> a -> a
str Sig
DurOf (Sco a)
dt (Sco a -> Sco a) -> (a -> Sco a) -> a -> Sco a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sco a
forall t a. Num t => a -> Track t a
temp)

retrig :: (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b
retrig :: (a -> SE b) -> Evt a -> b
retrig a -> SE b
f = (a -> SE b) -> Evt [a] -> b
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt [a] -> b
retrigs a -> SE b
f (Evt [a] -> b) -> (Evt a -> Evt [a]) -> Evt a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a]) -> Evt a -> Evt [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Executes some procedure for the whole lifespan of the program,
alwaysOn :: SE () -> SE ()
alwaysOn :: SE () -> SE ()
alwaysOn SE ()
proc = (Unit -> SE ()) -> Evt (Sco Unit) -> SE ()
forall a. Arg a => (a -> SE ()) -> Evt (Sco a) -> SE ()
sched_ (SE () -> Unit -> SE ()
forall a b. a -> b -> a
const (SE () -> Unit -> SE ()) -> SE () -> Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ SE ()
proc) (Evt (Sco Unit) -> SE ()) -> Evt (Sco Unit) -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit -> Evt (Sco Unit)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur (Sig
forall a. Num a => a
infiniteDur) (Evt Unit -> Evt (Sco Unit)) -> Evt Unit -> Evt (Sco Unit)
forall a b. (a -> b) -> a -> b
$ Evt Unit
loadbang

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

-- | Turns off named instruments.
--
-- > turnoffNamedInstr name kmode krelease
--
-- name of the instrument (should be defined with @trigByName@ or smth like that).
--
-- kmode -- sum of the following values:
--
-- 0, 1, or 2: turn off all instances (0), oldest only (1), or newest only (2)
--
-- 4: only turn off notes with exactly matching (fractional) instrument number, rather than ignoring fractional part
--
-- 8: only turn off notes with indefinite duration (p3 < 0 or MIDI)
--
-- krelease -- if non-zero, the turned off instances are allowed to release, otherwise are deactivated immediately (possibly resulting in clicks)
turnoffByName :: String -> Sig -> Sig -> SE ()
turnoffByName :: String -> Sig -> Sig -> SE ()
turnoffByName String
name Sig
kmode Sig
krelease = Str -> Sig -> Sig -> SE ()
strTurnoff2 (String -> Str
text String
name) Sig
kmode Sig
krelease

strTurnoff2 ::  Str -> Sig -> Sig -> SE ()
strTurnoff2 :: Str -> Sig -> Sig -> SE ()
strTurnoff2 Str
b1 Sig
b2 Sig
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
<$> Str -> GE E
unStr Str
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 = String -> Spec1 -> [E] -> E
opcs String
"turnoff2" [(Rate
Xr,[Rate
Sr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3]