src/RMCA/Translator/Message.hs

   1 module RMCA.Translator.Message where
   2
   3 import           RMCA.Semantics
   4 import           Sound.MIDI.Controller            (volume)
   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 = Int
  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              | Instrument Channel Voice.Program
  30              | Volume Channel Int
  31              -- | Control Channel ControllerIdx UCtrl
  32   deriving(Show)
  33
  34 getChannel :: Message -> Int
  35 getChannel (NoteOn c _ _) = Channel.fromChannel c
  36 getChannel (NoteOff c _ _) = Channel.fromChannel c
  37 getChannel (Volume c _) = Channel.fromChannel c
  38 --getChannel (Control c _) = Channel.fromChannel c
  39 getChannel (Instrument c _ ) = Channel.fromChannel c
  40
  41 mkChannel :: Int -> Channel
  42 mkChannel = Channel.toChannel
  43
  44 fromChannel :: Channel -> Int
  45 fromChannel = Channel.fromChannel
  46
  47 mkProgram :: Int -> Channel.Program
  48 mkProgram = Channel.toProgram
  49
  50 fromProgram :: Channel.Program -> Int
  51 fromProgram = Channel.fromProgram
  52
  53 -- Function to go back and forth with the representations of pitches,
  54 -- as they are different in our model and in the Jack API model.
  55 fromRawPitch :: Voice.Pitch -> Pitch
  56 fromRawPitch p = Pitch $ Voice.fromPitch p
  57
  58 toRawPitch :: Pitch -> Voice.Pitch
  59 toRawPitch (Pitch p) = Voice.toPitch p
  60
  61 isNoteOn :: Message -> Bool
  62 isNoteOn NoteOn {} = True
  63 isNoteOn _ = False
  64
  65 isNoteOff :: Message -> Bool
  66 isNoteOff NoteOff {} = True
  67 isNoteOff _ = False
  68
  69 isVolume :: Message -> Bool
  70 isVolume Volume {} = True
  71 isVolume _ = False
  72
  73 isInstrument :: Message -> Bool
  74 isInstrument Instrument {} = True
  75 isInstrument _ = False
  76
  77 switchOnOff :: Message -> Message
  78 switchOnOff (NoteOn  c p v) = NoteOff c p v
  79 switchOnOff (NoteOff c p v) = NoteOn  c p v
  80 switchOnOff m = error $ "The message " ++ show m ++ " is not a note message"
  81
  82 fromRawMessage :: RawMessage -> Maybe Message
  83 fromRawMessage (Message.Channel (Channel.Cons c
  84                                  (Channel.Voice (Voice.NoteOn  p v)))) =
  85   Just $ NoteOn  c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
  86 fromRawMessage (Message.Channel (Channel.Cons c
  87                                  (Channel.Voice (Voice.NoteOff p v)))) =
  88   Just $ NoteOff c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
  89 fromRawMessage (Message.Channel (Channel.Cons c
  90                                  (Channel.Voice (Voice.ProgramChange p)))) =
  91   Just $ Instrument c p
  92 fromRawMessage (Message.Channel (Channel.Cons c
  93                                  (Channel.Voice (Voice.Control n v))))
  94   | n == volume = Just $ Volume c v
  95   | otherwise = Nothing
  96 fromRawMessage _ = Nothing
  97
  98 toRawMessage :: Message -> RawMessage
  99 toRawMessage (NoteOn  c p v) =
 100   Message.Channel $ Channel.Cons c
 101   (Channel.Voice $ Voice.NoteOn  (toRawPitch p) (Voice.toVelocity $ fromUCtrl v))
 102 toRawMessage (NoteOff c p v) =
 103   Message.Channel $ Channel.Cons c
 104   (Channel.Voice $ Voice.NoteOff (toRawPitch p) (Voice.toVelocity $ fromUCtrl v))
 105 toRawMessage (Volume c v) =
 106   Message.Channel (Channel.Cons c
 107                     (Channel.Voice (Voice.Control volume v)))
 108 toRawMessage (Instrument c p) =
 109   Message.Channel (Channel.Cons c
 110                     (Channel.Voice (Voice.ProgramChange p)))