]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RMCA/Translator/Note.hs
Added a few calls to postGUIAsync.
[tmp/julm/arpeggigon.git] / RMCA / Translator / Note.hs
1 {-# LANGUAGE Arrows #-}
2
3 module RMCA.Translator.Note where
4
5 import Data.Ratio
6 import FRP.Yampa
7 import RMCA.Global.Clock
8 import RMCA.Layer.Layer
9 import RMCA.Semantics
10 import RMCA.Translator.Message
11
12 messageToNote :: Message -> Note
13 messageToNote (NoteOn _ p s) = Note { notePch = p
14 , noteStr = s
15 , noteDur = 1 % 4
16 , noteOrn = noOrn
17 }
18
19 -- noteToMessage gives a pair of two time-stamped messages. The one on
20 -- the left is a note message, the other a note off.
21 noteToMessages :: LTempo
22 -> SampleRate
23 -> Int -- Channel number
24 -> (Frames,Note) -- Note to convert
25 -> [(Frames,Message)]
26 noteToMessages layTempo sr chan =
27 proc (t,n@Note { notePch = p
28 , noteStr = s
29 , noteDur = d
30 }) -> do
31 nm <- noteOnToMessage chan -< n
32 let dt = fromRational (d * toRational (tempoToQNoteIvl layTempo))
33 dn = floor $ dt * fromIntegral sr
34 returnA -< [(t,nm),(t + dn,switchOnOff nm)]
35
36 noteOnToMessage :: Int -> Note -> Message
37 noteOnToMessage c Note { notePch = p
38 , noteStr = s
39 } = NoteOn (makeChannel c) p s