Reactogon/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 {-
  50 class (Message a) => Voice a where
  51   fromVoice :: MidiVoice -> Maybe a
  52   toVoice :: a -> MidiVoice
  53 -}
  54
  55 type ControllerIdx = Voice.Controller
  56 type ControllerValue = Int
  57
  58 data Message = NoteOn  Channel Pitch Velocity
  59              | NoteOff Channel Pitch Velocity
  60              | Control Channel ControllerIdx ControllerValue
  61   deriving(Show)
  62
  63 fromRawMessage :: RawMessage -> Maybe Message
  64 fromRawMessage (Message.Channel (Channel.Cons c
  65                                  (Channel.Voice (Voice.NoteOn  p v)))) = Just $ NoteOn  c p v
  66 fromRawMessage (Message.Channel (Channel.Cons c
  67                                  (Channel.Voice (Voice.NoteOff p v)))) = Just $ NoteOff c p v
  68 fromRawMessage _ = Nothing
  69
  70 toRawMessage :: Message -> RawMessage
  71 toRawMessage (NoteOn  c p v) = (Message.Channel $ Channel.Cons c
  72                                (Channel.Voice $ Voice.NoteOn  p v))
  73 toRawMessage (NoteOff c p v) = (Message.Channel $ Channel.Cons c
  74                                (Channel.Voice $ Voice.NoteOff p v))
  75
  76 {-
  77 instance Message Note where
  78   fromMessage (Message.Channel (Channel.Cons c
  79                (Channel.Voice (Voice.NoteOn  p v)))) = Just $ NoteOn  c p v
  80   fromMessage (Message.Channel (Channel.Cons c
  81                (Channel.Voice (Voice.NoteOff p v)))) = Just $ NoteOff c p v
  82   fromMessage _ = Nothing
  83   toMessage (NoteOn  c p v) = (Message.Channel $ Channel.Cons c
  84                                (Channel.Voice $ Voice.NoteOn  p v))
  85   toMessage (NoteOff c p v) = (Message.Channel $ Channel.Cons c
  86                                (Channel.Voice $ Voice.NoteOff p v))
  87 {-
  88 instance Voice Note where
  89   fromVoice (Voice.NoteOn  p v) = Just $ NoteOn  p v
  90   fromVoice (Voice.NoteOff p v) = Just $ NoteOff p v
  91   fromVoice _ = Nothing
  92   toVoice (NoteOn  p v) = Voice.NoteOn  p v
  93   toVoice (NoteOff p v) = Voice.NoteOff p v
  94 -}
  95 -}
  96 {-
  97
  98 data Control = Control ControllerIdx ControllerValue
  99 -}
 100 {-
 101 instance Voice Control where
 102   fromVoice (Voice.Control i v) = Just $ Control i v
 103   fromVoice _ = Nothing
 104   toVoice (Control i v) = Voice.Control i v
 105 -}