1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE ExplicitForAll #-}
module Midi where
import BasePrelude
import qualified Data.ByteString as BS
-- import Data.ByteString.Char8 (pack)
import Prelude hiding (id, (.))
-- import Sound.MIDI.ALSA
import System.Clock
import Database.SQLite.Simple
import Database.SQLite.Simple.FromRow ()
import qualified Sound.ALSA.Sequencer.Event as Event
-- import Sound.MIDI.ALSA
import Sound.MIDI.ALSA.Query
import qualified Sound.MIDI.ALSA.Construct as Construct
import Sound.MIDI.Message
-- import qualified Sound.ALSA.Sequencer
-- import qualified Sound.ALSA.Sequencer.Address
-- import qualified Sound.ALSA.Sequencer.Port
-- import qualified Sound.ALSA.Sequencer.Queue
-- import qualified Sound.ALSA.Sequencer.Time as Time
-- import qualified Sound.ALSA.Sequencer.RealTime as RealTime
-- type RecordedEvent = (TimeSpec, Event.Data)
type RecordedEvent = (TimeSpec, Sound.MIDI.Message.T)
data Recording = StartRecording TimeSpec |
RecordingInProgress TimeSpec TimeSpec [RecordedEvent]
data CompleteRecording = CompleteRecording {
_recStart :: TimeSpec,
_recEnd :: TimeSpec,
_recFirst :: TimeSpec,
_recLast :: TimeSpec,
_recEvents :: [RecordedEvent]
}
instance FromRow CompleteRecording where
fromRow = cons <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field
where
cons a a' b b' c c' d d' z = CompleteRecording (TimeSpec a a') (TimeSpec b b') (TimeSpec c c') (TimeSpec d d') (bytesToMidi z)
instance ToRow CompleteRecording where
toRow reco = toRow (s, ns, s', ns', s'', ns'', s''', ns''', midiToBytes midi)
where
(CompleteRecording (TimeSpec s ns) (TimeSpec s' ns') (TimeSpec s'' ns'') (TimeSpec s''' ns''') midi) = reco
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)
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)
where
conv :: Sound.MIDI.Message.T -> Maybe Event.Data
conv msg = uncurry Construct.note <$> note msg
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)
where y = fst $ last new
stopRecording :: Recording -> TimeSpec -> Maybe CompleteRecording
stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecording x end y z ls
stopRecording _ _ = Nothing
midiToBytes :: [RecordedEvent] -> BS.ByteString
-- midiToBytes = pack . show
midiToBytes = undefined
bytesToMidi :: BS.ByteString -> [RecordedEvent]
bytesToMidi = undefined
|
