summaryrefslogtreecommitdiff
path: root/midi-dump.hs
diff options
context:
space:
mode:
Diffstat (limited to 'midi-dump.hs')
-rw-r--r--midi-dump.hs18
1 files changed, 3 insertions, 15 deletions
diff --git a/midi-dump.hs b/midi-dump.hs
index b68a790..e6d2aca 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -42,7 +42,6 @@ main = main' `AlsaExc.catch` handler
42data LoopState = LoopState { 42data LoopState = LoopState {
43 _wantExit :: Bool, 43 _wantExit :: Bool,
44 keysDown :: MidiPitchSet, 44 keysDown :: MidiPitchSet,
45 _playNOW :: [Event.Data],
46 _scheduled :: Q.Queue Event.Data, 45 _scheduled :: Q.Queue Event.Data,
47 _recording :: Recording, 46 _recording :: Recording,
48 _replay :: Recording, 47 _replay :: Recording,
@@ -50,7 +49,7 @@ data LoopState = LoopState {
50} 49}
51 50
52initializeState :: TimeSpec -> LoopState 51initializeState :: TimeSpec -> LoopState
53initializeState now = LoopState False Set.empty [] createQueue (StartRecording now) (StartRecording now) now 52initializeState now = LoopState False Set.empty createQueue (StartRecording now) (StartRecording now) now
54 53
55data LoopEnv = LoopEnv { 54data LoopEnv = LoopEnv {
56 _saver :: Chan CompleteRecording, 55 _saver :: Chan CompleteRecording,
@@ -132,24 +131,13 @@ mainLoop :: MidiController ()
132mainLoop = do 131mainLoop = do
133 maybeReadLine >>= maybe processMidi processCommand 132 maybeReadLine >>= maybe processMidi processCommand
134 wantExit <- gets _wantExit 133 wantExit <- gets _wantExit
135
136 playImmediates
137 playScheduled 134 playScheduled
138
139 unless wantExit mainLoop 135 unless wantExit mainLoop
140 136
141playScheduled :: MidiController () 137playScheduled :: MidiController ()
142playScheduled = queueAction $ runScheduledIO (TimeSpec 1 0) $ uncurry alsaDelayNoteEv 138playScheduled = queueAction $ runScheduledIO (TimeSpec 1 0) $ uncurry alsaDelayNoteEv
143-- TODO: flush ALSA output here (and remove flush from playNoteEv) 139-- TODO: flush ALSA output here (and remove flush from playNoteEv)
144 140
145playImmediates :: MidiController ()
146playImmediates = do
147 immediate <- gets _playNOW
148 unless (null immediate) $ do
149 forM_ immediate playNoteEv
150 -- TODO: flush ALSA output here (and remove flush from playNoteEv)
151 modify $ \s -> s { _playNOW = [] }
152
153_playNote :: Bool -> Event.Note -> MidiController () 141_playNote :: Bool -> Event.Note -> MidiController ()
154_playNote noteOn note = 142_playNote noteOn note =
155 playNoteEv $ Event.NoteEv onoff note 143 playNoteEv $ Event.NoteEv onoff note
@@ -189,7 +177,7 @@ processCommand "exit" = modify $ \s -> s { _wantExit = True }
189processCommand "" = gets _replay >>= playRecording 177processCommand "" = gets _replay >>= playRecording
190processCommand "C" = do 178processCommand "C" = do
191 let notes = (Event.NoteEv Event.NoteOn . mkNote) <$> [60, 64, 67] 179 let notes = (Event.NoteEv Event.NoteOn . mkNote) <$> [60, 64, 67]
192 modify $ \s -> s { _playNOW = notes } 180 forM_ notes (delayNoteEv (TimeSpec 0 0))
193processCommand "C'" = do 181processCommand "C'" = do
194 let notes = (Event.NoteEv Event.NoteOn . mkNote) <$> [60, 64, 67] 182 let notes = (Event.NoteEv Event.NoteOn . mkNote) <$> [60, 64, 67]
195 forM_ notes (delayNoteEv (TimeSpec 2 0)) 183 forM_ notes (delayNoteEv (TimeSpec 2 0))
@@ -199,7 +187,7 @@ processCommand "C'" = do
199 let mkNote pitch = Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 128) 187 let mkNote pitch = Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 128)
200 setDuration d note = note { Event.noteDuration = Event.Duration d } 188 setDuration d note = note { Event.noteDuration = Event.Duration d }
201 let notes = (Event.NoteEv Event.NoteOn . setDuration 4290000000 . mkNote) <$> [60, 64, 67] 189 let notes = (Event.NoteEv Event.NoteOn . setDuration 4290000000 . mkNote) <$> [60, 64, 67]
202 modify $ \s -> s { _playNOW = notes } 190 forM_ notes (delayNoteEv (TimeSpec 0 0))
203-} 191-}
204processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str 192processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str
205 193