From 3284de97381580cb428949fa1945f77d092ceb3e Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 15 Jan 2014 14:24:54 -0500 Subject: render netwire hooray text in SDL --- axis.hs | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) (limited to 'axis.hs') diff --git a/axis.hs b/axis.hs index 64217ea..37b187f 100644 --- a/axis.hs +++ b/axis.hs @@ -8,6 +8,7 @@ import Control.Monad import qualified Graphics.UI.SDL as SDL import AlsaSeq import qualified Data.Set as Set +import qualified Graphics.UI.SDL.TTF as SDL.TTF netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String netwireIsCool = @@ -32,6 +33,12 @@ main = height = SDL.videoInfoHeight info --screen <- SDL.setVideoMode width height 32 [SDL.SWSurface, SDL.Fullscreen] screen <- SDL.setVideoMode width height 32 [SDL.SWSurface] + + _ <- SDL.TTF.init + font <- SDL.TTF.openFont "LiberationMono-Bold.ttf" 30 + videoSurface <- SDL.getVideoSurface + videoClipRect <- SDL.getClipRect videoSurface + putStrLn "Initialized." let parseAlsa keysDown = parseAlsaEvents h keysDown (forwardNoteEvent h q publicAddr) @@ -41,7 +48,18 @@ main = (ds, s') <- stepSession s (ex, w') <- stepWire w ds (Right x) let x' = either (const "") id ex - Control.Monad.when (x /= x' && x' /= "") $ putStrLn x' + + 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 fontClipRect) (SDL.Pixel 0) + _ <- SDL.fillRect videoSurface (Just videoClipRect) (SDL.Pixel 0) + _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just fontClipRect) +-- _ <- SDL.updateRect videoSurface fontClipRect + _ <- SDL.updateRect videoSurface videoClipRect + return () + let framerate = 30 let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) SDL.delay (delay) -- cgit v1.2.3