diff options
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 18 |
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 | |||
42 | data LoopState = LoopState { | 42 | data 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 | ||
52 | initializeState :: TimeSpec -> LoopState | 51 | initializeState :: TimeSpec -> LoopState |
53 | initializeState now = LoopState False Set.empty [] createQueue (StartRecording now) (StartRecording now) now | 52 | initializeState now = LoopState False Set.empty createQueue (StartRecording now) (StartRecording now) now |
54 | 53 | ||
55 | data LoopEnv = LoopEnv { | 54 | data LoopEnv = LoopEnv { |
56 | _saver :: Chan CompleteRecording, | 55 | _saver :: Chan CompleteRecording, |
@@ -132,24 +131,13 @@ mainLoop :: MidiController () | |||
132 | mainLoop = do | 131 | mainLoop = 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 | ||
141 | playScheduled :: MidiController () | 137 | playScheduled :: MidiController () |
142 | playScheduled = queueAction $ runScheduledIO (TimeSpec 1 0) $ uncurry alsaDelayNoteEv | 138 | playScheduled = 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 | ||
145 | playImmediates :: MidiController () | ||
146 | playImmediates = 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 } | |||
189 | processCommand "" = gets _replay >>= playRecording | 177 | processCommand "" = gets _replay >>= playRecording |
190 | processCommand "C" = do | 178 | processCommand "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)) |
193 | processCommand "C'" = do | 181 | processCommand "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 | -} |
204 | processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str | 192 | processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str |
205 | 193 | ||