]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RMCA/Unknown/MIDI.hs
Tile adding supported.
[tmp/julm/arpeggigon.git] / RMCA / Unknown / MIDI.hs
1 module MIDI ( EventQueue
2 , SampleRate
3 , Pitch
4 , toPitch
5 , fromPitch
6 , fromVelocity
7 , toVelocity
8 , Velocity
9 , Message ( NoteOn
10 , NoteOff
11 , Control
12 )
13 , fromRawMessage
14 , toRawMessage
15 , ControllerIdx
16 , ControllerValue
17 ) where
18
19 import qualified Sound.MIDI.Message as Message
20
21 import Sound.MIDI.Message.Channel.Voice ( fromPitch
22 , toPitch
23 , fromVelocity
24 , toVelocity
25 )
26 import qualified Sound.MIDI.Message.Channel as Channel
27 import qualified Sound.MIDI.Message.Channel.Voice as Voice
28 import Data.Map (Map)
29 import FRP.Yampa
30
31 type EventQueue = Map Time Message
32
33 type SampleRate = Int
34
35 type RawMessage = Message.T
36
37 {-
38 class Message a where
39 fromMessage :: RawMessage -> Maybe a
40 toMessage :: a -> RawMessage
41 -}
42
43 type MidiVoice = Voice.T
44
45 type Channel = Channel.Channel
46 type Pitch = Voice.Pitch
47 type Velocity = Voice.Velocity
48
49 type ControllerIdx = Voice.Controller
50 type ControllerValue = Int
51
52 data Message = NoteOn Channel Pitch Velocity
53 | NoteOff Channel Pitch Velocity
54 | Control Channel ControllerIdx ControllerValue
55 deriving(Show)
56
57 fromRawMessage :: RawMessage -> Maybe Message
58 fromRawMessage (Message.Channel (Channel.Cons c
59 (Channel.Voice (Voice.NoteOn p v)))) = Just $ NoteOn c p v
60 fromRawMessage (Message.Channel (Channel.Cons c
61 (Channel.Voice (Voice.NoteOff p v)))) = Just $ NoteOff c p v
62 fromRawMessage (Message.Channel (Channel.Cons c
63 (Channel.Voice (Voice.Control n v)))) = Just $ Control c n v
64 fromRawMessage _ = Nothing
65
66 toRawMessage :: Message -> RawMessage
67 toRawMessage (NoteOn c p v) = (Message.Channel $ Channel.Cons c
68 (Channel.Voice $ Voice.NoteOn p v))
69 toRawMessage (NoteOff c p v) = (Message.Channel $ Channel.Cons c
70 (Channel.Voice $ Voice.NoteOff p v))
71 toRawMessage (Control c n v) = (Message.Channel (Channel.Cons c
72 (Channel.Voice (Voice.Control n v))))
73
74 {-
75 instance Message Note where
76 fromMessage (Message.Channel (Channel.Cons c
77 (Channel.Voice (Voice.NoteOn p v)))) = Just $ NoteOn c p v
78 fromMessage (Message.Channel (Channel.Cons c
79 (Channel.Voice (Voice.NoteOff p v)))) = Just $ NoteOff c p v
80 fromMessage _ = Nothing
81 toMessage (NoteOn c p v) = (Message.Channel $ Channel.Cons c
82 (Channel.Voice $ Voice.NoteOn p v))
83 toMessage (NoteOff c p v) = (Message.Channel $ Channel.Cons c
84 (Channel.Voice $ Voice.NoteOff p v))
85 {-
86 instance Voice Note where
87 fromVoice (Voice.NoteOn p v) = Just $ NoteOn p v
88 fromVoice (Voice.NoteOff p v) = Just $ NoteOff p v
89 fromVoice _ = Nothing
90 toVoice (NoteOn p v) = Voice.NoteOn p v
91 toVoice (NoteOff p v) = Voice.NoteOff p v
92 -}
93 -}
94 {-
95
96 data Control = Control ControllerIdx ControllerValue
97 -}
98 {-
99 instance Voice Control where
100 fromVoice (Voice.Control i v) = Just $ Control i v
101 fromVoice _ = Nothing
102 toVoice (Control i v) = Voice.Control i v
103 -}