diff options
-rw-r--r-- | midi-dump.hs | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index 308e008..c7cd5e1 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -21,6 +21,9 @@ data EVENT = MidiEvent TimeSpec Event.T | Silence TimeSpec | |||
21 | isSilence (Silence _) = True | 21 | isSilence (Silence _) = True |
22 | isSilence _ = False | 22 | isSilence _ = False |
23 | 23 | ||
24 | getTS (MidiEvent ts _) = ts | ||
25 | getTS (Silence ts) = ts | ||
26 | |||
24 | data LoopState = LoopState { | 27 | data LoopState = LoopState { |
25 | keysDown :: MidiPitchSet, | 28 | keysDown :: MidiPitchSet, |
26 | inputHistory :: [EVENT], | 29 | inputHistory :: [EVENT], |
@@ -57,8 +60,21 @@ loop = do | |||
57 | 60 | ||
58 | when (Set.null newKeys) $ do | 61 | when (Set.null newKeys) $ do |
59 | hist <- gets $ takeWhile (not . isSilence) . inputHistory | 62 | hist <- gets $ takeWhile (not . isSilence) . inputHistory |
60 | liftIO $ print $ reverse hist | 63 | liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist |
64 | liftIO $ print $ mapMaybe getMidiDesc $ reverse hist | ||
61 | modify $ \s -> s { inputHistory = Silence now:inputHistory s } | 65 | modify $ \s -> s { inputHistory = Silence now:inputHistory s } |
62 | 66 | ||
63 | modify $ \s -> s { lastTick = now } | 67 | modify $ \s -> s { lastTick = now } |
64 | loop | 68 | loop |
69 | |||
70 | getMidiDesc :: EVENT -> Maybe String | ||
71 | getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOn ev))) = return $ ("on:" ++) $ showPitch $ unPitch $ Event.noteNote ev | ||
72 | getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOff ev))) = return $ ("off:" ++) $ showPitch $ unPitch $ Event.noteNote ev | ||
73 | getMidiDesc _ = Nothing | ||
74 | |||
75 | tsDeltas :: [TimeSpec] -> [Integer] | ||
76 | tsDeltas [] = [] | ||
77 | tsDeltas ls@(x:xs) = map (\(a,b) -> a - b) $ zip nsecs (0:nsecs) | ||
78 | where | ||
79 | nsecs = map timeSpecAsNanoSecs rel | ||
80 | rel = map (\y -> y - x) ls | ||