summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2015-12-05 06:34:47 -0500
committerAndrew Cady <d@jerkface.net>2015-12-05 06:34:47 -0500
commit9a15e58ff786aaef0fbb673d14de562f37bbc596 (patch)
treee77a56471aeb20421fc2270221f4611879952799
parent4d77cfcfa36a628f5a583c846fe7ee2955afa923 (diff)
recording stores both end time and time of last event
-rw-r--r--midi-dump.hs56
1 files changed, 41 insertions, 15 deletions
diff --git a/midi-dump.hs b/midi-dump.hs
index 8484272..f053e28 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -46,6 +46,7 @@ data Recording = StartRecording TimeSpec |
46 46
47data CompleteRecording = CompleteRecording { 47data CompleteRecording = CompleteRecording {
48 _recStart :: TimeSpec, 48 _recStart :: TimeSpec,
49 _recEnd :: TimeSpec,
49 _recFirst :: TimeSpec, 50 _recFirst :: TimeSpec,
50 _recLast :: TimeSpec, 51 _recLast :: TimeSpec,
51 _recEvents :: [RecordedEvent] 52 _recEvents :: [RecordedEvent]
@@ -57,9 +58,9 @@ recordEvents i@(StartRecording _) [] = i
57recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y new 58recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y new
58 where y = fst $ last new 59 where y = fst $ last new
59 60
60stopRecording :: Recording -> Maybe CompleteRecording 61stopRecording :: Recording -> TimeSpec -> Maybe CompleteRecording
61stopRecording (RecordingInProgress x y ls@((z,_):_)) = Just $ CompleteRecording x y z ls 62stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecording x end y z ls
62stopRecording _ = Nothing 63stopRecording _ _ = Nothing
63 64
64 65
65data LoopState = LoopState { 66data LoopState = LoopState {
@@ -100,13 +101,36 @@ createTable :: Query
100createTable = fromString $ concat 101createTable = fromString $ concat
101 ["CREATE TABLE IF NOT EXISTS axis_input", 102 ["CREATE TABLE IF NOT EXISTS axis_input",
102 " (id INTEGER PRIMARY KEY,", 103 " (id INTEGER PRIMARY KEY,",
104
103 " start_sec INTEGER,", 105 " start_sec INTEGER,",
104 " start_nsec INTEGER,", 106 " start_nsec INTEGER,",
105 " end_sec INTEGER,", 107 " end_sec INTEGER,",
106 " end_nsec INTEGER,", 108 " end_nsec INTEGER,",
107 " leading_silence INTEGER,", 109
110 " first_sec INTEGER,",
111 " first_nsec INTEGER,",
112 " last_sec INTEGER,",
113 " last_nsec INTEGER,",
114
108 " midi BLOB)"] 115 " midi BLOB)"]
109 116
117sqlInsert :: Query
118sqlInsert = fromString $ concat
119 ["INSERT INTO axis_input",
120
121 "(start_sec,",
122 " start_nsec,",
123 " end_sec,",
124 " end_nsec,",
125
126 " first_sec,",
127 " first_nsec,",
128 " last_sec,",
129 " last_nsec,",
130
131 " midi)",
132 "VALUES (?,?,?,?, ?,?,?,?, ?)"]
133
110main' :: IO () 134main' :: IO ()
111main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do 135main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
112 cmdlineAlsaConnect h public 136 cmdlineAlsaConnect h public
@@ -215,23 +239,26 @@ startLineReader = do
215 _thread <- liftIO $ forkIO (forever $ tryIOError getLine >>= either (const $ putMVar mv "exit") (putMVar mv)) 239 _thread <- liftIO $ forkIO (forever $ tryIOError getLine >>= either (const $ putMVar mv "exit") (putMVar mv))
216 return mv 240 return mv
217 241
218data Chunk = Chunk Int64 Int64 Int64 Int64 Int64 BS.ByteString 242midiToBytes :: [RecordedEvent] -> BS.ByteString
219instance FromRow Chunk where 243midiToBytes = pack . show
220 fromRow = Chunk <$> field <*> field <*> field <*> field <*> field <*> field 244bytesToMidi :: BS.ByteString -> [RecordedEvent]
221instance ToRow Chunk where 245bytesToMidi = undefined
222 toRow (Chunk s ns s' ns' d m) = toRow (s, ns, s', ns', d, m) 246
247instance FromRow CompleteRecording where
248 fromRow = cons <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field
249 where
250 cons a a' b b' c c' d d' z = CompleteRecording (TimeSpec a a') (TimeSpec b b') (TimeSpec c c') (TimeSpec d d') (bytesToMidi z)
223 251
224instance ToRow CompleteRecording where 252instance ToRow CompleteRecording where
225 toRow reco = toRow (s, ns, s', ns', leadingSilence :: Int64, pack $ show midi) 253 toRow reco = toRow (s, ns, s', ns', s'', ns'', s''', ns''', midiToBytes midi)
226 where 254 where
227 (CompleteRecording start ts@(TimeSpec s ns) (TimeSpec s' ns') midi) = reco 255 (CompleteRecording (TimeSpec s ns) (TimeSpec s' ns') (TimeSpec s'' ns'') (TimeSpec s''' ns''') midi) = reco
228 leadingSilence = fromIntegral $ timeSpecAsNanoSecs $ ts - start
229 256
230saveMidi :: forall (m :: * -> *). (MonadIO m, MonadState LoopState m, MonadReader LoopEnv m) => Recording -> m () 257saveMidi :: forall (m :: * -> *). (MonadIO m, MonadState LoopState m, MonadReader LoopEnv m) => Recording -> m ()
231saveMidi recording = do 258saveMidi recording = do
232 saver <- asks _saver 259 saver <- asks _saver
233 end <- gets lastTick -- TODO: record last tick (?) 260 now <- gets lastTick
234 mapM_ (liftIO . writeChan saver) $ stopRecording recording 261 mapM_ (liftIO . writeChan saver) $ stopRecording recording now
235 262
236startSaver :: forall (m :: * -> *). MonadIO m => Connection -> m (Chan CompleteRecording) 263startSaver :: forall (m :: * -> *). MonadIO m => Connection -> m (Chan CompleteRecording)
237startSaver sqlite = do 264startSaver sqlite = do
@@ -241,7 +268,6 @@ startSaver sqlite = do
241 where 268 where
242 saver chan = forever $ do 269 saver chan = forever $ do
243 reco <- readChan chan 270 reco <- readChan chan
244 let sqlInsert = "INSERT INTO axis_input (start_sec, start_nsec, end_sec, end_nsec, leading_silence, midi) VALUES (?,?,?,?,?,?)"
245 liftIO $ execute sqlite sqlInsert reco 271 liftIO $ execute sqlite sqlInsert reco
246 return () 272 return ()
247 273