From 4d77cfcfa36a628f5a583c846fe7ee2955afa923 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Sat, 5 Dec 2015 02:45:26 -0500
Subject: change representation of recordings

---
 midi-dump.hs | 67 +++++++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 42 insertions(+), 25 deletions(-)

diff --git a/midi-dump.hs b/midi-dump.hs
index 90a1bae..8484272 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -39,31 +39,43 @@ main = main' `AlsaExc.catch` handler
   where
   handler e = when verbose $ putStrLn $ "alsa_exception: " ++ AlsaExc.show e
 
-type RecordedEvents = [(TimeSpec, Event.T)]
+type RecordedEvent = (TimeSpec, Event.T)
 
-data Recording = Recording {
-  _recordingStart  :: TimeSpec, -- from initial silence
-  _recordingEvents :: RecordedEvents
+data Recording = StartRecording TimeSpec |
+                  RecordingInProgress TimeSpec TimeSpec [RecordedEvent]
+
+data CompleteRecording = CompleteRecording {
+    _recStart :: TimeSpec,
+    _recFirst :: TimeSpec,
+    _recLast  :: TimeSpec,
+    _recEvents :: [RecordedEvent]
 }
 
-data FinishedRecording = FinishedRecording Recording TimeSpec
+recordEvents :: Recording -> [RecordedEvent]-> Recording
+recordEvents (RecordingInProgress x y orig) new = RecordingInProgress x y $ new ++ orig
+recordEvents i@(StartRecording _) [] = i
+recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y new
+    where y = fst $ last new
+
+stopRecording :: Recording -> Maybe CompleteRecording
+stopRecording (RecordingInProgress x y ls@((z,_):_)) = Just $ CompleteRecording x y z ls
+stopRecording _ = Nothing
 
-recordEvents :: Recording -> RecordedEvents -> Recording
-recordEvents (Recording s orig) new = Recording s (new ++ orig)
 
 data LoopState = LoopState {
   _wantExit  :: Bool,
   keysDown   :: MidiPitchSet,
   _playNOW   :: [Event.Data],
   _recording :: Recording,
+  _replay    :: Recording,
   lastTick   :: TimeSpec
 }
 
 initializeState :: TimeSpec -> LoopState
-initializeState now = LoopState False Set.empty [] (emptyRecording now) now
+initializeState now = LoopState False Set.empty [] (StartRecording now) (StartRecording now) now
 
 data LoopEnv = LoopEnv {
-  _saver         :: Chan FinishedRecording,
+  _saver         :: Chan CompleteRecording,
   _sqlite        :: Connection,
   _startTime     :: TimeSpec,
   _startTimeReal :: TimeSpec,
@@ -123,7 +135,7 @@ mainLoop = do
   scheduled <- gets _playNOW
   unless (null scheduled) $ do
     forM_ scheduled playNoteEv
-    -- TODO: flush ALSA output here
+    -- TODO: flush ALSA output here (and remove flush from playNoteEv)
     modify $ \s -> s { _playNOW = [] }
 
   unless wantExit mainLoop
@@ -178,14 +190,21 @@ processMidi = do
     liftIO $ printChordLn newKeys
     modify $ \s -> s { keysDown = newKeys, _recording = recordEvents (_recording s) newEvents, lastTick = now }
 
+{-
+
+    when (Set.null oldKeys) $ do
+
+      replay <- gets _replay
+
+      when (lastEventTime replay < now - 10*10^9) $ do
+        modify $ \s -> s { _replay = StartRecording now }
+-}
+
     when (Set.null newKeys) $ do
 
       doSave <- asks _doSave
       when doSave $ gets _recording >>= saveMidi >> return ()
-      modify $ \s -> s { _recording = emptyRecording now }
-
-emptyRecording :: TimeSpec -> Recording
-emptyRecording now = Recording now []
+      modify $ \s -> s { _recording = StartRecording now }
 
 maybeReadLine :: RWST LoopEnv () LoopState IO (Maybe String)
 maybeReadLine = asks _lineReader >>= liftIO . tryTakeMVar
@@ -202,30 +221,28 @@ instance FromRow Chunk where
 instance ToRow Chunk where
   toRow (Chunk s ns s' ns' d m) = toRow (s, ns, s', ns', d, m)
 
-data Chunkable = MkChunk FinishedRecording TimeSpec
-instance ToRow Chunkable where
-  toRow (MkChunk reco ts) = toRow (s, ns, s', ns', leadingSilence :: Int64, pack $ show midi)
+instance ToRow CompleteRecording where
+  toRow reco = toRow (s, ns, s', ns', leadingSilence :: Int64, pack $ show midi)
     where
-      (FinishedRecording (Recording start@(TimeSpec s ns) midi) (TimeSpec s' ns')) = reco
+      (CompleteRecording start ts@(TimeSpec s ns) (TimeSpec s' ns') midi) = reco
       leadingSilence = fromIntegral $ timeSpecAsNanoSecs $ ts - start
 
 saveMidi :: forall (m :: * -> *). (MonadIO m, MonadState LoopState m, MonadReader LoopEnv m) => Recording -> m ()
 saveMidi recording = do
   saver <- asks _saver
-  end <- gets lastTick
-  liftIO $ writeChan saver $ FinishedRecording recording end
+  end <- gets lastTick -- TODO: record last tick (?)
+  mapM_ (liftIO . writeChan saver) $ stopRecording recording
 
-startSaver :: forall (m :: * -> *). MonadIO m => Connection -> m (Chan FinishedRecording)
+startSaver :: forall (m :: * -> *). MonadIO m => Connection -> m (Chan CompleteRecording)
 startSaver sqlite = do
   chan <- liftIO newChan
   _thread <- liftIO $ forkIO (saver chan)
   return chan
   where
     saver chan = forever $ do
-      reco@(FinishedRecording (Recording _ events) _) <- readChan chan
-      let start = fst $ head events
-          sqlInsert = "INSERT INTO axis_input (start_sec, start_nsec, end_sec, end_nsec, leading_silence, midi) VALUES (?,?,?,?,?,?)"
-      liftIO $ execute sqlite sqlInsert (MkChunk reco start)
+      reco <- readChan chan
+      let sqlInsert = "INSERT INTO axis_input (start_sec, start_nsec, end_sec, end_nsec, leading_silence, midi) VALUES (?,?,?,?,?,?)"
+      liftIO $ execute sqlite sqlInsert reco
       return ()
 
 
-- 
cgit v1.2.3