diff options
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 46 |
1 files changed, 29 insertions, 17 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index eacaa03..5285849 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -127,9 +127,9 @@ sqlSelectRECENT = do | |||
127 | , "last_sec," | 127 | , "last_sec," |
128 | , "last_nsec," | 128 | , "last_nsec," |
129 | , "midi" | 129 | , "midi" |
130 | , " FROM axis_input", | 130 | , " FROM axis_input" |
131 | " ORDER BY start_sec DESC, start_nsec DESC ", | 131 | , " ORDER BY start_sec DESC, start_nsec DESC " |
132 | " LIMIT 10" | 132 | , " LIMIT 10" |
133 | ] | 133 | ] |
134 | 134 | ||
135 | _sqlSelectEVERYTHING :: MidiController [CompleteRecording] | 135 | _sqlSelectEVERYTHING :: MidiController [CompleteRecording] |
@@ -257,14 +257,27 @@ setOutputChannel :: Codec.Midi.Message -> Codec.Midi.Message | |||
257 | setOutputChannel = case fixedOutputChannel of Just n -> setChannel n | 257 | setOutputChannel = case fixedOutputChannel of Just n -> setChannel n |
258 | Nothing -> id | 258 | Nothing -> id |
259 | 259 | ||
260 | saveEvents :: FilePath -> [RecordedEvent] -> MidiController () | 260 | backgroundWithWait :: IO () -> MidiController () |
261 | saveEvents file evts@(_:_) = do | 261 | backgroundWithWait fn = do |
262 | (_, wait) <- liftIO $ Thread.forkIO $ Codec.Midi.exportFile file midi | 262 | (_, wait) <- liftIO $ Thread.forkIO fn |
263 | modify $ \s -> s { _waitThreads = wait:_waitThreads s } | 263 | modify $ \s -> s { _waitThreads = wait:_waitThreads s } |
264 | |||
265 | saveEvents :: FilePath -> [RecordedEvent] -> MidiController () | ||
266 | saveEvents file evts@(_:_) = backgroundWithWait $ Codec.Midi.exportFile file (toSingleTrackMidi evts) | ||
267 | saveEvents _ _ = return () | ||
268 | |||
269 | -- NOTE: The list must be in ascending order for this to work | ||
270 | -- TODO: Check that it is, and use 'last xs' if not. | ||
271 | dropLeadingSilence :: [RecordedEvent] -> [RecordedEvent] | ||
272 | dropLeadingSilence [] = [] | ||
273 | dropLeadingSilence xs@(x:_) = map (first (subtract (fst x))) xs | ||
274 | |||
275 | toSingleTrackMidi :: [RecordedEvent] -> Midi | ||
276 | toSingleTrackMidi evts = midi | ||
264 | where | 277 | where |
265 | midi = Midi MultiTrack (TicksPerBeat $ fromIntegral ticksPerBeat) [track ++ [(0, Codec.Midi.TrackEnd)]] | 278 | midi = Midi MultiTrack (TicksPerBeat $ fromIntegral ticksPerBeat) [track ++ [(0, Codec.Midi.TrackEnd)]] |
266 | track = zip (toDeltas (conv . subtract (head delays) <$> delays)) events | 279 | track = zip (toDeltas $ map conv delays) events |
267 | (delays, events) = unzip $ reverse $ (fmap.fmap) setOutputChannel evts -- TODO: do not use fixed channel | 280 | (delays, events) = unzip $ fmap setOutputChannel <$> dropLeadingSilence (reverse evts) -- TODO: do not use fixed channel |
268 | conv :: TimeSpec -> Int | 281 | conv :: TimeSpec -> Int |
269 | conv = fromIntegral . (`div` (10^(9::Int) `div` ticksPerSecond)) . timeSpecAsNanoSecs | 282 | conv = fromIntegral . (`div` (10^(9::Int) `div` ticksPerSecond)) . timeSpecAsNanoSecs |
270 | ticksPerSecond = ticksPerBeat * beatsPerSecond | 283 | ticksPerSecond = ticksPerBeat * beatsPerSecond |
@@ -272,26 +285,25 @@ saveEvents file evts@(_:_) = do | |||
272 | ticksPerBeat :: Integer | 285 | ticksPerBeat :: Integer |
273 | -- ticksPerBeat = 2^(15::Int) - 1 | 286 | -- ticksPerBeat = 2^(15::Int) - 1 |
274 | ticksPerBeat = 2400 | 287 | ticksPerBeat = 2400 |
275 | saveEvents _ _ = return () | ||
276 | 288 | ||
277 | playEvents :: [RecordedEvent] -> RWST LoopEnv () LoopState IO () | 289 | playEvents :: [RecordedEvent] -> MidiController () |
278 | playEvents evts@(_:_) = | 290 | playEvents evts@(_:_) = |
279 | mapM_ (uncurry delayNoteEv) (zip (subtract (head delays) <$> delays) events) | 291 | mapM_ (uncurry delayNoteEv) $ unConvertEvents $ fmap setOutputChannel <$> dropLeadingSilence (reverse evts) |
280 | where (delays, events) = unzip $ reverse $ unConvertEvents $ (fmap.fmap) setOutputChannel evts -- TODO: do not use fixed channel | 292 | -- TODO: do not use fixed channel |
281 | playEvents _ = return () | 293 | playEvents _ = return () |
282 | 294 | ||
283 | getMidiSender :: MidiController MidiHook | 295 | getMidiSender :: MidiController MidiHook |
284 | getMidiSender = do | 296 | getMidiSender = do |
285 | h <- asks _h | 297 | h <- asks _h |
286 | q <- asks _q | 298 | q <- asks _q |
287 | publicAddr <- asks _publicAddr | 299 | publicAddr <- asks _publicAddr |
288 | return $ forwardNoteEvent h q publicAddr | 300 | return $ forwardNoteEvent h q publicAddr |
289 | 301 | ||
290 | processMidi :: MidiController () | 302 | processMidi :: MidiController () |
291 | processMidi = do | 303 | processMidi = do |
292 | h <- asks _h | 304 | h <- asks _h |
293 | oldKeys <- gets _keysDown | 305 | oldKeys <- gets _keysDown |
294 | forwardNOW <- getMidiSender | 306 | forwardNOW <- getMidiSender |
295 | (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys forwardNOW | 307 | (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys forwardNOW |
296 | 308 | ||
297 | 309 | ||