Reactogon/Translator/Message.hs

   1 module Reactogon.Translator.Message ( SampleRate
   2                                     , RawMessage
   3                                     ) where
   4
   5 import           Reactogon.Semantics
   6 import qualified Sound.MIDI.Message               as Message
   7 import qualified Sound.MIDI.Message.Channel       as Channel
   8 import qualified Sound.MIDI.Message.Channel.Voice as Voice
   9
  10 type SampleRate = Int
  11
  12 type RawMessage = Message.T
  13
  14 type MidiVoice = Voice.T
  15
  16 type Channel = Channel.Channel
  17
  18 type ControllerIdx = Voice.Controller
  19
  20 -- Each channel is linked to a particular translation signal function
  21 -- itself linked to a particular layer. Therefore we will dispose of
  22 -- the channel number as soon as possible.
  23 -- !!! This is dangerous as it only treats unipolar control values.
  24 data Message = NoteOn  Channel Pitch Strength
  25              | NoteOff Channel Pitch Strength
  26              | Control Channel ControllerIdx UCtrl
  27   deriving(Show)
  28
  29 -- Function to go back and forth with the representations of pitches,
  30 -- as they are different in our model and in the Jack API model.
  31 fromRawPitch :: Voice.Pitch -> Pitch
  32 fromRawPitch p = Pitch $ Voice.fromPitch p
  33
  34 toRawPitch :: Pitch -> Voice.Pitch
  35 toRawPitch (Pitch p) = Voice.toPitch p
  36
  37
  38 isNoteOn :: Message -> Bool
  39 isNoteOn (NoteOn _ _ _) = True
  40 isNoteOn _ = False
  41
  42 isNoteOff :: Message -> Bool
  43 isNoteOff (NoteOff _ _ _) = True
  44 isNoteOff _ = False
  45
  46 isControl :: Message -> Bool
  47 isControl (Control _ _ _) = True
  48 isControl _ = False
  49
  50 fromRawMessage :: RawMessage -> Maybe Message
  51 fromRawMessage (Message.Channel (Channel.Cons c
  52                                  (Channel.Voice (Voice.NoteOn  p v)))) =
  53   Just $ NoteOn  c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
  54 fromRawMessage (Message.Channel (Channel.Cons c
  55                                  (Channel.Voice (Voice.NoteOff p v)))) =
  56   Just $ NoteOff c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
  57 fromRawMessage (Message.Channel (Channel.Cons c
  58                                  (Channel.Voice (Voice.Control n v)))) =
  59   Just $ Control c n (toUCtrl v)
  60 fromRawMessage _ = Nothing
  61
  62 toRawMessage :: Message -> RawMessage
  63 toRawMessage (NoteOn  c p v) =
  64   (Message.Channel $ Channel.Cons c
  65     (Channel.Voice $ Voice.NoteOn  (toRawPitch p) (Voice.toVelocity $ fromUCtrl v)))
  66 toRawMessage (NoteOff c p v) =
  67   (Message.Channel $ Channel.Cons c
  68     (Channel.Voice $ Voice.NoteOff (toRawPitch p) (Voice.toVelocity $ fromUCtrl v)))
  69 toRawMessage (Control c n v) =
  70   (Message.Channel (Channel.Cons c
  71                      (Channel.Voice (Voice.Control n (fromUCtrl v)))))