From 3f4fa5d43194479c9137d729097ddf1645e04136 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 15 Jan 2014 17:45:26 -0500 Subject: factor out textBand function to draw text over full width of screen --- axis.hs | 37 ++++++++++++++----------------------- 1 file changed, 14 insertions(+), 23 deletions(-) (limited to 'axis.hs') diff --git a/axis.hs b/axis.hs index 3e0b8b1..da42259 100644 --- a/axis.hs +++ b/axis.hs @@ -51,26 +51,13 @@ main = Control.Monad.when (x /= x' && x' /= "") $ do putStrLn x' - fontSurface <- SDL.TTF.renderUTF8Blended font x' (SDL.Color 0 255 0) - fontClipRect <- SDL.getClipRect fontSurface - _ <- SDL.fillRect videoSurface (Just (widenRect fontClipRect videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band - _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just fontClipRect) + textBand videoSurface videoClipRect (SDL.Rect 0 0 0 70) font x' return () Control.Monad.when (midiKeysDown' /= midiKeysDown) $ do let chord = showChord midiKeysDown' - putStrLn chord - if (chord /= "") - then do - chordFontSurface <- SDL.TTF.renderUTF8Blended font chord (SDL.Color 0 255 0) - chordFontClipRect <- SDL.getClipRect chordFontSurface - let r = chordFontClipRect `underNeath` (SDL.Rect 0 0 0 70) - _ <- SDL.fillRect videoSurface (Just (widenRect r videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band - _ <- SDL.blitSurface chordFontSurface (Just chordFontClipRect) videoSurface (Just r) - return () - else do - _ <- SDL.fillRect videoSurface (Just (widenRect (SDL.Rect 0 70 0 70) videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band - return () + Control.Monad.when (chord /= "") $ putStrLn chord + textBand videoSurface videoClipRect (SDL.Rect 0 70 0 70) font chord return () _ <- SDL.updateRect videoSurface videoClipRect @@ -83,13 +70,17 @@ main = loop Set.empty Set.empty clockSession_ netwireIsCool "" -widenRect a b = - let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect x2 _ w2 _)) = (a, b) in - (SDL.Rect x2 y1 w2 h1) - -underNeath a b = - let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect _ _ _ h2)) = (a, b) in - (SDL.Rect x1 (y1+h2) w1 h1) +-- clear a band the width of the videoClipRect and print the text within it, centered +textBand videoSurface videoClipRect (SDL.Rect _ y _ h) font text = do + let (SDL.Rect vx _ vw _) = videoClipRect + _ <- SDL.fillRect videoSurface (Just (SDL.Rect 0 y vw h)) (SDL.Pixel 0) + Control.Monad.when (text /= "") $ do + fontSurface <- SDL.TTF.renderUTF8Blended font text (SDL.Color 0 255 0) + fontClipRect <- SDL.getClipRect fontSurface + let (SDL.Rect _ fy fw _) = fontClipRect + _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect ((vw - fw) `div` 2) y vw h)) + return () + return () parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym) parseSDLEvents keysDown = do -- cgit v1.2.3