summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2015-12-11 07:49:32 -0500
committerAndrew Cady <d@jerkface.net>2015-12-11 08:50:07 -0500
commit8feda549202e197a8e3e83ff986ca64bc158efdb (patch)
tree882e84307fa696cbe84321374f975d4299c2d2d9
parent66f65478a22fcc3ff024f0c1456ece372aae554b (diff)
Some cleanups & formatting changes.
No behavior should be affected.
-rw-r--r--midi-dump.hs46
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
257setOutputChannel = case fixedOutputChannel of Just n -> setChannel n 257setOutputChannel = case fixedOutputChannel of Just n -> setChannel n
258 Nothing -> id 258 Nothing -> id
259 259
260saveEvents :: FilePath -> [RecordedEvent] -> MidiController () 260backgroundWithWait :: IO () -> MidiController ()
261saveEvents file evts@(_:_) = do 261backgroundWithWait 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
265saveEvents :: FilePath -> [RecordedEvent] -> MidiController ()
266saveEvents file evts@(_:_) = backgroundWithWait $ Codec.Midi.exportFile file (toSingleTrackMidi evts)
267saveEvents _ _ = 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.
271dropLeadingSilence :: [RecordedEvent] -> [RecordedEvent]
272dropLeadingSilence [] = []
273dropLeadingSilence xs@(x:_) = map (first (subtract (fst x))) xs
274
275toSingleTrackMidi :: [RecordedEvent] -> Midi
276toSingleTrackMidi 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
275saveEvents _ _ = return ()
276 288
277playEvents :: [RecordedEvent] -> RWST LoopEnv () LoopState IO () 289playEvents :: [RecordedEvent] -> MidiController ()
278playEvents evts@(_:_) = 290playEvents 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
281playEvents _ = return () 293playEvents _ = return ()
282 294
283getMidiSender :: MidiController MidiHook 295getMidiSender :: MidiController MidiHook
284getMidiSender = do 296getMidiSender = 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
290processMidi :: MidiController () 302processMidi :: MidiController ()
291processMidi = do 303processMidi = 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