diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-05 01:50:29 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-05 01:50:29 -0500 |
commit | 8f46e826f188ce7716a87cf98ace41829725f10c (patch) | |
tree | 5723ea667ea7da74704b83ca21c7872c912c10bd | |
parent | 7dd4353d51eec254965ac23de085d829df94c05d (diff) |
Implement delayed output
This just sets the time field on the ALSA packet. It works!
I had planned to do something much more complicated but if this works
out, everything is easy.
-rw-r--r-- | midi-dump.hs | 7 |
1 files changed, 6 insertions, 1 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index 146ac5d..90a1bae 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -28,6 +28,8 @@ import qualified Sound.ALSA.Sequencer | |||
28 | import qualified Sound.ALSA.Sequencer.Address | 28 | import qualified Sound.ALSA.Sequencer.Address |
29 | import qualified Sound.ALSA.Sequencer.Port | 29 | import qualified Sound.ALSA.Sequencer.Port |
30 | import qualified Sound.ALSA.Sequencer.Queue | 30 | import qualified Sound.ALSA.Sequencer.Queue |
31 | import qualified Sound.ALSA.Sequencer.Time as Time | ||
32 | import qualified Sound.ALSA.Sequencer.RealTime as RealTime | ||
31 | 33 | ||
32 | verbose :: Bool | 34 | verbose :: Bool |
33 | verbose = False | 35 | verbose = False |
@@ -131,11 +133,14 @@ _playNote noteOn note = | |||
131 | playNoteEv $ Event.NoteEv onoff note | 133 | playNoteEv $ Event.NoteEv onoff note |
132 | where onoff = if noteOn then Event.NoteOn else Event.NoteOff | 134 | where onoff = if noteOn then Event.NoteOn else Event.NoteOff |
133 | 135 | ||
136 | delayEvent :: Event.T -> Integer -> Event.T | ||
137 | delayEvent evt nanosecs = evt {Event.time = Time.consRel $ Time.Real (RealTime.fromInteger nanosecs)} | ||
138 | |||
134 | playNoteEv :: Event.Data -> RWST LoopEnv () LoopState IO () | 139 | playNoteEv :: Event.Data -> RWST LoopEnv () LoopState IO () |
135 | playNoteEv nevdata = do | 140 | playNoteEv nevdata = do |
136 | ms <- getMidiSender | 141 | ms <- getMidiSender |
137 | publicAddr <- asks _publicAddr | 142 | publicAddr <- asks _publicAddr |
138 | liftIO $ ms $ Event.simple publicAddr nevdata | 143 | liftIO $ ms $ Event.simple publicAddr nevdata `delayEvent` (10 * 10^(9::Int)) |
139 | 144 | ||
140 | _whenFlag :: forall (m :: * -> *) s. MonadState s m => (s -> Bool) -> m () -> m () | 145 | _whenFlag :: forall (m :: * -> *) s. MonadState s m => (s -> Bool) -> m () -> m () |
141 | _whenFlag flag f = gets flag >>= flip when f | 146 | _whenFlag flag f = gets flag >>= flip when f |