]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Translator/Message.hs
Add a warning about Jack in the README.
[tmp/julm/arpeggigon.git] / 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)))