From 161f46c1aa0a5f34ff6f44eb5905b1a4679b0398 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Sun, 6 Dec 2015 11:28:26 -0500
Subject: Store recordings as Codec.Midi.Message

---
 Midi.hs            | 42 ++++++++++++++++++++++++++++++++----------
 axis-of-eval.cabal |  2 +-
 2 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/Midi.hs b/Midi.hs
index b4f4fc0..64226f3 100644
--- a/Midi.hs
+++ b/Midi.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE ExplicitForAll #-}
 module Midi where
 import           BasePrelude
-import qualified Data.ByteString       as BS
--- import           Data.ByteString.Char8 (pack)
+import qualified Data.ByteString as BS
+import           Data.ByteString.Char8 (pack)
 import           Prelude               hiding (id, (.))
 -- import           Sound.MIDI.ALSA
 import           System.Clock
@@ -15,6 +15,9 @@ import Sound.MIDI.ALSA.Query
 import qualified Sound.MIDI.ALSA.Construct as Construct
 import Sound.MIDI.Message
 
+import Codec.Midi
+import Codec.ByteString.Builder
+
 -- import qualified Sound.ALSA.Sequencer
 -- import qualified Sound.ALSA.Sequencer.Address
 -- import qualified Sound.ALSA.Sequencer.Port
@@ -23,7 +26,7 @@ import Sound.MIDI.Message
 -- import qualified Sound.ALSA.Sequencer.RealTime as RealTime
 
 -- type RecordedEvent = (TimeSpec, Event.Data)
-type RecordedEvent = (TimeSpec, Sound.MIDI.Message.T)
+type RecordedEvent = (TimeSpec, Codec.Midi.Message)
 
 data Recording = StartRecording TimeSpec |
                   RecordingInProgress TimeSpec TimeSpec [RecordedEvent]
@@ -50,20 +53,40 @@ maybesnd :: forall t t1. (t, Maybe t1) -> Maybe (t, t1)
 maybesnd (_, Nothing) = Nothing
 maybesnd (x, Just y) = Just (x, y)
 
-convertEvents :: [(TimeSpec, Event.Data)] -> [(TimeSpec, Sound.MIDI.Message.T)]
-convertEvents = mapMaybe (maybesnd . fmap conv)
+convertEvents' :: [(TimeSpec, Event.Data)] -> [(TimeSpec, Sound.MIDI.Message.T)]
+convertEvents' = mapMaybe (maybesnd . fmap conv)
     where
       conv :: Event.Data -> Maybe Sound.MIDI.Message.T
       conv x@(Event.NoteEv _ _) = uncurry Construct.note <$> note x
       conv _ = Nothing
 
-unConvertEvents :: [(TimeSpec, Sound.MIDI.Message.T)] -> [(TimeSpec, Event.Data)]
-unConvertEvents = mapMaybe (maybesnd . fmap conv)
+unConvertEvents' :: [(TimeSpec, Sound.MIDI.Message.T)] -> [(TimeSpec, Event.Data)]
+unConvertEvents' = mapMaybe (maybesnd . fmap conv)
     where
       conv :: Sound.MIDI.Message.T -> Maybe Event.Data
       conv msg = uncurry Construct.note <$> note msg
 
-recordEvents :: Recording -> [(TimeSpec, Event.Data)]-> Recording
+convertEvents :: [(TimeSpec, Event.Data)] -> [(TimeSpec, Codec.Midi.Message)]
+convertEvents = mapMaybe (maybesnd . fmap conv)
+    where
+      conv :: Event.Data -> Maybe Codec.Midi.Message
+      conv (Event.NoteEv Event.NoteOn  (Event.Note c p v _ _)) = Just $ cpv Codec.Midi.NoteOn  c p v
+      conv (Event.NoteEv Event.NoteOff (Event.Note c p v _ _)) = Just $ cpv Codec.Midi.NoteOff c p v
+      conv _ = Nothing
+      cpv f c p v = f (fi $ Event.unChannel c) (fi $ Event.unPitch p) (fi $ Event.unVelocity v)
+      fi = fromIntegral
+
+unConvertEvents :: [(TimeSpec, Codec.Midi.Message)] -> [(TimeSpec, Event.Data)]
+unConvertEvents = mapMaybe (maybesnd . fmap conv)
+    where
+      conv :: Codec.Midi.Message -> Maybe Event.Data
+      conv (Codec.Midi.NoteOn  c p v) = Just $ cpv c p v Event.NoteOn
+      conv (Codec.Midi.NoteOff c p v) = Just $ cpv c p v Event.NoteOff
+      conv _ = Nothing
+      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))
+      fi = fromIntegral
+
+recordEvents :: Recording -> [(TimeSpec, Event.Data)] -> Recording
 recordEvents (RecordingInProgress x y orig) new = RecordingInProgress x y $ convertEvents new ++ orig
 recordEvents i@(StartRecording _) [] = i
 recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y (convertEvents new)
@@ -74,7 +97,6 @@ stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecord
 stopRecording _ _ = Nothing
 
 midiToBytes :: [RecordedEvent] -> BS.ByteString
--- midiToBytes = pack . show
-midiToBytes = undefined
+midiToBytes = pack . show . map (first timeSpecAsNanoSecs) . (fmap . fmap) (toLazyByteString . buildMessage)
 bytesToMidi :: BS.ByteString -> [RecordedEvent]
 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
   build-depends:
     base, time, containers, haskore, alsa-seq, alsa-core, mtl, clock,
     sqlite-simple, bytestring, base-prelude, midi-alsa, midi, psqueues,
-    transformers, semigroups
+    transformers, semigroups, HCodecs
   main-is: midi-dump.hs
   other-modules: AlsaSeq, Midi, RealTimeQueue
   ghc-options: -threaded -W -Wall -O2
-- 
cgit v1.2.3