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
|
import AlsaSeq
import Control.Concurrent (threadDelay)
import qualified Sound.ALSA.Exception as AlsaExc
import qualified Data.Set as Set
import qualified Haskore.Basic.Pitch as Pitch
import qualified Sound.ALSA.Sequencer.Event as Event
import Control.Monad.RWS.Strict
import Data.Maybe
import Data.List
main = main' `AlsaExc.catch` handler
where
handler e = putStrLn $ "alsa_exception: " ++ AlsaExc.show e
data LoopState = LoopState {
keysDown :: MidiPitchSet,
inputHistory :: [Maybe Event.T]
}
emptyLoopState = LoopState Set.empty []
main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
cmdlineAlsaConnect h public
putStrLn "Rock on!"
(_, ()) <- execRWST loop (h, public, private, q, publicAddr, privateAddr) emptyLoopState
return ()
loop = do
(h, _, _, q, publicAddr, _) <- ask
oldKeys <- gets keysDown
let forwardNOW = forwardNoteEvent h q publicAddr
(events, newKeys) <- liftIO $ parseAlsaEvents' h oldKeys forwardNOW
if (oldKeys == newKeys) then
liftIO $ threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%.
else do
let newEvents = map Just events
liftIO $ printChordLn newKeys
modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s }
when (Set.null newKeys) $ do
hist <- gets (takeWhile isJust . inputHistory)
liftIO $ print hist
modify $ \s -> s { inputHistory = Nothing:inputHistory s }
loop
|
