-- | Imperative csound instruments
module Csound.Typed.Control.InstrRef(
    InstrRef, newInstr, scheduleEvent, turnoff2, negateInstrRef, addFracInstrRef,
    newOutInstr, noteOn, noteOff
) where

import Control.Monad
import Control.Monad.Trans.Class

import Data.Default
import Csound.Dynamic(InstrId(..), Rate(..), DepT, depT_, opcs)
import qualified Csound.Typed.GlobalState.Elements as C

import Csound.Typed.Types
import Csound.Typed.GlobalState hiding (turnoff2)
import Csound.Typed.Control.Ref

-- | Fractional part of the instrument dentifier.
data InstrFrac = InstrFrac
    { InstrFrac -> D
_instrFracValue :: D
    , InstrFrac -> D
_instrFracSize  :: D
    }

-- | Instrument reference. we can invoke or stop the instrument by the identifier.
data InstrRef a = InstrRef
    { forall a. InstrRef a -> D
instrRefMain :: D
    , forall a. InstrRef a -> Maybe InstrFrac
instrRefFrac :: Maybe InstrFrac }

-- | Creates a new instrument and generates a unique identifier.
newInstr ::  (Arg a) => (a -> SE ()) -> SE (InstrRef a)
newInstr :: forall a. Arg a => (a -> SE ()) -> SE (InstrRef a)
newInstr a -> SE ()
instr = GE (InstrRef a) -> SE (InstrRef a)
forall a. GE a -> SE a
geToSe (GE (InstrRef a) -> SE (InstrRef a))
-> GE (InstrRef a) -> SE (InstrRef a)
forall a b. (a -> b) -> a -> b
$ (InstrId -> InstrRef a) -> GE InstrId -> GE (InstrRef a)
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InstrId -> InstrRef a
forall a. InstrId -> InstrRef a
fromInstrId (GE InstrId -> GE (InstrRef a)) -> GE InstrId -> GE (InstrRef a)
forall a b. (a -> b) -> a -> b
$ SE () -> GE InstrId
saveInstr (SE () -> GE InstrId) -> SE () -> GE InstrId
forall a b. (a -> b) -> a -> b
$ a -> SE ()
instr a
forall a. Arg a => a
toArg

-- | Schedules an event for the instrument.
--
-- > scheduleEvent instrRef delay duration args
--
-- The arguments for time values are set in seconds.
scheduleEvent :: (Arg a) => InstrRef a -> D -> D -> a -> SE ()
scheduleEvent :: forall a. Arg a => InstrRef a -> D -> D -> a -> SE ()
scheduleEvent InstrRef a
instrRef D
start D
end a
args = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (Event -> Dep ()) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
C.event (GE Event -> GE (Dep ())) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> [E] -> Event
C.Event (E -> E -> E -> [E] -> Event)
-> GE E -> GE (E -> E -> [E] -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
forall a. Val a => a -> GE E
toGE (InstrRef a -> D
forall a. InstrRef a -> D
getInstrId InstrRef a
instrRef) GE (E -> E -> [E] -> Event) -> GE E -> GE (E -> [E] -> Event)
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
forall a. Val a => a -> GE E
toGE D
start GE (E -> [E] -> Event) -> GE E -> GE ([E] -> Event)
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
forall a. Val a => a -> GE E
toGE D
end GE ([E] -> Event) -> GE [E] -> GE Event
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> GE [E]
forall a. Arg a => a -> GE [E]
toNote a
args

getInstrId :: InstrRef a -> D
getInstrId :: forall a. InstrRef a -> D
getInstrId (InstrRef D
value Maybe InstrFrac
frac) = D
value D -> D -> D
forall a. Num a => a -> a -> a
+ D -> (InstrFrac -> D) -> Maybe InstrFrac -> D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe D
0 InstrFrac -> D
fromFrac Maybe InstrFrac
frac
    where
        fromFrac :: InstrFrac -> D
fromFrac (InstrFrac D
val D
size) = (D
val D -> D -> D
forall a. Num a => a -> a -> a
* D
10 D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) D -> D -> D
forall a. Fractional a => a -> a -> a
/ (D
size D -> D -> D
forall a. Num a => a -> a -> a
* D
10)

-- | Negates the instrument identifier. This trick is used in Csound to update the instrument arguments while instrument is working.
negateInstrRef :: InstrRef a -> InstrRef a
negateInstrRef :: forall a. InstrRef a -> InstrRef a
negateInstrRef InstrRef a
ref = InstrRef a
ref { instrRefMain = negate $ instrRefMain ref }

-- | Adds fractional part to the instrument reference. This trick is used in Csound to identify the notes (or specific instrument invokation).
addFracInstrRef :: D -> D -> InstrRef a -> InstrRef a
addFracInstrRef :: forall a. D -> D -> InstrRef a -> InstrRef a
addFracInstrRef D
maxSize D
value InstrRef a
instrRef = InstrRef a
instrRef { instrRefFrac = Just (InstrFrac value maxSize) }

fromInstrId :: InstrId -> InstrRef a
fromInstrId :: forall a. InstrId -> InstrRef a
fromInstrId InstrId
x = case InstrId
x of
    InstrId Maybe Int
_frac Int
ceil -> D -> Maybe InstrFrac -> InstrRef a
forall a. D -> Maybe InstrFrac -> InstrRef a
InstrRef (Int -> D
int Int
ceil) Maybe InstrFrac
forall a. Maybe a
Nothing
    InstrLabel Text
_       -> [Char] -> InstrRef a
forall a. HasCallStack => [Char] -> a
error [Char]
"No reference for string instrument id. (Csound.Typed.Control.Instr.hs: fromInstrId)"

-- | Creates an insturment that produces a value.
newOutInstr :: (Arg a, Sigs b) => (a -> SE b) -> SE (InstrRef a, b)
newOutInstr :: forall a b. (Arg a, Sigs b) => (a -> SE b) -> SE (InstrRef a, b)
newOutInstr a -> SE b
f = do
    Ref b
ref <- b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newClearableGlobalRef b
0
    InstrRef a
instrId <- (a -> SE ()) -> SE (InstrRef a)
forall a. Arg a => (a -> SE ()) -> SE (InstrRef a)
newInstr ((a -> SE ()) -> SE (InstrRef a))
-> (a -> SE ()) -> SE (InstrRef a)
forall a b. (a -> b) -> a -> b
$ \a
a -> Ref b -> b -> SE ()
forall a. (Num a, Tuple a) => Ref a -> a -> SE ()
mixRef Ref b
ref (b -> SE ()) -> SE b -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> SE b
f a
a
    b
aout <- Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
ref
    (InstrRef a, b) -> SE (InstrRef a, b)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrRef a
instrId, b
aout)

