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
|
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 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.T)
data Recording = StartRecording TimeSpec |
RecordingInProgress TimeSpec TimeSpec [RecordedEvent]
deriving Show
data CompleteRecording = CompleteRecording {
_recStart :: TimeSpec,
_recEnd :: TimeSpec,
_recFirst :: TimeSpec,
_recLast :: TimeSpec,
_recEvents :: [RecordedEvent]
} deriving Show
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
recordEvents :: Recording -> [RecordedEvent]-> Recording
recordEvents (RecordingInProgress x y orig) new = RecordingInProgress x y $ new ++ orig
recordEvents i@(StartRecording _) [] = i
recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y 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
bytesToMidi :: BS.ByteString -> [RecordedEvent]
bytesToMidi = undefined
|
