diff options
Diffstat (limited to 'axis.hs')
-rw-r--r-- | axis.hs | 37 |
1 files changed, 14 insertions, 23 deletions
@@ -51,26 +51,13 @@ main = | |||
51 | 51 | ||
52 | Control.Monad.when (x /= x' && x' /= "") $ do | 52 | Control.Monad.when (x /= x' && x' /= "") $ do |
53 | putStrLn x' | 53 | putStrLn x' |
54 | fontSurface <- SDL.TTF.renderUTF8Blended font x' (SDL.Color 0 255 0) | 54 | textBand videoSurface videoClipRect (SDL.Rect 0 0 0 70) font x' |
55 | fontClipRect <- SDL.getClipRect fontSurface | ||
56 | _ <- SDL.fillRect videoSurface (Just (widenRect fontClipRect videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band | ||
57 | _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just fontClipRect) | ||
58 | return () | 55 | return () |
59 | 56 | ||
60 | Control.Monad.when (midiKeysDown' /= midiKeysDown) $ do | 57 | Control.Monad.when (midiKeysDown' /= midiKeysDown) $ do |
61 | let chord = showChord midiKeysDown' | 58 | let chord = showChord midiKeysDown' |
62 | putStrLn chord | 59 | Control.Monad.when (chord /= "") $ putStrLn chord |
63 | if (chord /= "") | 60 | textBand videoSurface videoClipRect (SDL.Rect 0 70 0 70) font 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 () | 61 | return () |
75 | 62 | ||
76 | _ <- SDL.updateRect videoSurface videoClipRect | 63 | _ <- SDL.updateRect videoSurface videoClipRect |
@@ -83,13 +70,17 @@ main = | |||
83 | 70 | ||
84 | loop Set.empty Set.empty clockSession_ netwireIsCool "" | 71 | loop Set.empty Set.empty clockSession_ netwireIsCool "" |
85 | 72 | ||
86 | widenRect a b = | 73 | -- clear a band the width of the videoClipRect and print the text within it, centered |
87 | let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect x2 _ w2 _)) = (a, b) in | 74 | textBand videoSurface videoClipRect (SDL.Rect _ y _ h) font text = do |
88 | (SDL.Rect x2 y1 w2 h1) | 75 | let (SDL.Rect vx _ vw _) = videoClipRect |
89 | 76 | _ <- SDL.fillRect videoSurface (Just (SDL.Rect 0 y vw h)) (SDL.Pixel 0) | |
90 | underNeath a b = | 77 | Control.Monad.when (text /= "") $ do |
91 | let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect _ _ _ h2)) = (a, b) in | 78 | fontSurface <- SDL.TTF.renderUTF8Blended font text (SDL.Color 0 255 0) |
92 | (SDL.Rect x1 (y1+h2) w1 h1) | 79 | fontClipRect <- SDL.getClipRect fontSurface |
80 | let (SDL.Rect _ fy fw _) = fontClipRect | ||
81 | _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect ((vw - fw) `div` 2) y vw h)) | ||
82 | return () | ||
83 | return () | ||
93 | 84 | ||
94 | parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym) | 85 | parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym) |
95 | parseSDLEvents keysDown = do | 86 | parseSDLEvents keysDown = do |