summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2015-12-05 01:50:29 -0500
committerAndrew Cady <d@jerkface.net>2015-12-05 01:50:29 -0500
commit8f46e826f188ce7716a87cf98ace41829725f10c (patch)
tree5723ea667ea7da74704b83ca21c7872c912c10bd
parent7dd4353d51eec254965ac23de085d829df94c05d (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.hs7
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
28import qualified Sound.ALSA.Sequencer.Address 28import qualified Sound.ALSA.Sequencer.Address
29import qualified Sound.ALSA.Sequencer.Port 29import qualified Sound.ALSA.Sequencer.Port
30import qualified Sound.ALSA.Sequencer.Queue 30import qualified Sound.ALSA.Sequencer.Queue
31import qualified Sound.ALSA.Sequencer.Time as Time
32import qualified Sound.ALSA.Sequencer.RealTime as RealTime
31 33
32verbose :: Bool 34verbose :: Bool
33verbose = False 35verbose = 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
136delayEvent :: Event.T -> Integer -> Event.T
137delayEvent evt nanosecs = evt {Event.time = Time.consRel $ Time.Real (RealTime.fromInteger nanosecs)}
138
134playNoteEv :: Event.Data -> RWST LoopEnv () LoopState IO () 139playNoteEv :: Event.Data -> RWST LoopEnv () LoopState IO ()
135playNoteEv nevdata = do 140playNoteEv 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