Reactogon/Translator/MIDI.hs

   1 module MIDI ( EventQueue
   2             , SampleRate
   3             , Pitch
   4             , toPitch
   5             , fromPitch
   6             , fromVelocity
   7             , toVelocity
   8             , Velocity
   9             , Message ( NoteOn
  10                       , NoteOff
  11                       , Control
  12                       )
  13             , fromRawMessage
  14             , toRawMessage
  15             , ControllerIdx
  16             , ControllerValue
  17             ) where
  18
  19 import qualified Sound.MIDI.Message as Message
  20
  21 import Sound.MIDI.Message.Channel.Voice ( fromPitch
  22                                         , toPitch
  23                                         , fromVelocity
  24                                         , toVelocity
  25                                         )
  26 import qualified Sound.MIDI.Message.Channel as Channel
  27 import qualified Sound.MIDI.Message.Channel.Voice as Voice
  28 import Data.Map (Map)
  29 import FRP.Yampa
  30
  31 type EventQueue = Map Time Message
  32
  33 type SampleRate = Int
  34
  35 type RawMessage = Message.T
  36
  37 {-
  38 class Message a where
  39   fromMessage :: RawMessage -> Maybe a
  40   toMessage :: a -> RawMessage
  41 -}
  42
  43 type MidiVoice = Voice.T
  44
  45 type Channel = Channel.Channel
  46 type Pitch = Voice.Pitch
  47 type Velocity = Voice.Velocity
  48
  49 type ControllerIdx = Voice.Controller
  50 type ControllerValue = Int
  51
  52 data Message = NoteOn  Channel Pitch Velocity
  53              | NoteOff Channel Pitch Velocity
  54              | Control Channel ControllerIdx ControllerValue
  55   deriving(Show)
  56
  57 fromRawMessage :: RawMessage -> Maybe Message
  58 fromRawMessage (Message.Channel (Channel.Cons c
  59                                  (Channel.Voice (Voice.NoteOn  p v)))) = Just $ NoteOn  c p v
  60 fromRawMessage (Message.Channel (Channel.Cons c
  61                                  (Channel.Voice (Voice.NoteOff p v)))) = Just $ NoteOff c p v
  62 fromRawMessage (Message.Channel (Channel.Cons c
  63                                  (Channel.Voice (Voice.Control n v)))) = Just $ Control c n v
  64 fromRawMessage _ = Nothing
  65
  66 toRawMessage :: Message -> RawMessage
  67 toRawMessage (NoteOn  c p v) = (Message.Channel $ Channel.Cons c
  68                                (Channel.Voice $ Voice.NoteOn  p v))
  69 toRawMessage (NoteOff c p v) = (Message.Channel $ Channel.Cons c
  70                                (Channel.Voice $ Voice.NoteOff p v))
  71 toRawMessage (Control c n v) = (Message.Channel (Channel.Cons c
  72                                                    (Channel.Voice (Voice.Control n v))))
  73
  74 {-
  75 instance Message Note where
  76   fromMessage (Message.Channel (Channel.Cons c
  77                (Channel.Voice (Voice.NoteOn  p v)))) = Just $ NoteOn  c p v
  78   fromMessage (Message.Channel (Channel.Cons c
  79                (Channel.Voice (Voice.NoteOff p v)))) = Just $ NoteOff c p v
  80   fromMessage _ = Nothing
  81   toMessage (NoteOn  c p v) = (Message.Channel $ Channel.Cons c
  82                                (Channel.Voice $ Voice.NoteOn  p v))
  83   toMessage (NoteOff c p v) = (Message.Channel $ Channel.Cons c
  84                                (Channel.Voice $ Voice.NoteOff p v))
  85 {-
  86 instance Voice Note where
  87   fromVoice (Voice.NoteOn  p v) = Just $ NoteOn  p v
  88   fromVoice (Voice.NoteOff p v) = Just $ NoteOff p v
  89   fromVoice _ = Nothing
  90   toVoice (NoteOn  p v) = Voice.NoteOn  p v
  91   toVoice (NoteOff p v) = Voice.NoteOff p v
  92 -}
  93 -}
  94 {-
  95
  96 data Control = Control ControllerIdx ControllerValue
  97 -}
  98 {-
  99 instance Voice Control where
 100   fromVoice (Voice.Control i v) = Just $ Control i v
 101   fromVoice _ = Nothing
 102   toVoice (Control i v) = Voice.Control i v
 103 -}