]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - div/little_things/Note.hs
Translation from high to low level progressing. Should be finished soon.
[tmp/julm/arpeggigon.git] / div / little_things / Note.hs
1 module Note where
2
3 import MIDI
4
5 isNoteOn :: Message -> Bool
6 isNoteOn (NoteOn _ _ _) = True
7 isNoteOn _ = False
8
9 isNoteOff :: Message -> Bool
10 isNoteOff (NoteOff _ _ _) = True
11 isNoteOff _ = False
12
13 changePitch :: (Pitch -> Pitch) -> Message-> Message
14 changePitch f (NoteOn c p v) = NoteOn c (f p) v
15 changePitch f (NoteOff c p v) = NoteOff c (f p) v
16
17 changeVelocity :: (Velocity -> Velocity) -> Message-> Message
18 changeVelocity f (NoteOn c p v) = NoteOn c p (f v)
19 changeVelocity f (NoteOff c p v) = NoteOff c p (f v)
20
21 switchOnOff :: Message-> Message
22 switchOnOff (NoteOn c p v) = NoteOff c p v
23 switchOnOff (NoteOff c p v) = NoteOn c p v
24
25 perfectFifth :: Message-> Message
26 perfectFifth = changePitch (toPitch . (+7) . fromPitch)
27
28 majorThird :: Message-> Message
29 majorThird = changePitch (toPitch . (+4) . fromPitch)
30
31 minorThird :: Message-> Message
32 minorThird = changePitch (toPitch . (+3) . fromPitch)