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
|
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
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!"
(s, ()) <- execRWST loop (h, public, private, q, publicAddr, privateAddr) emptyLoopState
return ()
loop = do
(h, public, private, q, publicAddr, privateAddr) <- ask
loopState <- get
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 newHistory = if Set.null oldKeys then Nothing:newEvents else newEvents
newEvents = map Just events
liftIO $ printChordLn newKeys
put loopState { keysDown = newKeys, inputHistory = newHistory ++ inputHistory loopState }
loop
|
