1 module Reactogon.Translator.Message where
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
9 -- We might want to move that to Semantics.
12 type RawMessage = Message.T
14 type MidiVoice = Voice.T
16 type Channel = Channel.Channel
18 type ControllerIdx = Voice.Controller
20 type Frames = Jack.NFrames
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 -- !!! This is dangerous as it only treats unipolar control values.
26 data Message = NoteOn Channel Pitch Strength
27 | NoteOff Channel Pitch Strength
28 | Control Channel ControllerIdx UCtrl
31 -- Function to go back and forth with the representations of pitches,
32 -- as they are different in our model and in the Jack API model.
33 fromRawPitch :: Voice.Pitch -> Pitch
34 fromRawPitch p = Pitch $ Voice.fromPitch p
36 toRawPitch :: Pitch -> Voice.Pitch
37 toRawPitch (Pitch p) = Voice.toPitch p
40 isNoteOn :: Message -> Bool
41 isNoteOn (NoteOn _ _ _) = True
44 isNoteOff :: Message -> Bool
45 isNoteOff (NoteOff _ _ _) = True
48 isControl :: Message -> Bool
49 isControl (Control _ _ _) = True
52 fromRawMessage :: RawMessage -> Maybe Message
53 fromRawMessage (Message.Channel (Channel.Cons c
54 (Channel.Voice (Voice.NoteOn p v)))) =
55 Just $ NoteOn c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
56 fromRawMessage (Message.Channel (Channel.Cons c
57 (Channel.Voice (Voice.NoteOff p v)))) =
58 Just $ NoteOff c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
59 fromRawMessage (Message.Channel (Channel.Cons c
60 (Channel.Voice (Voice.Control n v)))) =
61 Just $ Control c n (toUCtrl v)
62 fromRawMessage _ = Nothing
64 toRawMessage :: Message -> RawMessage
65 toRawMessage (NoteOn c p v) =
66 (Message.Channel $ Channel.Cons c
67 (Channel.Voice $ Voice.NoteOn (toRawPitch p) (Voice.toVelocity $ fromUCtrl v)))
68 toRawMessage (NoteOff c p v) =
69 (Message.Channel $ Channel.Cons c
70 (Channel.Voice $ Voice.NoteOff (toRawPitch p) (Voice.toVelocity $ fromUCtrl v)))
71 toRawMessage (Control c n v) =
72 (Message.Channel (Channel.Cons c
73 (Channel.Voice (Voice.Control n (fromUCtrl v)))))