]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RCMA/Translator/Message.hs
Moved Reactogon to RCMA.
[tmp/julm/arpeggigon.git] / 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)))))