module Csound.Control.Midi(
MidiChn(..), MidiFun, toMidiFun, toMidiFun_,
Msg, Channel, midi, midin, pgmidi, ampCps,
midi_, midin_, pgmidi_,
monoMsg, holdMsg, trigNamedMono,
monoMsgTemp, holdMsgTemp,
midiKeyOn, midiKeyOff,
cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl,
ampmidinn,
ampCps', cpsmidi', cpsmidi'D, cpsmidi'Sig,
tryMidi, tryMidi', MidiInstr(..), MidiInstrTemp(..)
) where
import Data.Boolean
import Csound.Typed
import Csound.Typed.Opcode hiding (initc7)
import Csound.Control.Overload
import Csound.Control.Instr(alwaysOn)
import Csound.Control.Evt(Tick)
import Csound.Tuning
data MidiChn = ChnAll | Chn Int | Pgm (Maybe Int) Int
deriving (Show, Eq)
type MidiFun a = (Msg -> SE a) -> SE a
toMidiFun :: Sigs a => MidiChn -> MidiFun a
toMidiFun x = case x of
ChnAll -> midi
Chn n -> midin n
Pgm a b -> pgmidi a b
toMidiFun_ :: MidiChn -> MidiFun ()
toMidiFun_ x = case x of
ChnAll -> midi_
Chn n -> midin_ n
Pgm a b -> pgmidi_ a b
ampCps :: Msg -> (D, D)
ampCps msg = (ampmidi msg 1, cpsmidi msg)
ampmidinn :: (D, D) -> D -> D
ampmidinn (volMin, volMax) volKey = ampdbfs (volMin + ir (ampmidid volKey (volMax volMin)))
ampCps' :: Temp -> Msg -> (D, D)
ampCps' temp msg = (ampmidi msg 1, cpsmidi' temp msg)
cpsmidi' :: Temp -> Msg -> D
cpsmidi' (Temp t) msg = cpstmid msg t
cpsmidi'D :: Temp -> D -> D
cpsmidi'D (Temp t) key = cpstuni key t
cpsmidi'Sig :: Temp -> Sig -> Sig
cpsmidi'Sig (Temp t) key = cpstun 1 key t
monoMsg :: MidiChn -> D -> D -> SE (Sig, Sig)
monoMsg = genMonoMsg cpsmidi
monoMsgTemp :: Temp -> MidiChn -> D -> D -> SE (Sig, Sig)
monoMsgTemp tm = genMonoMsg (cpsmidi' tm)
genMonoMsg :: (Msg -> D) -> MidiChn -> D -> D -> SE (Sig, Sig)
genMonoMsg key2cps chn portTime relTime = do
(amp, cps, status) <- genAmpCpsSig key2cps (toMidiFun chn)
return (port amp portTime * port status relTime, port cps portTime)
holdMsg :: MidiChn -> D -> SE (Sig, Sig)
holdMsg = genHoldMsg cpsmidi
holdMsgTemp :: Temp -> MidiChn -> D -> SE (Sig, Sig)
holdMsgTemp tm = genHoldMsg (cpsmidi' tm)
genHoldMsg :: (Msg -> D) -> MidiChn -> D -> SE (Sig, Sig)
genHoldMsg key2cps channel portTime = do
(amp, cps) <- genHoldAmpCpsSig key2cps (toMidiFun_ channel)
return (port amp portTime, port cps portTime)
genAmpCpsSig :: (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE (Sig, Sig, Sig)
genAmpCpsSig key2cps midiFun = do
ref <- newGlobalRef ((0, 0) :: (Sig, Sig))
status <- midiFun (instr ref)
let resStatus = ifB (downsamp status ==* 0) 0 1
(amp, cps) <- readRef ref
return (downsamp amp, downsamp cps, resStatus)
where
instr :: Ref (Sig, Sig) -> Msg -> SE Sig
instr hNote msg = do
writeRef hNote (sig $ ampmidi msg 1, sig $ key2cps msg)
return 1
genHoldAmpCpsSig :: (Msg -> D) -> ((Msg -> SE ()) -> SE ()) -> SE (Sig, Sig)
genHoldAmpCpsSig key2cps midiFun = do
ref <- newGlobalRef ((0, 0) :: (Sig, Sig))
midiFun (instr ref)
(amp, cps) <- readRef ref
return (downsamp amp, downsamp cps)
where
instr :: Ref (Sig, Sig) -> Msg -> SE ()
instr hNote msg = do
writeRef hNote (sig $ ampmidi msg 1, sig $ key2cps msg)
trigNamedMono :: D -> D -> String -> SE (Sig, Sig)
trigNamedMono portTime relTime name = namedMonoMsg portTime relTime name
namedAmpCpsSig:: String -> SE (Sig, Sig, Sig)
namedAmpCpsSig name = do
ref <- newGlobalRef ((0, 0) :: (Sig, Sig))
statusRef <- newGlobalRef (0 :: Sig)
status <- trigByNameMidi name (instr statusRef ref)
writeRef statusRef status
let resStatus = ifB (downsamp status ==* 0) 0 1
(amp, cps) <- readRef ref
return (downsamp amp, downsamp cps, resStatus)
where
instr :: Ref Sig -> Ref (Sig, Sig) -> (D, D, Unit) -> SE Sig
instr statusRef hNote (pitchKey, volKey, _) = do
curId <- readRef statusRef
myIdRef <- newRef (ir curId)
myId <- readRef myIdRef
when1 (curId ==* (sig $ myId + 1)) $ do
writeRef hNote (sig volKey, sig pitchKey)
return 1
midiKeyOn :: MidiChn -> D -> SE (Evt D)
midiKeyOn = midiKeyOnBy . toMidiFun
midiKeyOff :: MidiChn -> D -> SE Tick
midiKeyOff = midiKeyOffBy . toMidiFun
midiKeyOnBy :: MidiFun Sig -> D -> SE (Evt D)
midiKeyOnBy midiFun key = do
chRef <- newGlobalRef (0 :: Sig)
evtRef <- newGlobalRef (0 :: Sig)
writeRef chRef =<< midiFun instr
alwaysOn $ do
a <- readRef chRef
writeRef evtRef $ diff a
evtSig <- readRef evtRef
return $ filterE ( >* 0) $ snaps evtSig
where
instr msg = do
print' [notnum msg]
return $ ifB (boolSig $ notnum msg ==* key) (sig $ ampmidi msg 1) 0
midiKeyOffBy :: MidiFun Sig -> D -> SE Tick
midiKeyOffBy midiFun key = do
chRef <- newGlobalRef (0 :: Sig)
evtRef <- newGlobalRef (0 :: Sig)
writeRef chRef =<< midiFun instr
alwaysOn $ do
a <- readRef chRef
writeRef evtRef $ diff a
evtSig <- readRef evtRef
return $ fmap (const unit) $ filterE ( `lessThan` 0) $ snaps evtSig
where
instr msg = do
print' [notnum msg]
return $ ifB (boolSig $ notnum msg ==* key) (sig $ ampmidi msg 1) 0
initc7 :: D -> D -> D -> SE ()
initc7 = initMidiCtrl
midiCtrl7 :: D -> D -> D -> D -> D -> SE Sig
midiCtrl7 chno ctrlno ival imin imax = do
initc7 chno ctrlno ival
return $ ctrl7 chno ctrlno imin imax
midiCtrl :: D -> D -> D -> SE Sig
midiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival (1) 1
umidiCtrl :: D -> D -> D -> SE Sig
umidiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival 0 1
tryMidi :: (MidiInstr a, Sigs (MidiInstrOut a)) => a -> SE (MidiInstrOut a)
tryMidi x = midi $ onMsg x
tryMidi' :: (MidiInstrTemp a, Sigs (MidiInstrOut a)) => Temp -> a -> SE (MidiInstrOut a)
tryMidi' tm x = midi $ onMsg' tm x