]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RMCA/Translator/Message.hs
Tile adding supported.
[tmp/julm/arpeggigon.git] / RMCA / Translator / Message.hs
1 module RMCA.Translator.Message where
2
3 import RMCA.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 = 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 | 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 makeChannel :: Int -> Channel
38 makeChannel = Channel.toChannel
39
40 -- Function to go back and forth with the representations of pitches,
41 -- as they are different in our model and in the Jack API model.
42 fromRawPitch :: Voice.Pitch -> Pitch
43 fromRawPitch p = Pitch $ Voice.fromPitch p
44
45 toRawPitch :: Pitch -> Voice.Pitch
46 toRawPitch (Pitch p) = Voice.toPitch p
47
48
49 isNoteOn :: Message -> Bool
50 isNoteOn NoteOn {} = True
51 isNoteOn _ = False
52
53 isNoteOff :: Message -> Bool
54 isNoteOff NoteOff {} = True
55 isNoteOff _ = False
56
57 isControl :: Message -> Bool
58 isControl Control {} = True
59 isControl _ = False
60
61 switchOnOff :: Message -> Message
62 switchOnOff (NoteOn c p v) = NoteOff c p v
63 switchOnOff (NoteOff c p v) = NoteOn c p v
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))))