diff options
author | Andrew Cady <d@jerkface.net> | 2014-01-15 15:18:30 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2014-01-15 15:18:44 -0500 |
commit | ec69d4ca77538a5624c4974181b6dc0879cfca59 (patch) | |
tree | 9f955ee3610e01f6cdfce9ddcf3316d45efb77e3 | |
parent | e83c155a8be7053ea90118659e83a334c3d1c382 (diff) |
show currently-playing midi notes in real-time through sdl!
-rw-r--r-- | AlsaSeq.hs | 4 | ||||
-rw-r--r-- | axis.hs | 31 |
2 files changed, 30 insertions, 5 deletions
@@ -1,4 +1,4 @@ | |||
1 | module AlsaSeq (withAlsaInit, parseAlsaEvents, forwardNoteEvent, cmdlineAlsaConnect, printChordLn) where | 1 | module AlsaSeq (withAlsaInit, parseAlsaEvents, forwardNoteEvent, cmdlineAlsaConnect, printChordLn, showChord) where |
2 | import qualified Sound.ALSA.Exception as AlsaExc | 2 | import qualified Sound.ALSA.Exception as AlsaExc |
3 | import qualified Sound.ALSA.Sequencer.Address as Addr | 3 | import qualified Sound.ALSA.Sequencer.Address as Addr |
4 | import qualified Sound.ALSA.Sequencer as SndSeq | 4 | import qualified Sound.ALSA.Sequencer as SndSeq |
@@ -31,6 +31,8 @@ joinWords ls = foldr1 (\a b -> a ++ " " ++ b) ls | |||
31 | printWords [] = return () -- print nothing if no words (not an empty line) | 31 | printWords [] = return () -- print nothing if no words (not an empty line) |
32 | printWords ls = putStrLn $ joinWords ls | 32 | printWords ls = putStrLn $ joinWords ls |
33 | 33 | ||
34 | showChord ls = joinWords $ pitchWords ls | ||
35 | |||
34 | showPitch x = | 36 | showPitch x = |
35 | let (octave, pitch) = Haskore.Basic.Pitch.fromInt $ fromIntegral x | 37 | let (octave, pitch) = Haskore.Basic.Pitch.fromInt $ fromIntegral x |
36 | in Haskore.Basic.Pitch.classFormat pitch (show octave) | 38 | in Haskore.Basic.Pitch.classFormat pitch (show octave) |
@@ -53,13 +53,28 @@ main = | |||
53 | putStrLn x' | 53 | putStrLn x' |
54 | fontSurface <- SDL.TTF.renderUTF8Blended font x' (SDL.Color 0 255 0) | 54 | fontSurface <- SDL.TTF.renderUTF8Blended font x' (SDL.Color 0 255 0) |
55 | fontClipRect <- SDL.getClipRect fontSurface | 55 | fontClipRect <- SDL.getClipRect fontSurface |
56 | -- _ <- SDL.fillRect videoSurface (Just fontClipRect) (SDL.Pixel 0) | 56 | _ <- SDL.fillRect videoSurface (Just (widenRect fontClipRect videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band |
57 | _ <- SDL.fillRect videoSurface (Just videoClipRect) (SDL.Pixel 0) | ||
58 | _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just fontClipRect) | 57 | _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just fontClipRect) |
59 | -- _ <- SDL.updateRect videoSurface fontClipRect | ||
60 | _ <- SDL.updateRect videoSurface videoClipRect | ||
61 | return () | 58 | return () |
62 | 59 | ||
60 | Control.Monad.when (midiKeysDown' /= midiKeysDown) $ do | ||
61 | let chord = showChord midiKeysDown' | ||
62 | putStrLn chord | ||
63 | if (chord /= "") | ||
64 | then do | ||
65 | chordFontSurface <- SDL.TTF.renderUTF8Blended font chord (SDL.Color 0 255 0) | ||
66 | chordFontClipRect <- SDL.getClipRect chordFontSurface | ||
67 | let r = chordFontClipRect `underNeath` (SDL.Rect 0 0 0 70) | ||
68 | _ <- SDL.fillRect videoSurface (Just (widenRect r videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band | ||
69 | _ <- SDL.blitSurface chordFontSurface (Just chordFontClipRect) videoSurface (Just r) | ||
70 | return () | ||
71 | else do | ||
72 | _ <- SDL.fillRect videoSurface (Just (widenRect (SDL.Rect 0 70 0 70) videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band | ||
73 | return () | ||
74 | return () | ||
75 | |||
76 | _ <- SDL.updateRect videoSurface videoClipRect | ||
77 | |||
63 | let framerate = 30 | 78 | let framerate = 30 |
64 | let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) | 79 | let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) |
65 | SDL.delay (delay) | 80 | SDL.delay (delay) |
@@ -68,6 +83,14 @@ main = | |||
68 | 83 | ||
69 | loop Set.empty Set.empty clockSession_ netwireIsCool "" | 84 | loop Set.empty Set.empty clockSession_ netwireIsCool "" |
70 | 85 | ||
86 | widenRect a b = | ||
87 | let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect x2 _ w2 _)) = (a, b) in | ||
88 | (SDL.Rect x2 y1 w2 h1) | ||
89 | |||
90 | underNeath a b = | ||
91 | let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect _ _ _ h2)) = (a, b) in | ||
92 | (SDL.Rect x1 (y1+h2) w1 h1) | ||
93 | |||
71 | parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym) | 94 | parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym) |
72 | parseSDLEvents keysDown = do | 95 | parseSDLEvents keysDown = do |
73 | event <- SDL.pollEvent | 96 | event <- SDL.pollEvent |