module Sound.MIDI.ALSA where
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Sound.MIDI.Message.Channel.Mode as Mode
import Sound.MIDI.Message.Channel (Channel, )
import Sound.MIDI.Message.Channel.Voice (Velocity, Pitch, Controller, Program, )
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Data.Accessor.Basic as Acc
import Data.Accessor.Basic ((^.), )
import Data.Tuple.HT (mapPair, )
toChannel :: Event.Channel -> Channel
toChannel = ChannelMsg.toChannel . fromIntegral . Event.unChannel
fromChannel :: Channel -> Event.Channel
fromChannel = Event.Channel . fromIntegral . ChannelMsg.fromChannel
toPitch :: Event.Pitch -> Pitch
toPitch = ChannelMsg.toPitch . fromIntegral . Event.unPitch
fromPitch :: Pitch -> Event.Pitch
fromPitch = Event.Pitch . fromIntegral . ChannelMsg.fromPitch
toVelocity :: Event.Velocity -> Velocity
toVelocity = ChannelMsg.toVelocity . fromIntegral . Event.unVelocity
fromVelocity :: Velocity -> Event.Velocity
fromVelocity = Event.Velocity . fromIntegral . ChannelMsg.fromVelocity
normalizeNote :: (Event.NoteEv, Velocity) -> (Event.NoteEv, Velocity)
normalizeNote nv@(notePart,velocity) =
case notePart of
Event.NoteOn ->
if velocity == VoiceMsg.toVelocity 0
then (Event.NoteOff, VoiceMsg.normalVelocity)
else (Event.NoteOn, velocity)
_ -> nv
normalNoteFromEvent :: Event.NoteEv -> Event.Note -> (Event.NoteEv, Velocity)
normalNoteFromEvent notePart note =
normalizeNote (notePart, note ^. noteVelocity)
toController :: Event.Parameter -> Controller
toController = ChannelMsg.toController . fromIntegral . Event.unParameter
fromController :: Controller -> Event.Parameter
fromController = Event.Parameter . fromIntegral . ChannelMsg.fromController
toProgram :: Event.Value -> Program
toProgram = ChannelMsg.toProgram . fromIntegral . Event.unValue
fromProgram :: Program -> Event.Value
fromProgram = Event.Value . fromIntegral . ChannelMsg.fromProgram
noteEvent ::
Channel -> Pitch -> Velocity -> Velocity -> Int ->
Event.Note
noteEvent chan pitch velOn velOff dur =
Event.Note
(fromChannel chan)
(fromPitch pitch)
(fromVelocity velOn)
(fromVelocity velOff)
(Event.Duration $ fromIntegral dur)
controllerEvent ::
Channel -> Controller -> Int ->
Event.Ctrl
controllerEvent chan ctrl value =
Event.Ctrl
(fromChannel chan)
(fromController ctrl)
(Event.Value $ fromIntegral value)
programChangeEvent ::
Channel -> Program ->
Event.Ctrl
programChangeEvent chan pgm =
Event.Ctrl
(fromChannel chan)
(Event.Parameter 0)
(fromProgram pgm)
modeEvent ::
Channel -> Mode.T ->
Event.Ctrl
modeEvent chan m =
case Mode.toControllerValue m of
(param,value) ->
Event.Ctrl
(fromChannel chan)
(Event.Parameter $ fromIntegral param)
(Event.Value value)
noteChannel :: Acc.T Event.Note Channel
noteChannel =
Acc.fromSetGet
(\c note -> note{Event.noteChannel = fromChannel c})
(toChannel . Event.noteChannel)
notePitch :: Acc.T Event.Note Pitch
notePitch =
Acc.fromSetGet
(\p note -> note{Event.noteNote = fromPitch p})
(toPitch . Event.noteNote)
noteVelocity :: Acc.T Event.Note Velocity
noteVelocity =
Acc.fromSetGet
(\v note -> note{Event.noteVelocity = fromVelocity v})
(toVelocity . Event.noteVelocity)
ctrlChannel :: Acc.T Event.Ctrl Channel
ctrlChannel =
Acc.fromSetGet
(\c ctrl -> ctrl{Event.ctrlChannel = fromChannel c})
(toChannel . Event.ctrlChannel)
ctrlController :: Acc.T Event.Ctrl Controller
ctrlController =
Acc.fromSetGet
(\c ctrl -> ctrl{Event.ctrlParam = fromController c})
(toController . Event.ctrlParam)
data ControllerMode =
Controller Controller Int
| Mode Mode.T
deriving (Show, Eq)
ctrlControllerMode :: Acc.T Event.Ctrl ControllerMode
ctrlControllerMode =
Acc.fromSetGet
(\cm ctrl ->
let (p,v) =
case cm of
Controller c x ->
(fromController c, fromIntegral x)
Mode m ->
mapPair (Event.Parameter, fromIntegral) $
Mode.toControllerValue m
in ctrl{Event.ctrlParam = p,
Event.ctrlValue = Event.Value v})
(\ctrl ->
let c = Event.ctrlParam ctrl
in if c < Event.Parameter 0x78
then Controller (ctrl ^. ctrlController) (ctrl ^. ctrlValue)
else Mode $ snd $ Mode.fromControllerValue
(Event.unParameter $ Event.ctrlParam ctrl,
fromIntegral $ Event.unValue $ Event.ctrlValue ctrl))
ctrlValue :: Acc.T Event.Ctrl Int
ctrlValue =
Acc.fromSetGet
(\x ctrl -> ctrl{Event.ctrlValue = Event.Value $ fromIntegral x})
(fromIntegral . Event.unValue . Event.ctrlValue)
ctrlProgram :: Acc.T Event.Ctrl Program
ctrlProgram =
Acc.fromSetGet
(\p ctrl -> ctrl{Event.ctrlValue = fromProgram p})
(toProgram . Event.ctrlValue)