render netwire hooray text in SDL

1 files changed, 19 insertions, 1 deletions

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)