diff options
-rw-r--r-- | Midi.hs | 10 | ||||
-rw-r--r-- | midi-dump.hs | 2 |
2 files changed, 11 insertions, 1 deletions
@@ -91,6 +91,16 @@ convertEvents = mapMaybe (maybesnd . fmap conv) | |||
91 | cpv f c p v = f (fi $ Event.unChannel c) (fi $ Event.unPitch p) (fi $ Event.unVelocity v) | 91 | cpv f c p v = f (fi $ Event.unChannel c) (fi $ Event.unPitch p) (fi $ Event.unVelocity v) |
92 | fi = fromIntegral | 92 | fi = fromIntegral |
93 | 93 | ||
94 | setChannel :: Codec.Midi.Channel -> Codec.Midi.Message -> Codec.Midi.Message | ||
95 | setChannel c (NoteOff _ k v) = (NoteOff c k v) | ||
96 | setChannel c (NoteOn _ k v) = (NoteOn c k v) | ||
97 | setChannel c (ProgramChange _ p) = (ProgramChange c p) | ||
98 | setChannel c (ControlChange _ n v) = (ControlChange c n v) | ||
99 | setChannel c (KeyPressure _ k p) = (KeyPressure c k p) | ||
100 | setChannel c (ChannelPressure _ p) = (ChannelPressure c p) | ||
101 | setChannel c (PitchWheel _ p) = (PitchWheel c p) | ||
102 | setChannel _ x = x | ||
103 | |||
94 | unConvertEvents :: [(TimeSpec, Codec.Midi.Message)] -> [(TimeSpec, Event.Data)] | 104 | unConvertEvents :: [(TimeSpec, Codec.Midi.Message)] -> [(TimeSpec, Event.Data)] |
95 | unConvertEvents = mapMaybe (maybesnd . fmap conv) | 105 | unConvertEvents = mapMaybe (maybesnd . fmap conv) |
96 | where | 106 | where |
diff --git a/midi-dump.hs b/midi-dump.hs index 4c74792..534671f 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -215,7 +215,7 @@ playRecording = playEvents . playableEvents | |||
215 | playEvents :: [RecordedEvent] -> RWST LoopEnv () LoopState IO () | 215 | playEvents :: [RecordedEvent] -> RWST LoopEnv () LoopState IO () |
216 | playEvents evts@(_:_) = | 216 | playEvents evts@(_:_) = |
217 | mapM_ (uncurry delayNoteEv) (zip (subtract (head delays) <$> delays) events) | 217 | mapM_ (uncurry delayNoteEv) (zip (subtract (head delays) <$> delays) events) |
218 | where (delays, events) = unzip $ reverse $ unConvertEvents evts | 218 | where (delays, events) = unzip $ reverse $ unConvertEvents $ (fmap.fmap) (setChannel 1) evts |
219 | playEvents _ = return () | 219 | playEvents _ = return () |
220 | 220 | ||
221 | getMidiSender :: MidiController MidiHook | 221 | getMidiSender :: MidiController MidiHook |