{-# Language FlexibleContexts #-}
-- | Midi.
module Csound.Control.Midi(
    MidiChn(..), MidiFun, toMidiFun, toMidiFun_,
    Msg, Channel, midi, midin, pgmidi, ampCps,
    midi_, midin_, pgmidi_,
    -- * Mono-midi synth
    monoMsg, holdMsg, trigNamedMono, genMonoMsg, smoothMonoArg,
    genFilteredMonoMsg, genFilteredMonoMsgTemp,

    -- ** Custom temperament
    monoMsgTemp, holdMsgTemp, genMonoMsgTemp,
    -- * Midi event streams
    midiKeyOn, midiKeyOff,
    -- * Reading midi note parameters
    cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl,
    midiCtrl7A, midiCtrlA, umidiCtrlA,
    ampmidinn,

    -- ** Custom temperament
    ampCps', cpsmidi', cpsmidi'D, cpsmidi'Sig,

    -- * Overload
    tryMidi, tryMidi', MidiInstr(..), MidiInstrTemp(..),

    -- * Other
    namedAmpCpsSig
) where

import Data.Boolean

import Csound.Typed hiding (arg)
import Csound.Typed.Opcode hiding (initc7)
import Csound.Control.Overload
import Csound.Control.Instr(alwaysOn)
import Csound.Control.Evt(Tick)
import Csound.Types

import Csound.Tuning

-- | Specifies the midi channel or programm.
data MidiChn = ChnAll | Chn Int | Pgm (Maybe Int) Int
  deriving (Int -> MidiChn -> ShowS
[MidiChn] -> ShowS
MidiChn -> String
(Int -> MidiChn -> ShowS)
-> (MidiChn -> String) -> ([MidiChn] -> ShowS) -> Show MidiChn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiChn] -> ShowS
$cshowList :: [MidiChn] -> ShowS
show :: MidiChn -> String
$cshow :: MidiChn -> String
showsPrec :: Int -> MidiChn -> ShowS
$cshowsPrec :: Int -> MidiChn -> ShowS
Show, MidiChn -> MidiChn -> Bool
(MidiChn -> MidiChn -> Bool)
-> (MidiChn -> MidiChn -> Bool) -> Eq MidiChn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiChn -> MidiChn -> Bool
$c/= :: MidiChn -> MidiChn -> Bool
== :: MidiChn -> MidiChn -> Bool
$c== :: MidiChn -> MidiChn -> Bool
Eq)

type MidiFun a = (Msg -> SE a) -> SE a

toMidiFun :: Sigs a => MidiChn -> MidiFun a
toMidiFun :: MidiChn -> MidiFun a
toMidiFun MidiChn
x = case MidiChn
x of
  MidiChn
ChnAll  -> MidiFun a
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi
  Chn Int
n   -> Int -> MidiFun a
forall a. (Num a, Sigs a) => Int -> (Msg -> SE a) -> SE a
midin Int
n
  Pgm Maybe Int
a Int
b -> Maybe Int -> Int -> MidiFun a
forall a.
(Num a, Sigs a) =>
Maybe Int -> Int -> (Msg -> SE a) -> SE a
pgmidi Maybe Int
a Int
b

toMidiFun_ :: MidiChn -> MidiFun ()
toMidiFun_ :: MidiChn -> MidiFun ()
toMidiFun_ MidiChn
x = case MidiChn
x of
  MidiChn
ChnAll  -> MidiFun ()
midi_
  Chn Int
n   -> Int -> MidiFun ()
midin_ Int
n
  Pgm Maybe Int
a Int
b -> Maybe Int -> Int -> MidiFun ()
pgmidi_ Maybe Int
a Int
b

ampCps :: Msg -> (D, D)
ampCps :: Msg -> (D, D)
ampCps Msg
msg = (Msg -> D -> D
ampmidi Msg
msg D
1, Msg -> D
cpsmidi Msg
msg)

