summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Midi.hs25
1 files changed, 22 insertions, 3 deletions
diff --git a/Midi.hs b/Midi.hs
index 64226f3..e335cd4 100644
--- a/Midi.hs
+++ b/Midi.hs
@@ -2,7 +2,8 @@
2module Midi where 2module Midi where
3import BasePrelude 3import BasePrelude
4import qualified Data.ByteString as BS 4import qualified Data.ByteString as BS
5import Data.ByteString.Char8 (pack) 5import qualified Data.ByteString.Lazy as LBS
6import Data.ByteString.Char8 (pack, unpack)
6import Prelude hiding (id, (.)) 7import Prelude hiding (id, (.))
7-- import Sound.MIDI.ALSA 8-- import Sound.MIDI.ALSA
8import System.Clock 9import System.Clock
@@ -17,6 +18,7 @@ import Sound.MIDI.Message
17 18
18import Codec.Midi 19import Codec.Midi
19import Codec.ByteString.Builder 20import Codec.ByteString.Builder
21import Codec.ByteString.Parser
20 22
21-- import qualified Sound.ALSA.Sequencer 23-- import qualified Sound.ALSA.Sequencer
22-- import qualified Sound.ALSA.Sequencer.Address 24-- import qualified Sound.ALSA.Sequencer.Address
@@ -97,6 +99,23 @@ stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecord
97stopRecording _ _ = Nothing 99stopRecording _ _ = Nothing
98 100
99midiToBytes :: [RecordedEvent] -> BS.ByteString 101midiToBytes :: [RecordedEvent] -> BS.ByteString
100midiToBytes = pack . show . map (first timeSpecAsNanoSecs) . (fmap . fmap) (toLazyByteString . buildMessage) 102midiToBytes = pack . show . overFirsts toDeltas . map (first timeSpecAsNanoSecs) . (fmap . fmap) (toLazyByteString . buildMessage) . reverse
101bytesToMidi :: BS.ByteString -> [RecordedEvent] 103bytesToMidi :: BS.ByteString -> [RecordedEvent]
102bytesToMidi = undefined 104bytesToMidi = unpack >>> read >>> overFirsts fromDeltas >>> map (first fromInteger) >>> (fmap . fmap) f >>> reverse
105 where f :: LBS.ByteString -> Codec.Midi.Message
106 f = runParser (parseMessage Nothing) >>> either error id
107
108overFirsts :: ([a1] -> [a]) -> [(a1, b)] -> [(a, b)]
109overFirsts f = uncurry zip . first f . unzip
110
111toDeltas :: Num n => [n] -> [n]
112toDeltas xs = zipWith (-) xs (0:xs)
113
114fromDeltas :: Num n => [n] -> [n]
115fromDeltas = helper 0
116 where
117 helper _ [] = []
118 helper n (x:xs) = (n+x) : helper (n+x) xs
119
120-- fromDeltas :: Num n => [n] -> [n]
121-- fromDeltas = foldr (\a b -> a:map (a +) b) []