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 Data.Word (Word8, Word32, )
import Data.Int (Int32, )
import qualified Data.Accessor.Basic as Acc
import Data.Accessor.Basic ((^.), )
import Data.Tuple.HT (mapSnd, )
toChannel :: Word8 -> Channel
toChannel = ChannelMsg.toChannel . fromIntegral
fromChannel :: Channel -> Word8
fromChannel = fromIntegral . ChannelMsg.fromChannel
toPitch :: Word8 -> Pitch
toPitch = ChannelMsg.toPitch . fromIntegral
fromPitch :: Pitch -> Word8
fromPitch = fromIntegral . ChannelMsg.fromPitch
toVelocity :: Word8 -> Velocity
toVelocity = ChannelMsg.toVelocity . fromIntegral
fromVelocity :: Velocity -> Word8
fromVelocity = 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.toVelocity VoiceMsg.normalVelocity)
else (Event.NoteOn, velocity)
_ -> nv
normalNoteFromEvent :: Event.NoteEv -> Event.Note -> (Event.NoteEv, Velocity)
normalNoteFromEvent notePart note =
normalizeNote (notePart, note ^. noteVelocity)
toController :: Word32 -> Controller
toController = ChannelMsg.toController . fromIntegral
fromController :: Controller -> Word32
fromController = fromIntegral . ChannelMsg.fromController
toProgram :: Int32 -> Program
toProgram = ChannelMsg.toProgram . fromIntegral
fromProgram :: Program -> Int32
fromProgram = fromIntegral . ChannelMsg.fromProgram
noteEvent ::
Channel -> Pitch -> Velocity -> Velocity -> Word32 ->
Event.Note
noteEvent chan pitch velOn velOff dur =
Event.Note
(fromChannel chan)
(fromPitch pitch)
(fromVelocity velOn)
(fromVelocity velOff)
dur
controllerEvent ::
Channel -> Controller -> Int32 ->
Event.Ctrl
controllerEvent chan ctrl value =
Event.Ctrl
(fromChannel chan)
(fromController ctrl)
value
programChangeEvent ::
Channel -> Program ->
Event.Ctrl
programChangeEvent chan pgm =
Event.Ctrl
(fromChannel chan)
0
(fromProgram pgm)
modeEvent ::
Channel -> Mode.T ->
Event.Ctrl
modeEvent chan m =
case Mode.toControllerValue m of
(param,value) ->
Event.Ctrl
(fromChannel chan)
param
(fromIntegral 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 ->
mapSnd fromIntegral $ Mode.toControllerValue m
in ctrl{Event.ctrlParam = p,
Event.ctrlValue = v})
(\ctrl ->
let c = Event.ctrlParam ctrl
in if c<0x78
then Controller (ctrl ^. ctrlController) (ctrl ^. ctrlValue)
else Mode $ snd $ Mode.fromControllerValue
(fromIntegral $ Event.ctrlParam ctrl,
Event.ctrlValue ctrl))
ctrlValue :: Acc.T Event.Ctrl Int
ctrlValue =
Acc.fromSetGet
(\x ctrl -> ctrl{Event.ctrlValue = fromIntegral x})
(fromIntegral . Event.ctrlValue)
ctrlProgram :: Acc.T Event.Ctrl Program
ctrlProgram =
Acc.fromSetGet
(\p ctrl -> ctrl{Event.ctrlValue = fromProgram p})
(toProgram . Event.ctrlValue)