Reactogon/Translator/Message.hs

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