-- | Triggers a note with fractional instrument reference. We can later stop the instrument on specific note with function @noteOff@.
noteOn :: (Arg a) => D -> D -> InstrRef a -> a -> SE ()
noteOn :: forall a. Arg a => D -> D -> InstrRef a -> a -> SE ()
noteOn D
maxSize D
noteId InstrRef a
instrId a
args = InstrRef a -> D -> D -> a -> SE ()
forall a. Arg a => InstrRef a -> D -> D -> a -> SE ()
scheduleEvent (D -> D -> InstrRef a -> InstrRef a
forall a. D -> D -> InstrRef a -> InstrRef a
addFracInstrRef D
maxSize D
noteId InstrRef a
instrId) D
0 (-D
1) a
args

-- | Stops a note with fractional instrument reference.
noteOff :: (Default a, Arg a) => D -> D -> InstrRef a -> SE ()
noteOff :: forall a. (Default a, Arg a) => D -> D -> InstrRef a -> SE ()
noteOff D
maxSize D
noteId InstrRef a
instrId = InstrRef a -> D -> D -> a -> SE ()
forall a. Arg a => InstrRef a -> D -> D -> a -> SE ()
scheduleEvent (InstrRef a -> InstrRef a
forall a. InstrRef a -> InstrRef a
negateInstrRef (InstrRef a -> InstrRef a) -> InstrRef a -> InstrRef a
forall a b. (a -> b) -> a -> b
$ D -> D -> InstrRef a -> InstrRef a
forall a. D -> D -> InstrRef a -> InstrRef a
addFracInstrRef D
maxSize D
noteId InstrRef a
instrId) D
0 D
0.01 a
forall a. Default a => a
def

-- | Turns off the note played on the given instrument.
-- Use fractional instrument reference to turn off specific instance.
--
-- > turnoff2 instrRef mode releaseTime
--
-- The mode is 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 (idur < 0 or MIDI)
--
-- @releaseTime@  if non-zero, the turned off instances are allowed to release, otherwise are deactivated immediately (possibly resulting in clicks).
turnoff2 :: InstrRef a -> Sig -> Sig -> SE ()
turnoff2 :: forall a. InstrRef a -> Sig -> Sig -> SE ()
turnoff2 InstrRef a
instrRef Sig
kmode Sig
krelease = Sig -> Sig -> Sig -> SE ()
go (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ InstrRef a -> D
forall a. InstrRef a -> D
getInstrId InstrRef a
instrRef) Sig
kmode Sig
krelease
    where
        go :: Sig -> Sig -> Sig -> SE ()
        go :: Sig -> Sig -> Sig -> SE ()
go Sig
instr Sig
mode Sig
release = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ DepT GE (Dep ()) -> Dep ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (DepT GE (Dep ()) -> Dep ()) -> DepT GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> DepT GE (Dep ())
forall (m :: * -> *) a. Monad m => m a -> DepT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE (Dep ()) -> DepT GE (Dep ()))
-> GE (Dep ()) -> DepT GE (Dep ())
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> Dep ()
forall (m :: * -> *). Monad m => E -> E -> E -> DepT m ()
csdTurnoff2 (E -> E -> E -> Dep ()) -> GE E -> GE (E -> E -> Dep ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
instr) GE (E -> E -> Dep ()) -> GE E -> GE (E -> Dep ())
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
mode) GE (E -> Dep ()) -> GE E -> GE (Dep ())
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
release)

        csdTurnoff2 :: Monad m => E -> E -> E -> DepT m ()
        csdTurnoff2 :: forall (m :: * -> *). Monad m => E -> E -> E -> DepT m ()
csdTurnoff2 E
instrId E
mode E
release = E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Text -> Spec1 -> [E] -> E
opcs Text
"turnoff2" [(Rate
Xr, [Rate
Kr, Rate
Kr, Rate
Kr])] [E
instrId, E
mode, E
release]