diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-05 06:34:47 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-05 06:34:47 -0500 |
commit | 9a15e58ff786aaef0fbb673d14de562f37bbc596 (patch) | |
tree | e77a56471aeb20421fc2270221f4611879952799 | |
parent | 4d77cfcfa36a628f5a583c846fe7ee2955afa923 (diff) |
recording stores both end time and time of last event
-rw-r--r-- | midi-dump.hs | 56 |
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 | ||
47 | data CompleteRecording = CompleteRecording { | 47 | data 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 | |||
57 | recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y new | 58 | recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y new |
58 | where y = fst $ last new | 59 | where y = fst $ last new |
59 | 60 | ||
60 | stopRecording :: Recording -> Maybe CompleteRecording | 61 | stopRecording :: Recording -> TimeSpec -> Maybe CompleteRecording |
61 | stopRecording (RecordingInProgress x y ls@((z,_):_)) = Just $ CompleteRecording x y z ls | 62 | stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecording x end y z ls |
62 | stopRecording _ = Nothing | 63 | stopRecording _ _ = Nothing |
63 | 64 | ||
64 | 65 | ||
65 | data LoopState = LoopState { | 66 | data LoopState = LoopState { |
@@ -100,13 +101,36 @@ createTable :: Query | |||
100 | createTable = fromString $ concat | 101 | createTable = 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 | ||
117 | sqlInsert :: Query | ||
118 | sqlInsert = 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 | |||
110 | main' :: IO () | 134 | main' :: IO () |
111 | main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do | 135 | main' = 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 | ||
218 | data Chunk = Chunk Int64 Int64 Int64 Int64 Int64 BS.ByteString | 242 | midiToBytes :: [RecordedEvent] -> BS.ByteString |
219 | instance FromRow Chunk where | 243 | midiToBytes = pack . show |
220 | fromRow = Chunk <$> field <*> field <*> field <*> field <*> field <*> field | 244 | bytesToMidi :: BS.ByteString -> [RecordedEvent] |
221 | instance ToRow Chunk where | 245 | bytesToMidi = undefined |
222 | toRow (Chunk s ns s' ns' d m) = toRow (s, ns, s', ns', d, m) | 246 | |
247 | instance 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 | ||
224 | instance ToRow CompleteRecording where | 252 | instance 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 | ||
230 | saveMidi :: forall (m :: * -> *). (MonadIO m, MonadState LoopState m, MonadReader LoopEnv m) => Recording -> m () | 257 | saveMidi :: forall (m :: * -> *). (MonadIO m, MonadState LoopState m, MonadReader LoopEnv m) => Recording -> m () |
231 | saveMidi recording = do | 258 | saveMidi 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 | ||
236 | startSaver :: forall (m :: * -> *). MonadIO m => Connection -> m (Chan CompleteRecording) | 263 | startSaver :: forall (m :: * -> *). MonadIO m => Connection -> m (Chan CompleteRecording) |
237 | startSaver sqlite = do | 264 | startSaver 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 | ||