-- | Converts midi velocity number to amplitude.
-- The first argument is dynamic range in decibels.
--
-- > ampmidinn (volMinDb, volMaxDb) volumeKey = amplitude
ampmidinn :: (D, D) -> D -> D
ampmidinn :: (D, D) -> D -> D
ampmidinn (D
volMin, D
volMax) D
volKey = D -> D
forall a. SigOrD a => a -> a
ampdbfs (D
volMin D -> D -> D
forall a. Num a => a -> a -> a
+ Sig -> D
ir (D -> D -> Sig
ampmidid D
volKey (D
volMax D -> D -> D
forall a. Num a => a -> a -> a
- D
volMin)))

-- | Midi message convertion with custom temperament.
ampCps' :: Temp -> Msg -> (D, D)
ampCps' :: Temp -> Msg -> (D, D)
ampCps' Temp
temp Msg
msg = (Msg -> D -> D
ampmidi Msg
msg D
1, Temp -> Msg -> D
cpsmidi' Temp
temp Msg
msg)

-- | Midi message convertion to Hz with custom temperament.
cpsmidi' :: Temp -> Msg -> D
cpsmidi' :: Temp -> Msg -> D
cpsmidi' (Temp Tab
t) Msg
msg = Msg -> Tab -> D
cpstmid Msg
msg Tab
t

-- | Midi pitch key convertion to Hz with custom temperament. It works on constants.
cpsmidi'D :: Temp -> D -> D
cpsmidi'D :: Temp -> D -> D
cpsmidi'D (Temp Tab
t) D
key = D -> Tab -> D
cpstuni D
key Tab
t

-- | Midi pitch key convertion to Hz with custom temperament. It works on signals.
cpsmidi'Sig :: Temp -> Sig -> Sig
cpsmidi'Sig :: Temp -> Sig -> Sig
cpsmidi'Sig (Temp Tab
t) Sig
key = Sig -> Sig -> Tab -> Sig
cpstun Sig
1 Sig
key Tab
t

-----------------------------------------------------------------------
-- Midi addons

-- mono midi

-- | Produces midi amplitude and frequency as a signal.
-- The signal fades out when nothing is pressed.
-- It can be used in mono-synths. Arguments are portamento time
-- and release time. A portamento time is time it takes for transition
-- from one note to another.
--
-- > monoMsg channel portamentoTime releaseTime
monoMsg :: MidiChn -> D -> D -> SE (Sig, Sig)
monoMsg :: MidiChn -> D -> D -> SE (Sig, Sig)
monoMsg = (Msg -> D) -> MidiChn -> D -> D -> SE (Sig, Sig)
smoothMonoMsg Msg -> D
cpsmidi

-- | Produces midi amplitude and frequency as a signal.
-- The signal fades out when nothing is pressed.
-- It can be used in mono-synths. Arguments are custom temperament, midi channel, portamento time
-- and release time. A portamento time is time it takes for transition
-- from one note to another.
--
-- > monoMsgTemp temperament channel portamentoTime releaseTime
monoMsgTemp :: Temp -> MidiChn -> D -> D -> SE (Sig, Sig)
monoMsgTemp :: Temp -> MidiChn -> D -> D -> SE (Sig, Sig)
monoMsgTemp Temp
tm = (Msg -> D) -> MidiChn -> D -> D -> SE (Sig, Sig)
smoothMonoMsg (Temp -> Msg -> D
cpsmidi' Temp
tm)

