summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--midi-dump.hs35
1 files changed, 29 insertions, 6 deletions
diff --git a/midi-dump.hs b/midi-dump.hs
index 034c8f8..ad9fd46 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -50,12 +50,26 @@ data LoopState = LoopState {
50 lastTick :: TimeSpec 50 lastTick :: TimeSpec
51} 51}
52 52
53data LoopEnv = LoopEnv {
54 saver :: Chan (Int64, Int64, [EVENT]),
55 sqlite :: Connection,
56 startTime :: TimeSpec,
57 startTimeReal :: TimeSpec,
58 h :: Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode,
59 public :: Sound.ALSA.Sequencer.Port.T,
60 private :: Sound.ALSA.Sequencer.Port.T,
61 q :: Sound.ALSA.Sequencer.Queue.T,
62 publicAddr :: Sound.ALSA.Sequencer.Address.T,
63 privateAddr :: Sound.ALSA.Sequencer.Address.T
64}
65
53getAbsTime = do 66getAbsTime = do
54 (_, sqlite, startTime, startTimeReal, _, _, _, _, _, _) <- ask 67 sqlite <- asks sqlite
68 startTime <- asks startTime
69 startTimeReal <- asks startTimeReal
55 now <- liftIO $ getTime Monotonic 70 now <- liftIO $ getTime Monotonic
56 return $ now - startTime + startTimeReal 71 return $ now - startTime + startTimeReal
57 72
58
59emptyLoopState = LoopState Set.empty [] 73emptyLoopState = LoopState Set.empty []
60 74
61main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do 75main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
@@ -69,14 +83,17 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
69 execute_ sqlite "CREATE TABLE IF NOT EXISTS chunks (id INTEGER PRIMARY KEY, sec INTEGER, nsec INTEGER, midi BLOB)" 83 execute_ sqlite "CREATE TABLE IF NOT EXISTS chunks (id INTEGER PRIMARY KEY, sec INTEGER, nsec INTEGER, midi BLOB)"
70 saver <- startSaver sqlite 84 saver <- startSaver sqlite
71 85
72 let env = (saver, sqlite, startTime, startTimeReal, h, public, private, q, publicAddr, privateAddr) 86 let env = LoopEnv saver sqlite startTime startTimeReal h public private q publicAddr privateAddr
73 env :: (Chan (Int64, Int64, [EVENT]), Connection, TimeSpec, TimeSpec, Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode, Sound.ALSA.Sequencer.Port.T, Sound.ALSA.Sequencer.Port.T, Sound.ALSA.Sequencer.Queue.T, Sound.ALSA.Sequencer.Address.T, Sound.ALSA.Sequencer.Address.T)
74 87
75 (_, ()) <- execRWST loop env (emptyLoopState startTime) 88 (_, ()) <- execRWST loop env (emptyLoopState startTime)
76 return () 89 return ()
77 90
78loop = do 91loop = do
79 (_, _, startTime, startTimeReal, h, _, _, q, publicAddr, _) <- ask 92 startTime <- asks startTime
93 startTimeReal <- asks startTimeReal
94 h <- asks h
95 q <- asks q
96 publicAddr <- asks publicAddr
80 97
81 oldKeys <- gets keysDown 98 oldKeys <- gets keysDown
82 let forwardNOW = forwardNoteEvent h q publicAddr 99 let forwardNOW = forwardNoteEvent h q publicAddr
@@ -92,12 +109,18 @@ loop = do
92 modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s, lastTick = now } 109 modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s, lastTick = now }
93 110
94 when (Set.null newKeys) $ do 111 when (Set.null newKeys) $ do
112 {-
95 chunk <- gets $ takeWhile (not . isSilence) . inputHistory 113 chunk <- gets $ takeWhile (not . isSilence) . inputHistory
96 saveMidi chunk 114 saveMidi chunk
115
97 hist <- gets $ filter (not . isSilence) . inputHistory 116 hist <- gets $ filter (not . isSilence) . inputHistory
98 liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist 117 liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist
99 liftIO $ print $ mapMaybe getMidiDesc $ reverse hist 118 liftIO $ print $ mapMaybe getMidiDesc $ reverse hist
100 modify $ \s -> s { inputHistory = Silence now:inputHistory s } 119 modify $ \s -> s { inputHistory = Silence now:inputHistory s }
120 -}
121
122 gets inputHistory >>= saveMidi >> return ()
123 modify $ \s -> s { inputHistory = [] }
101 124
102 loop 125 loop
103 126
@@ -108,7 +131,7 @@ instance ToRow Chunk where
108 toRow (Chunk s ns b) = toRow (s, ns, b) 131 toRow (Chunk s ns b) = toRow (s, ns, b)
109 132
110saveMidi chunk = do 133saveMidi chunk = do
111 (saver, _, _, _, _, _, _, _, _, _) <- ask 134 saver <- asks saver
112 (TimeSpec s ns) <- gets lastTick 135 (TimeSpec s ns) <- gets lastTick
113 liftIO $ writeChan saver (s, ns, chunk) 136 liftIO $ writeChan saver (s, ns, chunk)
114 137