diff options
-rw-r--r-- | midi-dump.hs | 35 |
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 | ||
53 | data 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 | |||
53 | getAbsTime = do | 66 | getAbsTime = 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 | |||
59 | emptyLoopState = LoopState Set.empty [] | 73 | emptyLoopState = LoopState Set.empty [] |
60 | 74 | ||
61 | main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do | 75 | main' = 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 | ||
78 | loop = do | 91 | loop = 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 | ||
110 | saveMidi chunk = do | 133 | saveMidi 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 | ||