diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-06 11:28:26 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-06 11:28:26 -0500 |
commit | 161f46c1aa0a5f34ff6f44eb5905b1a4679b0398 (patch) | |
tree | 5e159ca19e75d7c6f2ef2b03c78d98d439fa6407 | |
parent | 52bc07bc5a70ac43b0e1070d7fbb0d468d4e8139 (diff) |
Store recordings as Codec.Midi.Message
-rw-r--r-- | Midi.hs | 42 | ||||
-rw-r--r-- | axis-of-eval.cabal | 2 |
2 files changed, 33 insertions, 11 deletions
@@ -1,8 +1,8 @@ | |||
1 | {-# LANGUAGE ExplicitForAll #-} | 1 | {-# LANGUAGE ExplicitForAll #-} |
2 | module Midi where | 2 | module Midi where |
3 | import BasePrelude | 3 | import BasePrelude |
4 | import qualified Data.ByteString as BS | 4 | import qualified Data.ByteString as BS |
5 | -- import Data.ByteString.Char8 (pack) | 5 | import Data.ByteString.Char8 (pack) |
6 | import Prelude hiding (id, (.)) | 6 | import Prelude hiding (id, (.)) |
7 | -- import Sound.MIDI.ALSA | 7 | -- import Sound.MIDI.ALSA |
8 | import System.Clock | 8 | import System.Clock |
@@ -15,6 +15,9 @@ import Sound.MIDI.ALSA.Query | |||
15 | import qualified Sound.MIDI.ALSA.Construct as Construct | 15 | import qualified Sound.MIDI.ALSA.Construct as Construct |
16 | import Sound.MIDI.Message | 16 | import Sound.MIDI.Message |
17 | 17 | ||
18 | import Codec.Midi | ||
19 | import Codec.ByteString.Builder | ||
20 | |||
18 | -- import qualified Sound.ALSA.Sequencer | 21 | -- import qualified Sound.ALSA.Sequencer |
19 | -- import qualified Sound.ALSA.Sequencer.Address | 22 | -- import qualified Sound.ALSA.Sequencer.Address |
20 | -- import qualified Sound.ALSA.Sequencer.Port | 23 | -- import qualified Sound.ALSA.Sequencer.Port |
@@ -23,7 +26,7 @@ import Sound.MIDI.Message | |||
23 | -- import qualified Sound.ALSA.Sequencer.RealTime as RealTime | 26 | -- import qualified Sound.ALSA.Sequencer.RealTime as RealTime |
24 | 27 | ||
25 | -- type RecordedEvent = (TimeSpec, Event.Data) | 28 | -- type RecordedEvent = (TimeSpec, Event.Data) |
26 | type RecordedEvent = (TimeSpec, Sound.MIDI.Message.T) | 29 | type RecordedEvent = (TimeSpec, Codec.Midi.Message) |
27 | 30 | ||
28 | data Recording = StartRecording TimeSpec | | 31 | data Recording = StartRecording TimeSpec | |
29 | RecordingInProgress TimeSpec TimeSpec [RecordedEvent] | 32 | RecordingInProgress TimeSpec TimeSpec [RecordedEvent] |
@@ -50,20 +53,40 @@ maybesnd :: forall t t1. (t, Maybe t1) -> Maybe (t, t1) | |||
50 | maybesnd (_, Nothing) = Nothing | 53 | maybesnd (_, Nothing) = Nothing |
51 | maybesnd (x, Just y) = Just (x, y) | 54 | maybesnd (x, Just y) = Just (x, y) |
52 | 55 | ||
53 | convertEvents :: [(TimeSpec, Event.Data)] -> [(TimeSpec, Sound.MIDI.Message.T)] | 56 | convertEvents' :: [(TimeSpec, Event.Data)] -> [(TimeSpec, Sound.MIDI.Message.T)] |
54 | convertEvents = mapMaybe (maybesnd . fmap conv) | 57 | convertEvents' = mapMaybe (maybesnd . fmap conv) |
55 | where | 58 | where |
56 | conv :: Event.Data -> Maybe Sound.MIDI.Message.T | 59 | conv :: Event.Data -> Maybe Sound.MIDI.Message.T |
57 | conv x@(Event.NoteEv _ _) = uncurry Construct.note <$> note x | 60 | conv x@(Event.NoteEv _ _) = uncurry Construct.note <$> note x |
58 | conv _ = Nothing | 61 | conv _ = Nothing |
59 | 62 | ||
60 | unConvertEvents :: [(TimeSpec, Sound.MIDI.Message.T)] -> [(TimeSpec, Event.Data)] | 63 | unConvertEvents' :: [(TimeSpec, Sound.MIDI.Message.T)] -> [(TimeSpec, Event.Data)] |
61 | unConvertEvents = mapMaybe (maybesnd . fmap conv) | 64 | unConvertEvents' = mapMaybe (maybesnd . fmap conv) |
62 | where | 65 | where |
63 | conv :: Sound.MIDI.Message.T -> Maybe Event.Data | 66 | conv :: Sound.MIDI.Message.T -> Maybe Event.Data |
64 | conv msg = uncurry Construct.note <$> note msg | 67 | conv msg = uncurry Construct.note <$> note msg |
65 | 68 | ||
66 | recordEvents :: Recording -> [(TimeSpec, Event.Data)]-> Recording | 69 | convertEvents :: [(TimeSpec, Event.Data)] -> [(TimeSpec, Codec.Midi.Message)] |
70 | convertEvents = mapMaybe (maybesnd . fmap conv) | ||
71 | where | ||
72 | conv :: Event.Data -> Maybe Codec.Midi.Message | ||
73 | conv (Event.NoteEv Event.NoteOn (Event.Note c p v _ _)) = Just $ cpv Codec.Midi.NoteOn c p v | ||
74 | conv (Event.NoteEv Event.NoteOff (Event.Note c p v _ _)) = Just $ cpv Codec.Midi.NoteOff c p v | ||
75 | conv _ = Nothing | ||
76 | cpv f c p v = f (fi $ Event.unChannel c) (fi $ Event.unPitch p) (fi $ Event.unVelocity v) | ||
77 | fi = fromIntegral | ||
78 | |||
79 | unConvertEvents :: [(TimeSpec, Codec.Midi.Message)] -> [(TimeSpec, Event.Data)] | ||
80 | unConvertEvents = mapMaybe (maybesnd . fmap conv) | ||
81 | where | ||
82 | conv :: Codec.Midi.Message -> Maybe Event.Data | ||
83 | conv (Codec.Midi.NoteOn c p v) = Just $ cpv c p v Event.NoteOn | ||
84 | conv (Codec.Midi.NoteOff c p v) = Just $ cpv c p v Event.NoteOff | ||
85 | conv _ = Nothing | ||
86 | cpv c p v f = Event.NoteEv f (Event.Note (Event.Channel $ fi c) (Event.Pitch $ fi p) (Event.Velocity $ fi v) (Event.Velocity $ fi v) (Event.Duration 0)) | ||
87 | fi = fromIntegral | ||
88 | |||
89 | recordEvents :: Recording -> [(TimeSpec, Event.Data)] -> Recording | ||
67 | recordEvents (RecordingInProgress x y orig) new = RecordingInProgress x y $ convertEvents new ++ orig | 90 | recordEvents (RecordingInProgress x y orig) new = RecordingInProgress x y $ convertEvents new ++ orig |
68 | recordEvents i@(StartRecording _) [] = i | 91 | recordEvents i@(StartRecording _) [] = i |
69 | recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y (convertEvents new) | 92 | recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y (convertEvents new) |
@@ -74,7 +97,6 @@ stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecord | |||
74 | stopRecording _ _ = Nothing | 97 | stopRecording _ _ = Nothing |
75 | 98 | ||
76 | midiToBytes :: [RecordedEvent] -> BS.ByteString | 99 | midiToBytes :: [RecordedEvent] -> BS.ByteString |
77 | -- midiToBytes = pack . show | 100 | midiToBytes = pack . show . map (first timeSpecAsNanoSecs) . (fmap . fmap) (toLazyByteString . buildMessage) |
78 | midiToBytes = undefined | ||
79 | bytesToMidi :: BS.ByteString -> [RecordedEvent] | 101 | bytesToMidi :: BS.ByteString -> [RecordedEvent] |
80 | bytesToMidi = undefined | 102 | bytesToMidi = undefined |
diff --git a/axis-of-eval.cabal b/axis-of-eval.cabal index fa1049d..dac8e24 100644 --- a/axis-of-eval.cabal +++ b/axis-of-eval.cabal | |||
@@ -37,7 +37,7 @@ executable midi-dump | |||
37 | build-depends: | 37 | build-depends: |
38 | base, time, containers, haskore, alsa-seq, alsa-core, mtl, clock, | 38 | base, time, containers, haskore, alsa-seq, alsa-core, mtl, clock, |
39 | sqlite-simple, bytestring, base-prelude, midi-alsa, midi, psqueues, | 39 | sqlite-simple, bytestring, base-prelude, midi-alsa, midi, psqueues, |
40 | transformers, semigroups | 40 | transformers, semigroups, HCodecs |
41 | main-is: midi-dump.hs | 41 | main-is: midi-dump.hs |
42 | other-modules: AlsaSeq, Midi, RealTimeQueue | 42 | other-modules: AlsaSeq, Midi, RealTimeQueue |
43 | ghc-options: -threaded -W -Wall -O2 | 43 | ghc-options: -threaded -W -Wall -O2 |