summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AlsaSeq.hs4
-rw-r--r--axis.hs11
-rw-r--r--midi-dump.hs2
3 files changed, 9 insertions, 8 deletions
diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index a6920f0..7c831bd 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -1,4 +1,4 @@
1module AlsaSeq (alsaInit, parseAlsaEvents, forwardNoteEvent, cmdlineAlsaConnect, printChordLn) where 1module AlsaSeq (withAlsaInit, parseAlsaEvents, forwardNoteEvent, cmdlineAlsaConnect, printChordLn) where
2import qualified Sound.ALSA.Exception as AlsaExc 2import qualified Sound.ALSA.Exception as AlsaExc
3import qualified Sound.ALSA.Sequencer.Address as Addr 3import qualified Sound.ALSA.Sequencer.Address as Addr
4import qualified Sound.ALSA.Sequencer as SndSeq 4import qualified Sound.ALSA.Sequencer as SndSeq
@@ -69,7 +69,7 @@ alsaClientPorts h cinfo = do
69 return p 69 return p
70 return ports 70 return ports
71 71
72alsaInit k = do 72withAlsaInit k = do
73 SndSeq.withDefault SndSeq.Nonblock $ \h -> do 73 SndSeq.withDefault SndSeq.Nonblock $ \h -> do
74 74
75 Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell Beats" -- In imperative language MIDI sequencer, you rock beat. In Haskell language MIDI sequencer, rock beat you! 75 Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell Beats" -- In imperative language MIDI sequencer, you rock beat. In Haskell language MIDI sequencer, rock beat you!
diff --git a/axis.hs b/axis.hs
index b59a6f6..7513163 100644
--- a/axis.hs
+++ b/axis.hs
@@ -5,6 +5,8 @@ import Control.Wire hiding (when)
5import Control.Wire.Session 5import Control.Wire.Session
6import Control.Monad 6import Control.Monad
7import qualified Graphics.UI.SDL as SDL 7import qualified Graphics.UI.SDL as SDL
8import AlsaSeq
9import qualified Data.Set as Set
8 10
9netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String 11netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String
10netwireIsCool = 12netwireIsCool =
@@ -19,17 +21,16 @@ netwireIsCool =
19 holdFor 0.5 . periodic 1 . pure "Hoo..." <|> 21 holdFor 0.5 . periodic 1 . pure "Hoo..." <|>
20 pure "...ray!" 22 pure "...ray!"
21 23
22--main :: IO () 24main = SDL.withInit [SDL.InitVideo, SDL.InitTimer, SDL.InitJoystick] $
23--main = testWire clockSession_ netwireIsCool 25 withAlsaInit $ \h public private q publicAddr privateAddr -> do
24 26 putStrLn "Initialized."
25main = SDL.withInit [SDL.InitVideo, SDL.InitTimer, SDL.InitJoystick] $ do
26 loop clockSession_ netwireIsCool "" 27 loop clockSession_ netwireIsCool ""
27 where 28 where
28 loop s w x = do 29 loop s w x = do
29 (ds, s') <- stepSession s 30 (ds, s') <- stepSession s
30 (ex, w') <- stepWire w ds (Right x) 31 (ex, w') <- stepWire w ds (Right x)
31 let x' = either (const "") id ex 32 let x' = either (const "") id ex
32 Control.Monad.when (x /= x' && x /= "") $ putStrLn x 33 Control.Monad.when (x /= x' && x' /= "") $ putStrLn x'
33 let framerate = 30 34 let framerate = 30
34 let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) 35 let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds)
35 SDL.delay (delay) 36 SDL.delay (delay)
diff --git a/midi-dump.hs b/midi-dump.hs
index 3de065b..51ebc6b 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -5,7 +5,7 @@ import qualified Data.Set as Set
5 5
6main = (do 6main = (do
7 7
8 alsaInit $ \h public private q publicAddr privateAddr -> do 8 withAlsaInit $ \h public private q publicAddr privateAddr -> do
9 cmdlineAlsaConnect h public 9 cmdlineAlsaConnect h public
10 10
11 let 11 let