-- | Produces an argument for monophonic midi-synth.
-- The signal fades out when nothing is pressed.
-- It can be used in mono-synths.
--
-- > genMonoMsg channel
genMonoMsg :: MidiChn -> SE MonoArg
genMonoMsg :: MidiChn -> SE MonoArg
genMonoMsg MidiChn
chn = (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE MonoArg
genAmpCpsSig Msg -> D
cpsmidi (MidiChn -> (Msg -> SE Sig) -> SE Sig
forall a. Sigs a => MidiChn -> MidiFun a
toMidiFun MidiChn
chn)

-- | Just like mono @genMonoMsg@ but also we can alter the temperament. The temperament spec goes first.
--
-- > genMonoMsgTemp temperament channel
genMonoMsgTemp :: Temp -> MidiChn -> SE MonoArg
genMonoMsgTemp :: Temp -> MidiChn -> SE MonoArg
genMonoMsgTemp Temp
tm MidiChn
chn = (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE MonoArg
genAmpCpsSig (Temp -> Msg -> D
cpsmidi' Temp
tm) (MidiChn -> (Msg -> SE Sig) -> SE Sig
forall a. Sigs a => MidiChn -> MidiFun a
toMidiFun MidiChn
chn)

smoothMonoArg :: D -> MonoArg -> MonoArg
smoothMonoArg :: D -> MonoArg -> MonoArg
smoothMonoArg D
time MonoArg
arg = MonoArg
arg { monoAmp :: Sig
monoAmp = Sig -> D -> Sig
port (MonoArg -> Sig
monoAmp MonoArg
arg) D
time, monoCps :: Sig
monoCps = Sig -> D -> Sig
port (MonoArg -> Sig
monoCps MonoArg
arg) D
time }

smoothMonoMsg :: (Msg -> D) -> MidiChn -> D -> D -> SE (Sig, Sig)
smoothMonoMsg :: (Msg -> D) -> MidiChn -> D -> D -> SE (Sig, Sig)
smoothMonoMsg Msg -> D
key2cps MidiChn
chn D
portTime D
relTime = do
  (MonoArg Sig
amp Sig
cps Sig
status Sig
_) <- (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE MonoArg
genAmpCpsSig Msg -> D
key2cps (MidiChn -> (Msg -> SE Sig) -> SE Sig
forall a. Sigs a => MidiChn -> MidiFun a
toMidiFun MidiChn
chn)
  (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> D -> Sig
port Sig
amp D
portTime Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> D -> Sig
port Sig
status D
relTime,  Sig -> D -> Sig
port Sig
cps D
portTime)


genFilteredMonoMsg :: MidiChn -> (D -> BoolD) -> SE MonoArg
genFilteredMonoMsg :: MidiChn -> (D -> BoolD) -> SE MonoArg
genFilteredMonoMsg MidiChn
chn D -> BoolD
condition = (Msg -> D)
-> ((Msg -> SE Sig) -> SE Sig) -> (D -> BoolD) -> SE MonoArg
filteredGenAmpCpsSig Msg -> D
cpsmidi (MidiChn -> (Msg -> SE Sig) -> SE Sig
forall a. Sigs a => MidiChn -> MidiFun a
toMidiFun MidiChn
chn) D -> BoolD
condition

-- | Just like mono @genMonoMsg@ but also we can alter the temperament. The temperament spec goes first.
--
-- > genMonoMsgTemp temperament channel
genFilteredMonoMsgTemp :: Temp -> MidiChn -> (D -> BoolD) -> SE MonoArg
genFilteredMonoMsgTemp :: Temp -> MidiChn -> (D -> BoolD) -> SE MonoArg
genFilteredMonoMsgTemp Temp
tm MidiChn
chn D -> BoolD
condition = (Msg -> D)
-> ((Msg -> SE Sig) -> SE Sig) -> (D -> BoolD) -> SE MonoArg
filteredGenAmpCpsSig (Temp -> Msg -> D
cpsmidi' Temp
tm) (MidiChn -> (Msg -> SE Sig) -> SE Sig
forall a. Sigs a => MidiChn -> MidiFun a
toMidiFun MidiChn
chn) D -> BoolD
condition

-- | Produces midi amplitude and frequency as a signal and holds the
-- last value till the next one is present.
-- It can be used in mono-synths. Arguments are portamento time
-- and release time. A portamento time is time it takes for transition
-- from one note to another.
--
-- > holdMsg portamentoTime
holdMsg :: MidiChn -> D -> SE (Sig, Sig)
holdMsg :: MidiChn -> D -> SE (Sig, Sig)
holdMsg = (Msg -> D) -> MidiChn -> D -> SE (Sig, Sig)
genHoldMsg Msg -> D
cpsmidi

-- | Produces midi amplitude and frequency as a signal and holds the
-- last value till the next one is present.
-- It can be used in mono-synths. Arguments are portamento time
-- and release time. A portamento time is time it takes for transition
-- from one note to another.
--
-- > holdMsg portamentoTime
holdMsgTemp :: Temp -> MidiChn -> D -> SE (Sig, Sig)
holdMsgTemp :: Temp -> MidiChn -> D -> SE (Sig, Sig)
holdMsgTemp Temp
tm = (Msg -> D) -> MidiChn -> D -> SE (Sig, Sig)
genHoldMsg (Temp -> Msg -> D
cpsmidi' Temp
tm)

genHoldMsg :: (Msg -> D) -> MidiChn -> D -> SE (Sig, Sig)
genHoldMsg :: (Msg -> D) -> MidiChn -> D -> SE (Sig, Sig)
genHoldMsg Msg -> D
key2cps MidiChn
channel D
portTime = do
  (Sig
amp, Sig
cps) <- (Msg -> D) -> MidiFun () -> SE (Sig, Sig)
genHoldAmpCpsSig Msg -> D
key2cps (MidiChn -> MidiFun ()
toMidiFun_ MidiChn
channel)
  (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> D -> Sig
port Sig
amp D
portTime,  Sig -> D -> Sig
port Sig
cps D
portTime)



genAmpCpsSig :: (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE MonoArg
genAmpCpsSig :: (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE MonoArg
genAmpCpsSig Msg -> D
key2cps (Msg -> SE Sig) -> SE Sig
midiFun = do
    Ref (Sig, Sig)
ref <- (Sig, Sig) -> SE (Ref (Sig, Sig))
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef ((Sig
0, Sig
0) :: (Sig, Sig))
    Sig
status <- (Msg -> SE Sig) -> SE Sig
midiFun (Ref (Sig, Sig) -> Msg -> SE Sig
instr Ref (Sig, Sig)
ref)
    (Sig
amp, Sig
cps) <- Ref (Sig, Sig) -> SE (Sig, Sig)
forall a. Tuple a => Ref a -> SE a
readRef Ref (Sig, Sig)
ref
    MonoArg -> SE MonoArg
forall (m :: * -> *) a. Monad m => a -> m a
return (MonoArg -> SE MonoArg) -> MonoArg -> SE MonoArg
forall a b. (a -> b) -> a -> b
$ (Sig, Sig) -> Sig -> MonoArg
makeMonoArg (Sig
amp, Sig
cps) Sig
status
  where
        makeMonoArg :: (Sig, Sig) -> Sig -> MonoArg
makeMonoArg (Sig
amp, Sig
cps) Sig
status = Sig -> Sig -> Sig -> Sig -> MonoArg
MonoArg Sig
kamp Sig
kcps Sig
resStatus Sig
retrig
            where
                kamp :: Sig
kamp = Sig -> Sig
downsamp Sig
amp
                kcps :: Sig
kcps = Sig -> Sig
downsamp Sig
cps
                kstatus :: Sig
kstatus = Sig -> Sig
downsamp Sig
status
                resStatus :: Sig
resStatus = BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig
kstatus Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
0) Sig
0 Sig
1
                retrig :: Sig
retrig = [Sig] -> Sig
changed [Sig
kamp, Sig
kcps, Sig
kstatus]

        instr :: Ref (Sig, Sig) -> Msg -> SE Sig
        instr :: Ref (Sig, Sig) -> Msg -> SE Sig
instr Ref (Sig, Sig)
hNote Msg
msg = do
            Ref (Sig, Sig) -> (Sig, Sig) -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref (Sig, Sig)
hNote (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D -> D
ampmidi Msg
msg D
1, D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D
key2cps Msg
msg)
            Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
1

filteredGenAmpCpsSig :: (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> (D -> BoolD) -> SE MonoArg
filteredGenAmpCpsSig :: (Msg -> D)
-> ((Msg -> SE Sig) -> SE Sig) -> (D -> BoolD) -> SE MonoArg
filteredGenAmpCpsSig Msg -> D
key2cps (Msg -> SE Sig) -> SE Sig
midiFun D -> BoolD
condition  = do
    Ref (Sig, Sig)
ref <- (Sig, Sig) -> SE (Ref (Sig, Sig))
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef ((Sig
0, Sig
0) :: (Sig, Sig))
    Sig
status <- (Msg -> SE Sig) -> SE Sig
midiFun (Ref (Sig, Sig) -> Msg -> SE Sig
instr Ref (Sig, Sig)
ref)
    (Sig
amp, Sig
cps) <- Ref (Sig, Sig) -> SE (Sig, Sig)
forall a. Tuple a => Ref a -> SE a
readRef Ref (Sig, Sig)
ref
    MonoArg -> SE MonoArg
forall (m :: * -> *) a. Monad m => a -> m a
return (MonoArg -> SE MonoArg) -> MonoArg -> SE MonoArg
forall a b. (a -> b) -> a -> b
$ (Sig, Sig) -> Sig -> MonoArg
makeMonoArg (Sig
amp, Sig
cps) Sig
status
    where
        makeMonoArg :: (Sig, Sig) -> Sig -> MonoArg
makeMonoArg (Sig
amp, Sig
cps) Sig
status = Sig -> Sig -> Sig -> Sig -> MonoArg
MonoArg Sig
kamp Sig
kcps Sig
resStatus Sig
retrig
            where
                kamp :: Sig
kamp = Sig -> Sig
downsamp Sig
amp
                kcps :: Sig
kcps = Sig -> Sig
downsamp Sig
cps
                kstatus :: Sig
kstatus = Sig -> Sig
downsamp Sig
status
                resStatus :: Sig
resStatus = BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig
kstatus Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
0) Sig
0 Sig
1
                retrig :: Sig
retrig = [Sig] -> Sig
changed [Sig
kamp, Sig
kcps, Sig
kstatus]

        instr :: Ref (Sig, Sig) -> Msg -> SE Sig
        instr :: Ref (Sig, Sig) -> Msg -> SE Sig
instr Ref (Sig, Sig)
hNote Msg
msg = do
            Ref Sig
resRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newRef Sig
0
            BoolD -> SE () -> SE () -> SE ()
whenElseD (D -> BoolD
condition (D -> BoolD) -> D -> BoolD
forall a b. (a -> b) -> a -> b
$ Msg -> D
key2cps Msg
msg)
                (do
                    Ref (Sig, Sig) -> (Sig, Sig) -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref (Sig, Sig)
hNote (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D -> D
ampmidi Msg
msg D
1, D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D
key2cps Msg
msg)
                    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
resRef Sig
1)
                (do
                    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
resRef Sig
0)
            Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
resRef

genHoldAmpCpsSig :: (Msg -> D) -> ((Msg -> SE ()) -> SE ()) -> SE (Sig, Sig)
genHoldAmpCpsSig :: (Msg -> D) -> MidiFun () -> SE (Sig, Sig)
genHoldAmpCpsSig Msg -> D
key2cps MidiFun ()
midiFun = do
  Ref (Sig, Sig)
ref <- (Sig, Sig) -> SE (Ref (Sig, Sig))
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef ((Sig
0, Sig
0) :: (Sig, Sig))
  MidiFun ()
midiFun (Ref (Sig, Sig) -> Msg -> SE ()
instr Ref (Sig, Sig)
ref)
  (Sig
amp, Sig
cps) <- Ref (Sig, Sig) -> SE (Sig, Sig)
forall a. Tuple a => Ref a -> SE a
readRef Ref (Sig, Sig)
ref
  (Sig, Sig) -> SE (Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> Sig
downsamp Sig
amp, Sig -> Sig
downsamp Sig
cps)
  where
    instr :: Ref (Sig, Sig) -> Msg -> SE ()
    instr :: Ref (Sig, Sig) -> Msg -> SE ()
instr Ref (Sig, Sig)
hNote Msg
msg = do
      Ref (Sig, Sig) -> (Sig, Sig) -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref (Sig, Sig)
hNote (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D -> D
ampmidi Msg
msg D
1, D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D
key2cps Msg
msg)

-- | Creates a named instrument that can be triggered with Csound API.
-- This way we can create a csd file that can be used inside another program/language.
--
-- It simulates the input for monophonic midi-like instrument. Notes are encoded with messages:
--
-- > i "givenName" 1 pitchKey volumeKey     -- note on
-- > i "givenName" 0 pitchKey volumeKey     -- note off
--
-- The output is a pair of signals @(midiVolume, midiPitch)@.
trigNamedMono :: String -> SE MonoArg
trigNamedMono :: String -> SE MonoArg
trigNamedMono String
name = String -> SE MonoArg
namedMonoMsg String
name

namedAmpCpsSig:: String -> SE (Sig, Sig, Sig)
namedAmpCpsSig :: String -> SE (Sig, Sig, Sig)
namedAmpCpsSig String
name = do
  Ref (Sig, Sig)
ref <- (Sig, Sig) -> SE (Ref (Sig, Sig))
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef ((Sig
0, Sig
0) :: (Sig, Sig))
  Ref Sig
statusRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (Sig
0 :: Sig)
  Sig
status <- String -> ((D, D, Unit) -> SE Sig) -> SE Sig
forall a b.
(Arg a, Sigs b) =>
String -> ((D, D, a) -> SE b) -> SE b
trigByNameMidi String
name (Ref Sig -> Ref (Sig, Sig) -> (D, D, Unit) -> SE Sig
instr Ref Sig
statusRef Ref (Sig, Sig)
ref)
  Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
statusRef Sig
status
  let resStatus :: Sig
resStatus = BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig -> Sig
downsamp Sig
status Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
0) Sig
0 Sig
1
  (Sig
amp, Sig
cps) <- Ref (Sig, Sig) -> SE (Sig, Sig)
forall a. Tuple a => Ref a -> SE a
readRef Ref (Sig, Sig)
ref
  (Sig, Sig, Sig) -> SE (Sig, Sig, Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> Sig
downsamp Sig
amp, Sig -> Sig
downsamp Sig
cps, Sig
resStatus)
  where
    instr :: Ref Sig -> Ref (Sig, Sig) -> (D, D, Unit) -> SE Sig
    instr :: Ref Sig -> Ref (Sig, Sig) -> (D, D, Unit) -> SE Sig
instr Ref Sig
statusRef Ref (Sig, Sig)
hNote (D
pitchKey, D
volKey, Unit
_) = do
      Sig
curId <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
statusRef
      Ref D
myIdRef <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (Sig -> D
ir Sig
curId)
      D
myId <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
myIdRef
      BoolSig -> SE () -> SE ()
when1 (Sig
curId Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
myId D -> D -> D
forall a. Num a => a -> a -> a
+ D
1)) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
        Ref (Sig, Sig) -> (Sig, Sig) -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref (Sig, Sig)
hNote (D -> Sig
sig D
volKey, D -> Sig
sig D
pitchKey)
      Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
1

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

-- | Listens to midi on event on the given key as event stream.
-- The event stream carries the level of volume (ranges from 0 to 1).
midiKeyOn :: MidiChn -> D -> SE (Evt D)
midiKeyOn :: MidiChn -> D -> SE (Evt D)
midiKeyOn = ((Msg -> SE Sig) -> SE Sig) -> D -> SE (Evt D)
midiKeyOnBy (((Msg -> SE Sig) -> SE Sig) -> D -> SE (Evt D))
-> (MidiChn -> (Msg -> SE Sig) -> SE Sig)
-> MidiChn
-> D
-> SE (Evt D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MidiChn -> (Msg -> SE Sig) -> SE Sig
forall a. Sigs a => MidiChn -> MidiFun a
toMidiFun

-- | Listens to midi on event off the given key as event stream.
midiKeyOff :: MidiChn -> D -> SE Tick
midiKeyOff :: MidiChn -> D -> SE Tick
midiKeyOff = ((Msg -> SE Sig) -> SE Sig) -> D -> SE Tick
midiKeyOffBy (((Msg -> SE Sig) -> SE Sig) -> D -> SE Tick)
-> (MidiChn -> (Msg -> SE Sig) -> SE Sig)
-> MidiChn
-> D
-> SE Tick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MidiChn -> (Msg -> SE Sig) -> SE Sig
forall a. Sigs a => MidiChn -> MidiFun a
toMidiFun

midiKeyOnBy :: MidiFun Sig -> D -> SE (Evt D)
midiKeyOnBy :: ((Msg -> SE Sig) -> SE Sig) -> D -> SE (Evt D)
midiKeyOnBy (Msg -> SE Sig) -> SE Sig
midiFun D
key = do
  Ref Sig
chRef  <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (Sig
0 :: Sig)
  Ref Sig
evtRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (Sig
0 :: Sig)
  Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
chRef (Sig -> SE ()) -> SE Sig -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Msg -> SE Sig) -> SE Sig
midiFun Msg -> SE Sig
instr

  SE () -> SE ()
alwaysOn (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
    Sig
a <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
chRef
    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
evtRef (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
diff Sig
a

  Sig
evtSig <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
evtRef
  Evt D -> SE (Evt D)
forall (m :: * -> *) a. Monad m => a -> m a
return (Evt D -> SE (Evt D)) -> Evt D -> SE (Evt D)
forall a b. (a -> b) -> a -> b
$ (D -> BoolD) -> Evt D -> Evt D
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE ( D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* D
0) (Evt D -> Evt D) -> Evt D -> Evt D
forall a b. (a -> b) -> a -> b
$ Sig -> Evt D
snaps Sig
evtSig
  where
    instr :: Msg -> SE Sig
instr Msg
msg = do
      [D] -> SE ()
print' [Msg -> D
notnum Msg
msg]
      Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (BoolD -> BoolSig
boolSig (BoolD -> BoolSig) -> BoolD -> BoolSig
forall a b. (a -> b) -> a -> b
$ Msg -> D
notnum Msg
msg D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* D
key) (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D -> D
ampmidi Msg
msg D
1) Sig
0


midiKeyOffBy :: MidiFun Sig -> D -> SE Tick
midiKeyOffBy :: ((Msg -> SE Sig) -> SE Sig) -> D -> SE Tick
midiKeyOffBy (Msg -> SE Sig) -> SE Sig
midiFun D
key = do
  Ref Sig
chRef  <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (Sig
0 :: Sig)
  Ref Sig
evtRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (Sig
0 :: Sig)
  Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
chRef (Sig -> SE ()) -> SE Sig -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Msg -> SE Sig) -> SE Sig
midiFun Msg -> SE Sig
instr

  SE () -> SE ()
alwaysOn (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
    Sig
a <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
chRef
    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
evtRef (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
diff Sig
a

  Sig
evtSig <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
evtRef
  Tick -> SE Tick
forall (m :: * -> *) a. Monad m => a -> m a
return (Tick -> SE Tick) -> Tick -> SE Tick
forall a b. (a -> b) -> a -> b
$ (D -> Unit) -> Evt D -> Tick
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit -> D -> Unit
forall a b. a -> b -> a
const Unit
unit) (Evt D -> Tick) -> Evt D -> Tick
forall a b. (a -> b) -> a -> b
$ (D -> BoolD) -> Evt D -> Evt D
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE ( D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
0) (Evt D -> Evt D) -> Evt D -> Evt D
forall a b. (a -> b) -> a -> b
$ Sig -> Evt D
snaps Sig
evtSig
  where
    instr :: Msg -> SE Sig
instr Msg
msg = do
      [D] -> SE ()
print' [Msg -> D
notnum Msg
msg]
      Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (BoolD -> BoolSig
boolSig (BoolD -> BoolSig) -> BoolD -> BoolSig
forall a b. (a -> b) -> a -> b
$ Msg -> D
notnum Msg
msg D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* D
key) (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Msg -> D -> D
ampmidi Msg
msg D
1) Sig
0

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

-- | Initialization of the midi control-messages.
initc7 :: D -> D -> D -> SE ()
initc7 :: D -> D -> D -> SE ()
initc7 = D -> D -> D -> SE ()
initMidiCtrl

-- | Initializes control rate midi control and get the value in the specified range.
midiCtrl7 :: D -> D -> D -> D -> D -> SE Sig
midiCtrl7 :: D -> D -> D -> D -> D -> SE Sig
midiCtrl7 D
chno D
ctrlno D
ival D
imin D
imax = do
    D -> D -> D -> SE ()
initc7 D
chno D
ctrlno D
ival
    Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
kr (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ D -> D -> D -> D -> Sig
ctrl7 D
chno D
ctrlno D
imin D
imax

-- | Initializes control rate midi control and get the value in the range (-1) to 1.
midiCtrl :: D -> D -> D -> SE Sig
midiCtrl :: D -> D -> D -> SE Sig
midiCtrl D
chno D
ctrlno D
ival = D -> D -> D -> D -> D -> SE Sig
midiCtrl7 D
chno D
ctrlno D
ival (-D
1) D
1

-- | Unipolar control rate midiCtrl. Initializes midi control and get the value in the range 0 to 1.
umidiCtrl :: D -> D -> D -> SE Sig
umidiCtrl :: D -> D -> D -> SE Sig
umidiCtrl D
chno D
ctrlno D
ival = D -> D -> D -> D -> D -> SE Sig
midiCtrl7 D
chno D
ctrlno D
ival D
0 D
1

-- | Initializes audio-rate midi control and get the value in the specified range.
midiCtrl7A :: D -> D -> D -> D -> D -> SE Sig
midiCtrl7A :: D -> D -> D -> D -> D -> SE Sig
midiCtrl7A D
chno D
ctrlno D
ival D
imin D
imax = do
    D -> D -> D -> SE ()
initc7 D
chno D
ctrlno D
ival
    Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
ar (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ D -> D -> D -> D -> Sig
ctrl7 D
chno D
ctrlno D
imin D
imax

-- | Initializes audio-rate midi control and get the value in the range (-1) to 1.
midiCtrlA :: D -> D -> D -> SE Sig
midiCtrlA :: D -> D -> D -> SE Sig
midiCtrlA D
chno D
ctrlno D
ival = D -> D -> D -> D -> D -> SE Sig
midiCtrl7A D
chno D
ctrlno D
ival (-D
1) D
1

-- | Unipolar audio-rate midiCtrl. Initializes midi control and get the value in the range 0 to 1.
umidiCtrlA :: D -> D -> D -> SE Sig
umidiCtrlA :: D -> D -> D -> SE Sig
umidiCtrlA D
chno D
ctrlno D
ival = D -> D -> D -> D -> D -> SE Sig
midiCtrl7A D
chno D
ctrlno D
ival D
0 D
1

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

-- | Invokes ooverloaded instruments with midi.
-- Example:
--
-- > dac $ tryMidi (mul (fades 0.01 0.1) . tri)
tryMidi :: (MidiInstr a, Sigs (MidiInstrOut a)) => a -> SE (MidiInstrOut a)
tryMidi :: a -> SE (MidiInstrOut a)
tryMidi a
x = (Msg -> SE (MidiInstrOut a)) -> SE (MidiInstrOut a)
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi ((Msg -> SE (MidiInstrOut a)) -> SE (MidiInstrOut a))
-> (Msg -> SE (MidiInstrOut a)) -> SE (MidiInstrOut a)
forall a b. (a -> b) -> a -> b
$ a -> Msg -> SE (MidiInstrOut a)
forall a. MidiInstr a => a -> Msg -> SE (MidiInstrOut a)
onMsg a
x

-- | Invokes ooverloaded instruments with midi and custom temperament.
-- Example:
--
-- > dac $ tryMidi' youngTemp2 (mul (fades 0.01 0.1) . tri)
tryMidi' :: (MidiInstrTemp a, Sigs (MidiInstrOut a)) => Temp -> a -> SE (MidiInstrOut a)
tryMidi' :: Temp -> a -> SE (MidiInstrOut a)
tryMidi' Temp
tm a
x = (Msg -> SE (MidiInstrOut a)) -> SE (MidiInstrOut a)
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi ((Msg -> SE (MidiInstrOut a)) -> SE (MidiInstrOut a))
-> (Msg -> SE (MidiInstrOut a)) -> SE (MidiInstrOut a)
forall a b. (a -> b) -> a -> b
$ Temp -> a -> Msg -> SE (MidiInstrOut a)
forall a.
MidiInstrTemp a =>
Temp -> a -> Msg -> SE (MidiInstrOut a)
onMsg' Temp
tm a
x