From 8feda549202e197a8e3e83ff986ca64bc158efdb Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 11 Dec 2015 07:49:32 -0500
Subject: Some cleanups & formatting changes.

No behavior should be affected.
---
 midi-dump.hs | 46 +++++++++++++++++++++++++++++-----------------
 1 file 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
     , "last_sec,"
     , "last_nsec,"
     , "midi"
-    , " FROM axis_input",
-      " ORDER BY start_sec DESC, start_nsec DESC ",
-      " LIMIT 10"
+    , " FROM axis_input"
+    , " ORDER BY start_sec DESC, start_nsec DESC "
+    , " LIMIT 10"
     ]
 
 _sqlSelectEVERYTHING :: MidiController [CompleteRecording]
@@ -257,14 +257,27 @@ setOutputChannel :: Codec.Midi.Message -> Codec.Midi.Message
 setOutputChannel = case fixedOutputChannel of Just n -> setChannel n
                                               Nothing -> id
 
-saveEvents :: FilePath -> [RecordedEvent] -> MidiController ()
-saveEvents file evts@(_:_) = do
-  (_, wait) <- liftIO $ Thread.forkIO $ Codec.Midi.exportFile file midi
+backgroundWithWait :: IO () -> MidiController ()
+backgroundWithWait fn = do
+  (_, wait) <- liftIO $ Thread.forkIO fn
   modify $ \s -> s { _waitThreads = wait:_waitThreads s }
+
+saveEvents :: FilePath -> [RecordedEvent] -> MidiController ()
+saveEvents file evts@(_:_) = backgroundWithWait $ Codec.Midi.exportFile file (toSingleTrackMidi evts)
+saveEvents _ _ = return ()
+
+-- NOTE: The list must be in ascending order for this to work
+-- TODO: Check that it is, and use 'last xs' if not.
+dropLeadingSilence :: [RecordedEvent] -> [RecordedEvent]
+dropLeadingSilence [] = []
+dropLeadingSilence xs@(x:_) = map (first (subtract (fst x))) xs
+
+toSingleTrackMidi :: [RecordedEvent] -> Midi
+toSingleTrackMidi evts = midi
   where
     midi = Midi MultiTrack (TicksPerBeat $ fromIntegral ticksPerBeat) [track ++ [(0, Codec.Midi.TrackEnd)]]
-    track = zip (toDeltas (conv . subtract (head delays) <$> delays)) events
-    (delays, events) = unzip $ reverse $ (fmap.fmap) setOutputChannel evts -- TODO: do not use fixed channel
+    track = zip (toDeltas $ map conv delays) events
+    (delays, events) = unzip $ fmap setOutputChannel <$> dropLeadingSilence (reverse evts) -- TODO: do not use fixed channel
     conv :: TimeSpec -> Int
     conv = fromIntegral . (`div` (10^(9::Int) `div` ticksPerSecond)) . timeSpecAsNanoSecs
     ticksPerSecond = ticksPerBeat * beatsPerSecond
@@ -272,26 +285,25 @@ saveEvents file evts@(_:_) = do
     ticksPerBeat :: Integer
     -- ticksPerBeat = 2^(15::Int) - 1
     ticksPerBeat = 2400
-saveEvents _ _ = return ()
 
-playEvents :: [RecordedEvent] -> RWST LoopEnv () LoopState IO ()
+playEvents :: [RecordedEvent] -> MidiController ()
 playEvents evts@(_:_) =
-  mapM_ (uncurry delayNoteEv) (zip (subtract (head delays) <$> delays) events)
-  where (delays, events) = unzip $ reverse $ unConvertEvents $ (fmap.fmap) setOutputChannel evts -- TODO: do not use fixed channel
+  mapM_ (uncurry delayNoteEv) $ unConvertEvents $ fmap setOutputChannel <$> dropLeadingSilence (reverse evts)
+    -- TODO: do not use fixed channel
 playEvents  _ = return ()
 
 getMidiSender :: MidiController MidiHook
 getMidiSender = do
-  h <- asks _h
-  q <- asks _q
+  h          <- asks _h
+  q          <- asks _q
   publicAddr <- asks _publicAddr
   return $ forwardNoteEvent h q publicAddr
 
 processMidi :: MidiController ()
 processMidi = do
-  h <- asks _h
-  oldKeys <- gets _keysDown
-  forwardNOW <- getMidiSender
+  h                 <- asks _h
+  oldKeys           <- gets _keysDown
+  forwardNOW        <- getMidiSender
   (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys forwardNOW
 
 
-- 
cgit v1.2.3