Safe Haskell | None |
---|---|
Language | Haskell2010 |
Midi.
Synopsis
- data MidiChn
- type MidiFun a = (Msg -> SE a) -> SE a
- toMidiFun :: Sigs a => MidiChn -> MidiFun a
- toMidiFun_ :: MidiChn -> MidiFun ()
- data Msg
- type Channel = Int
- midi :: (Num a, Sigs a) => (Msg -> SE a) -> SE a
- midin :: (Num a, Sigs a) => Channel -> (Msg -> SE a) -> SE a
- pgmidi :: (Num a, Sigs a) => Maybe Int -> Channel -> (Msg -> SE a) -> SE a
- ampCps :: Msg -> (D, D)
- midi_ :: (Msg -> SE ()) -> SE ()
- midin_ :: Channel -> (Msg -> SE ()) -> SE ()
- pgmidi_ :: Maybe Int -> Channel -> (Msg -> SE ()) -> SE ()
- monoMsg :: MidiChn -> D -> D -> SE (Sig, Sig)
- holdMsg :: MidiChn -> D -> SE (Sig, Sig)
- trigNamedMono :: String -> SE MonoArg
- genMonoMsg :: MidiChn -> SE MonoArg
- smoothMonoArg :: D -> MonoArg -> MonoArg
- genFilteredMonoMsg :: MidiChn -> (D -> BoolD) -> SE MonoArg
- genFilteredMonoMsgTemp :: Temp -> MidiChn -> (D -> BoolD) -> SE MonoArg
- monoMsgTemp :: Temp -> MidiChn -> D -> D -> SE (Sig, Sig)
- holdMsgTemp :: Temp -> MidiChn -> D -> SE (Sig, Sig)
- genMonoMsgTemp :: Temp -> MidiChn -> SE MonoArg
- midiKeyOn :: MidiChn -> D -> SE (Evt D)
- midiKeyOff :: MidiChn -> D -> SE Tick
- cpsmidi :: Msg -> D
- ampmidi :: Msg -> D -> D
- initc7 :: D -> D -> D -> SE ()
- ctrl7 :: D -> D -> D -> D -> Sig
- midiCtrl7 :: D -> D -> D -> D -> D -> SE Sig
- midiCtrl :: D -> D -> D -> SE Sig
- umidiCtrl :: D -> D -> D -> SE Sig
- midiCtrl7A :: D -> D -> D -> D -> D -> SE Sig
- midiCtrlA :: D -> D -> D -> SE Sig
- umidiCtrlA :: D -> D -> D -> SE Sig
- ampmidinn :: (D, D) -> D -> D
- ampCps' :: Temp -> Msg -> (D, D)
- cpsmidi' :: Temp -> Msg -> D
- cpsmidi'D :: Temp -> D -> D
- cpsmidi'Sig :: Temp -> Sig -> Sig
- tryMidi :: (MidiInstr a, Sigs (MidiInstrOut a)) => a -> SE (MidiInstrOut a)
- tryMidi' :: (MidiInstrTemp a, Sigs (MidiInstrOut a)) => Temp -> a -> SE (MidiInstrOut a)
- class MidiInstr a where
- type MidiInstrOut a :: *
- onMsg :: a -> Msg -> SE (MidiInstrOut a)
- class MidiInstr a => MidiInstrTemp a where
- onMsg' :: Temp -> a -> Msg -> SE (MidiInstrOut a)
- namedAmpCpsSig :: String -> SE (Sig, Sig, Sig)
Documentation
Specifies the midi channel or programm.
toMidiFun_ :: MidiChn -> MidiFun () Source #
Instances
midi :: (Num a, Sigs a) => (Msg -> SE a) -> SE a #
Triggers a midi-instrument (aka Csound's massign) for all channels. It's useful to test a single instrument.
midin :: (Num a, Sigs a) => Channel -> (Msg -> SE a) -> SE a #
Triggers a midi-instrument (aka Csound's massign) on the specified channel.
pgmidi :: (Num a, Sigs a) => Maybe Int -> Channel -> (Msg -> SE a) -> SE a #
Triggers a midi-instrument (aka Csound's pgmassign) on the specified programm bank.
midi_ :: (Msg -> SE ()) -> SE () #
Triggers a midi-procedure (aka Csound's massign) for all channels.
midin_ :: Channel -> (Msg -> SE ()) -> SE () #
Triggers a midi-procedure (aka Csound's pgmassign) on the given channel.
pgmidi_ :: Maybe Int -> Channel -> (Msg -> SE ()) -> SE () #
Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank.
Mono-midi synth
monoMsg :: MidiChn -> D -> D -> SE (Sig, Sig) Source #
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
holdMsg :: MidiChn -> D -> SE (Sig, Sig) Source #
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
trigNamedMono :: String -> SE MonoArg Source #
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)
.
genMonoMsg :: MidiChn -> SE MonoArg Source #
Produces an argument for monophonic midi-synth. The signal fades out when nothing is pressed. It can be used in mono-synths.
genMonoMsg channel
genFilteredMonoMsgTemp :: Temp -> MidiChn -> (D -> BoolD) -> SE MonoArg Source #
Just like mono genMonoMsg
but also we can alter the temperament. The temperament spec goes first.
genMonoMsgTemp temperament channel
Custom temperament
monoMsgTemp :: Temp -> MidiChn -> D -> D -> SE (Sig, Sig) Source #
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
holdMsgTemp :: Temp -> MidiChn -> D -> SE (Sig, Sig) Source #
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
genMonoMsgTemp :: Temp -> MidiChn -> SE MonoArg Source #
Just like mono genMonoMsg
but also we can alter the temperament. The temperament spec goes first.
genMonoMsgTemp temperament channel
Midi event streams
midiKeyOn :: MidiChn -> D -> SE (Evt D) Source #
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).
midiKeyOff :: MidiChn -> D -> SE Tick Source #
Listens to midi on event off the given key as event stream.
Reading midi note parameters
Get the note number of the current MIDI event, expressed in cycles-per-second.
icps cpsmidi
csound doc: http://csound.com/docs/manual/cpsmidi.html
Get the velocity of the current MIDI event.
iamp ampmidi iscal [, ifn]
csound doc: http://csound.com/docs/manual/ampmidi.html
ctrl7 :: D -> D -> D -> D -> Sig #
Allows a floating-point 7-bit MIDI signal scaled with a minimum and a maximum range.
idest ctrl7 ichan, ictlno, imin, imax [, ifn] kdest ctrl7 ichan, ictlno, kmin, kmax [, ifn] adest ctrl7 ichan, ictlno, kmin, kmax [, ifn] [, icutoff]
csound doc: http://csound.com/docs/manual/ctrl7.html
midiCtrl7 :: D -> D -> D -> D -> D -> SE Sig Source #
Initializes control rate midi control and get the value in the specified range.
midiCtrl :: D -> D -> D -> SE Sig Source #
Initializes control rate midi control and get the value in the range (-1) to 1.
umidiCtrl :: D -> D -> D -> SE Sig Source #
Unipolar control rate midiCtrl. Initializes midi control and get the value in the range 0 to 1.
midiCtrl7A :: D -> D -> D -> D -> D -> SE Sig Source #
Initializes audio-rate midi control and get the value in the specified range.
midiCtrlA :: D -> D -> D -> SE Sig Source #
Initializes audio-rate midi control and get the value in the range (-1) to 1.
umidiCtrlA :: D -> D -> D -> SE Sig Source #
Unipolar audio-rate midiCtrl. Initializes midi control and get the value in the range 0 to 1.
ampmidinn :: (D, D) -> D -> D Source #
Converts midi velocity number to amplitude. The first argument is dynamic range in decibels.
ampmidinn (volMinDb, volMaxDb) volumeKey = amplitude
Custom temperament
cpsmidi'D :: Temp -> D -> D Source #
Midi pitch key convertion to Hz with custom temperament. It works on constants.
cpsmidi'Sig :: Temp -> Sig -> Sig Source #
Midi pitch key convertion to Hz with custom temperament. It works on signals.
Overload
tryMidi :: (MidiInstr a, Sigs (MidiInstrOut a)) => a -> SE (MidiInstrOut a) Source #
Invokes ooverloaded instruments with midi. Example:
dac $ tryMidi (mul (fades 0.01 0.1) . tri)
tryMidi' :: (MidiInstrTemp a, Sigs (MidiInstrOut a)) => Temp -> a -> SE (MidiInstrOut a) Source #
Invokes ooverloaded instruments with midi and custom temperament. Example:
dac $ tryMidi' youngTemp2 (mul (fades 0.01 0.1) . tri)
class MidiInstr a where Source #
type MidiInstrOut a :: * Source #
Instances
class MidiInstr a => MidiInstrTemp a where Source #
Converts a value to the midi-instrument with custom temperament.
It's used with the functions midi
, midin
.