]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RMCA/Unknown/Arpeggiated.hs
System producing sound apparently correctly (though this needs verification).
[tmp/julm/arpeggigon.git] / RMCA / Unknown / Arpeggiated.hs
1 {-# LANGUAGE Arrows #-}
2
3 module Arpeggiated where
4
5 import FRP.Yampa
6
7 import MIDI
8 import Note
9
10 arpeggiated :: SF (ControllerValue, Event Note) (Event Note)
11 arpeggiated = proc (c,n) -> do
12 non <- uncurry gate ^<< identity &&& arr (event False isOn) -< n
13 non' <- fmap majorThird ^<< delayEvent t -< non
14 non'' <- fmap perfectFifth ^<< delayEvent t -< non'
15 (nof',
16 nof'') <- makeOff *** makeOff -< (non',non'')
17 -- It's assumed that the NoteOff event corresponding to n will be
18 -- emitted.
19 returnA -< mergeEvents [n, non, non', nof', non'', nof'']
20 where onoffGap = 0.9*t
21 t = 100000
22 makeOff = delayEvent onoffGap <<^ fmap switchOnOff