RCMA/Translator/Message.hs

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