blob: a5a3d9c48b4632e3fcace7ab13487885fbe95ca9 (
plain)
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
|
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
main = main' `AlsaExc.catch` handler
where
handler e = putStrLn $ "alsa_exception: " ++ AlsaExc.show e
data State = State {
keysDown :: MidiPitchSet,
inputHistory :: [Maybe Event.T]
}
main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
cmdlineAlsaConnect h public
let
forwardNOW = forwardNoteEvent h q publicAddr
go state = do
(events, keysDown') <- parseAlsaEvents' h (keysDown state) forwardNOW
if ((keysDown state) == keysDown') then
threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%.
else do
let newHistory = if (Set.null $ keysDown state) then Nothing:newEvents else newEvents
newEvents = map Just events
printChordLn keysDown'
go (state { keysDown = keysDown', inputHistory = newHistory ++ inputHistory state })
putStrLn "Rock on!"
go (State Set.empty [])
|
