change data structures for midi recordings

1 files changed, 33 insertions, 37 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index c77ef00..6227c31 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -33,26 +33,27 @@ main = main' `AlsaExc.catch` handler
   where
   handler e = when verbose $ putStrLn $ "alsa_exception: " ++ AlsaExc.show e
 
-data EVENT = MidiEvent TimeSpec Event.T | Silence TimeSpec
-  deriving Show
+type RecordedEvents = [(TimeSpec, Event.T)]
 
-isSilence (Silence _) = True
-isSilence _ = False
+data Recording = Recording {
+  _recordingStart :: TimeSpec, -- from initial silence
+  _recordingEvents :: RecordedEvents
+}
 
-getTS (MidiEvent ts _) = ts
-getTS (Silence ts) = ts
+recordEvents :: Recording -> RecordedEvents -> Recording
+recordEvents (Recording s orig) new = Recording s (new ++ orig)
 
 data LoopState = LoopState {
   _wantExit    :: Bool,
   keysDown     :: MidiPitchSet,
-  inputHistory :: [EVENT],
+  _recording   :: Recording,
   lastTick     :: TimeSpec
 }
 
-emptyLoopState = LoopState False Set.empty []
+initializeState now = LoopState False Set.empty (emptyRecording now) now
 
 data LoopEnv = LoopEnv {
-  _saver         :: Chan (Int64, Int64, [EVENT]),
+  _saver         :: Chan Recording,
   _sqlite        :: Connection,
   _startTime     :: TimeSpec,
   _startTimeReal :: TimeSpec,
@@ -80,15 +81,15 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
   startTimeReal <- getTime Realtime
 
   sqlite <- open "test.db"
-  execute_ sqlite "CREATE TABLE IF NOT EXISTS chunks (id INTEGER PRIMARY KEY, sec INTEGER, nsec INTEGER, midi BLOB)"
+  execute_ sqlite "CREATE TABLE IF NOT EXISTS axis_input (id INTEGER PRIMARY KEY, sec INTEGER, nsec INTEGER, silence INTEGER, midi BLOB)"
   saver <- startSaver sqlite
   lineReader <- startLineReader
 
-  doSave <- isJust <$> lookupEnv "SAVE_MIDI"
+  doSave <- isNothing <$> lookupEnv "NO_SAVE_MIDI"
 
   let env = LoopEnv saver sqlite startTime startTimeReal h public private q publicAddr privateAddr doSave lineReader
 
-  (_, ()) <- execRWST loop env (emptyLoopState startTime)
+  (_, ()) <- execRWST loop env $ initializeState startTimeReal
   return ()
   where
     loop = do
@@ -97,6 +98,7 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
       unless wantExit loop
 
 processCommand "exit" = modify $ \s -> s { _wantExit = True }
+processCommand "" = return ()
 processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str
 
 processMidi = do
@@ -113,25 +115,18 @@ processMidi = do
     liftIO $ threadDelay 15000 -- 15ms.  Seems like a lot, but it sounds OK.  Cuts CPU down to 2%.
   else do
     now <- getAbsTime
-    let newEvents = map (MidiEvent now) events
+    let newEvents = map ((,) now) events
 
     liftIO $ printChordLn newKeys
-    modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s, lastTick = now }
+    modify $ \s -> s { keysDown = newKeys, _recording = recordEvents (_recording s) newEvents, lastTick = now }
 
     when (Set.null newKeys) $ do
 
-      when False $ do
-        chunk <- gets $ takeWhile (not . isSilence) . inputHistory
-        saveMidi chunk
-
-        hist <- gets $ filter (not . isSilence) . inputHistory
-        liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist
-        liftIO $ print $ mapMaybe getMidiDesc $ reverse hist
-        modify $ \s -> s { inputHistory = Silence now:inputHistory s }
-
       doSave <- asks _doSave
-      when doSave $ gets inputHistory >>= saveMidi >> return ()
-      modify $ \s -> s { inputHistory = [] }
+      when doSave $ gets _recording >>= saveMidi >> return ()
+      modify $ \s -> s { _recording = emptyRecording now }
+
+emptyRecording now = Recording now []
 
 maybeReadLine = asks _lineReader >>= liftIO . tryTakeMVar
 startLineReader = do
@@ -139,17 +134,16 @@ startLineReader = do
   thread <- liftIO $ forkIO (forever $ getLine >>= putMVar mv)
   return mv
 
-
-data Chunk = Chunk Int64 Int64 BS.ByteString
+data Chunk = Chunk Int64 Int64 Int64 {- duration of silence in nanoseconds -} BS.ByteString
 instance FromRow Chunk where
-  fromRow = Chunk <$> field <*> field <*> field
+  fromRow = Chunk <$> field <*> field <*> field <*> field
 instance ToRow Chunk where
-  toRow (Chunk s ns b) = toRow (s, ns, b)
+  toRow (Chunk s ns b pre) = toRow (s, ns, b, pre)
 
-saveMidi chunk = do
+saveMidi recording = do
   saver <- asks _saver
   (TimeSpec s ns) <- gets lastTick
-  liftIO $ writeChan saver (s, ns, chunk)
+  liftIO $ writeChan saver recording
 
 startSaver sqlite = do
   chan <- liftIO newChan
@@ -157,15 +151,17 @@ startSaver sqlite = do
   return chan
   where
     saver chan = forever $ do
-      (s, ns, chunk) <- readChan chan
-      let bytes = pack $ show chunk
-      liftIO $ execute sqlite "INSERT INTO chunks (sec, nsec, midi) VALUES (?,?,?)" (Chunk s ns bytes)
+      (Recording silenceStart events) <- readChan chan
+      let bytes = pack $ show events
+          ts@(TimeSpec s ns) = fst $ head events
+          silence = fromIntegral $ timeSpecAsNanoSecs $ ts - silenceStart
+      liftIO $ execute sqlite "INSERT INTO axis_input (sec, nsec, silence, midi) VALUES (?,?,?,?)" (Chunk s ns silence bytes)
       return ()
 
 
-getMidiDesc :: EVENT -> Maybe String
-getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOn  ev))) = return $ ("on:" ++)  $ showPitch $ unPitch $ Event.noteNote ev
-getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOff ev))) = return $ ("off:" ++) $ showPitch $ unPitch $ Event.noteNote ev
+getMidiDesc :: Event.T -> Maybe String
+getMidiDesc ((Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOn  ev))) = return $ ("on:" ++)  $ showPitch $ unPitch $ Event.noteNote ev
+getMidiDesc ((Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOff ev))) = return $ ("off:" ++) $ showPitch $ unPitch $ Event.noteNote ev
 getMidiDesc _ = Nothing
 
 tsDeltas :: [TimeSpec] -> [Integer]