]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Translator/Message.hs
Solved side RV problem.
[tmp/julm/arpeggigon.git] / src / RMCA / Translator / Message.hs
1 module RMCA.Translator.Message where
2
3 import RMCA.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 -- We might want to move that to Semantics.
9 type SampleRate = Int
10
11 type RawMessage = Message.T
12
13 type MidiVoice = Voice.T
14
15 type Channel = Channel.Channel
16
17 type ControllerIdx = Voice.Controller
18
19 type Frames = Int
20
21 -- Each channel is linked to a particular translation signal function
22 -- itself linked to a particular layer. Therefore we will dispose of
23 -- the channel number as soon as possible.
24 ---
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
29 deriving(Show)
30
31 getChannel :: Message -> Int
32 getChannel (NoteOn c _ _) = Channel.fromChannel c
33 getChannel (NoteOff c _ _) = Channel.fromChannel c
34 getChannel (Control c _ _) = Channel.fromChannel c
35
36 makeChannel :: Int -> Channel
37 makeChannel = Channel.toChannel
38
39 -- Function to go back and forth with the representations of pitches,
40 -- as they are different in our model and in the Jack API model.
41 fromRawPitch :: Voice.Pitch -> Pitch
42 fromRawPitch p = Pitch $ Voice.fromPitch p
43
44 toRawPitch :: Pitch -> Voice.Pitch
45 toRawPitch (Pitch p) = Voice.toPitch p
46
47
48 isNoteOn :: Message -> Bool
49 isNoteOn NoteOn {} = True
50 isNoteOn _ = False
51
52 isNoteOff :: Message -> Bool
53 isNoteOff NoteOff {} = True
54 isNoteOff _ = False
55
56 isControl :: Message -> Bool
57 isControl Control {} = True
58 isControl _ = False
59
60 switchOnOff :: Message -> Message
61 switchOnOff (NoteOn c p v) = NoteOff c p v
62 switchOnOff (NoteOff c p v) = NoteOn c p v
63 switchOnOff m = error $ "The message " ++ show m ++ " is not a note message"
64
65 fromRawMessage :: RawMessage -> Maybe Message
66 fromRawMessage (Message.Channel (Channel.Cons c
67 (Channel.Voice (Voice.NoteOn p v)))) =
68 Just $ NoteOn c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
69 fromRawMessage (Message.Channel (Channel.Cons c
70 (Channel.Voice (Voice.NoteOff p v)))) =
71 Just $ NoteOff c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
72 fromRawMessage (Message.Channel (Channel.Cons c
73 (Channel.Voice (Voice.Control n v)))) =
74 Just $ Control c n (toUCtrl v)
75 fromRawMessage _ = Nothing
76
77 toRawMessage :: Message -> RawMessage
78 toRawMessage (NoteOn c p v) =
79 Message.Channel $ Channel.Cons c
80 (Channel.Voice $ Voice.NoteOn (toRawPitch p) (Voice.toVelocity $ fromUCtrl v))
81 toRawMessage (NoteOff c p v) =
82 Message.Channel $ Channel.Cons c
83 (Channel.Voice $ Voice.NoteOff (toRawPitch p) (Voice.toVelocity $ fromUCtrl v))
84 toRawMessage (Control c n v) =
85 Message.Channel (Channel.Cons c
86 (Channel.Voice (Voice.Control n (fromUCtrl v))))