{-# Language FlexibleContexts #-}
module Csound.Typed.Control.Midi(
    Msg, Channel,
    midi, midin, pgmidi,
    midi_, midin_, pgmidi_,
    initMidiCtrl
) where

import Control.Monad

import Csound.Dynamic

import Csound.Typed.Types
import Csound.Typed.GlobalState
import Csound.Typed.Control.Ref

import qualified Csound.Typed.GlobalState.Opcodes as C(midiVolumeFactor)

-- | Triggers a midi-instrument (aka Csound's massign) for all channels.
-- It's useful to test a single instrument.
midi :: (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi :: forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi = ((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
forall a.
(Num a, Sigs a) =>
((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
fromProcMidi (Msg -> SE ()) -> SE ()
midiWithInstrId_

-- | Triggers a midi-instrument (aka Csound's massign) on the specified channel.
midin :: (Num a, Sigs a) => Channel -> (Msg -> SE a) -> SE a
midin :: forall a. (Num a, Sigs a) => Channel -> (Msg -> SE a) -> SE a
midin Channel
n = ((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
forall a.
(Num a, Sigs a) =>
((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
fromProcMidi (Channel -> (Msg -> SE ()) -> SE ()
midinWithInstrId_ Channel
n)

-- | Triggers a midi-instrument (aka Csound's pgmassign) on the specified programm bank.
pgmidi :: (Num a, Sigs a) => Maybe Int -> Channel -> (Msg -> SE a) -> SE a
pgmidi :: forall a.
(Num a, Sigs a) =>
Maybe Channel -> Channel -> (Msg -> SE a) -> SE a
pgmidi Maybe Channel
mchn Channel
n = ((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
forall a.
(Num a, Sigs a) =>
((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
fromProcMidi (Maybe Channel -> Channel -> (Msg -> SE ()) -> SE ()
pgmidiWithInstrId_ Maybe Channel
mchn Channel
n)

fromProcMidi :: (Num a, Sigs a) => ((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
fromProcMidi :: forall a.
(Num a, Sigs a) =>
((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a
fromProcMidi (Msg -> SE ()) -> SE ()
procMidi Msg -> SE a
f = do
    Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef a
0
    (Msg -> SE ()) -> SE ()
procMidi (Ref a -> a -> SE ()
forall a. (Num a, Tuple a) => Ref a -> a -> SE ()
mixRef Ref a
ref (a -> SE ()) -> (a -> a) -> a -> SE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Sigs a => a -> a
scaleMidiVolumeFactor (a -> SE ()) -> (Msg -> SE a) -> Msg -> SE ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Msg -> SE a
f)
    a
res <- Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref
    Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
0
    a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

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

-- | Triggers a midi-procedure (aka Csound's massign) for all channels.
midiWithInstrId_ :: (Msg -> SE ()) -> SE ()
midiWithInstrId_ :: (Msg -> SE ()) -> SE ()
midiWithInstrId_ = Channel -> (Msg -> SE ()) -> SE ()
midinWithInstrId_ Channel
0

-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given channel.
midinWithInstrId_ :: Channel -> (Msg -> SE ()) -> SE ()
midinWithInstrId_ :: Channel -> (Msg -> SE ()) -> SE ()
midinWithInstrId_ Channel
chn Msg -> SE ()
instr = MidiType -> Channel -> (Msg -> SE ()) -> SE ()
genMidi_ MidiType
Massign Channel
chn Msg -> SE ()
instr

-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank.
pgmidiWithInstrId_ :: Maybe Int -> Channel -> (Msg -> SE ()) -> SE ()
pgmidiWithInstrId_ :: Maybe Channel -> Channel -> (Msg -> SE ()) -> SE ()
pgmidiWithInstrId_ Maybe Channel
mchn Channel
chn Msg -> SE ()
instr = MidiType -> Channel -> (Msg -> SE ()) -> SE ()
genMidi_ (Maybe Channel -> MidiType
Pgmassign Maybe Channel
mchn) Channel
chn Msg -> SE ()
instr

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

-- | Triggers a midi-procedure (aka Csound's massign) for all channels.
midi_ :: (Msg -> SE ()) -> SE ()
midi_ :: (Msg -> SE ()) -> SE ()
midi_ = Channel -> (Msg -> SE ()) -> SE ()
midin_ Channel
0

-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given channel.
midin_ :: Channel -> (Msg -> SE ()) -> SE ()
midin_ :: Channel -> (Msg -> SE ()) -> SE ()
midin_ Channel
chn Msg -> SE ()
instr = MidiType -> Channel -> (Msg -> SE ()) -> SE ()
genMidi_ MidiType
Massign Channel
chn Msg -> SE ()
instr

-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank.
pgmidi_ :: Maybe Int -> Channel -> (Msg -> SE ()) -> SE ()
pgmidi_ :: Maybe Channel -> Channel -> (Msg -> SE ()) -> SE ()
pgmidi_ Maybe Channel
mchn Channel
chn Msg -> SE ()
instr = MidiType -> Channel -> (Msg -> SE ()) -> SE ()
genMidi_ (Maybe Channel -> MidiType
Pgmassign Maybe Channel
mchn) Channel
chn Msg -> SE ()
instr

genMidi_ :: MidiType -> Channel -> (Msg -> SE ()) -> SE ()
genMidi_ :: MidiType -> Channel -> (Msg -> SE ()) -> SE ()
genMidi_ MidiType
midiType Channel
chn Msg -> SE ()
instr = GE () -> SE ()
forall a. GE a -> SE a
geToSe (GE () -> SE ()) -> GE () -> SE ()
forall a b. (a -> b) -> a -> b
$ MidiType -> Channel -> Dep () -> GE ()
saveToMidiInstr MidiType
midiType Channel
chn (SE () -> Dep ()
forall a. SE a -> Dep a
unSE (SE () -> Dep ()) -> SE () -> Dep ()
forall a b. (a -> b) -> a -> b
$ Msg -> SE ()
instr Msg
Msg)

-----------------------------------------------------------------
-- midi ctrls

initMidiCtrl :: D -> D -> D -> SE ()
initMidiCtrl :: D -> D -> D -> SE ()
initMidiCtrl D
chno D
ctrlno D
val = GE () -> SE ()
forall a. GE a -> SE a
geToSe (GE () -> SE ()) -> GE () -> SE ()
forall a b. (a -> b) -> a -> b
$
    MidiCtrl -> GE ()
saveMidiCtrl (MidiCtrl -> GE ()) -> GE MidiCtrl -> GE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (E -> E -> E -> MidiCtrl
MidiCtrl (E -> E -> E -> MidiCtrl) -> GE E -> GE (E -> E -> MidiCtrl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
forall a. Val a => a -> GE E
toGE D
chno GE (E -> E -> MidiCtrl) -> GE E -> GE (E -> MidiCtrl)
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
ctrlno GE (E -> MidiCtrl) -> GE E -> GE MidiCtrl
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
val)


-----------------------------------------------------------------
-- midi volume factor

scaleMidiVolumeFactor :: Sigs a => a -> a
scaleMidiVolumeFactor :: forall a. Sigs a => a -> a
scaleMidiVolumeFactor = (E -> E) -> a -> a
forall a. Tuple a => (E -> E) -> a -> a
mapTuple (Rate -> E -> E
setRate Rate
Ir (E -> E
C.midiVolumeFactor (Channel -> E
pn Channel
1)) E -> E -> E
forall a. Num a => a -> a -> a
* )