"Toaster" notifications

To provide feedback to the user when a controller is plugged/unplugged.

3 files changed, 87 insertions, 21 deletions

diff --git a/src/Game/BitmapFont.hs b/src/Game/BitmapFont.hs
index d42f293..e68ee26 100644
--- a/src/Game/BitmapFont.hs
+++ b/src/Game/BitmapFont.hs
@@ -1,4 +1,4 @@
-module Game.BitmapFont (BitmapFont, load, renderText) where
+module Game.BitmapFont (BitmapFont, load, renderText, renderTextSolid) where
 
 import Control.Monad
 import Data.Map (Map)
@@ -36,7 +36,7 @@ load filename tex = do
     Ok desc -> pure $ BitmapFont desc tex
     Error e -> error e
 
--- | Render a string at position x, y using the prodided bitmap font.
+-- | Render a string at position x, y using the provided bitmap font.
 renderText :: SDL.Renderer -> BitmapFont -> Int -> Int -> String -> IO ()
 renderText renderer (BitmapFont (FontDesc w h m) tex) x y text = mapM_ renderOne (zip [0 ..] text)
   where
@@ -47,3 +47,10 @@ renderText renderer (BitmapFont (FontDesc w h m) tex) x y text = mapM_ renderOne
         -- find the glyph or render the special one as error
         src = fromMaybe (U.rect (length m * w) 0 w h) (Map.lookup c m)
         dst = U.rect (x + i * w) y w h
+
+-- | Render a string like renderText but with a translucid background.
+renderTextSolid :: SDL.Renderer -> BitmapFont -> Int -> Int -> String -> IO ()
+renderTextSolid renderer font@(BitmapFont (FontDesc w h _) _) x y text = do
+  -- TODO: make the rect transparent
+  _ <- SDL.fillRect renderer (Just (U.rect (x - 5) (y - 5) (length text * w + 10) (h + 10)))
+  renderText renderer font x y text
diff --git a/src/Game/Controller.hs b/src/Game/Controller.hs
index d47963e..4d0ba81 100644
--- a/src/Game/Controller.hs
+++ b/src/Game/Controller.hs
@@ -4,6 +4,7 @@ import Control.Monad
 import Data.Int (Int32)
 import Data.Maybe (fromMaybe, isNothing)
 import Foreign.C (peekCAString)
+import qualified Game.Toaster as T
 import qualified SDL
 import qualified SDL.Input.GameController as SDL
 import qualified SDL.Raw
@@ -22,28 +23,27 @@ data Controls = Controls
   }
   deriving (Show)
 
-processControllerEvents :: Controls -> [SDL.EventPayload] -> IO Controls
-processControllerEvents controls (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceAdded joyIndex) : t) = do
+processControllerEvents :: Controls -> T.Toaster -> [SDL.EventPayload] -> IO (Controls, T.Toaster)
+processControllerEvents controls toaster (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceAdded joyIndex) : t) = do
   if isNothing controls.joyId
     then do
       joyName <- peekCAString =<< SDL.Raw.gameControllerNameForIndex (fromIntegral joyIndex)
-      putStrLn $ "Connected gamepad: " ++ show joyName
+      let toaster' = T.add toaster $ "Connected " ++ show joyName
       gc <- SDL.Raw.gameControllerOpen (fromIntegral joyIndex)
       joy <- SDL.Raw.gameControllerGetJoystick gc
       joyId <- SDL.Raw.joystickInstanceID joy
-      processControllerEvents controls {joyId = Just joyId, gc = Just gc} t
-    else processControllerEvents controls t
-processControllerEvents controls (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceRemoved joyId) : t) = do
-  c <-
+      processControllerEvents controls {joyId = Just joyId, gc = Just gc} toaster' t
+    else processControllerEvents controls toaster t
+processControllerEvents controls toaster (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceRemoved joyId) : t) = do
+  (c, toaster') <-
     if Just joyId == controls.joyId
       then do
         forM_ (controls.gc) SDL.Raw.gameControllerClose
-        putStrLn "Disconnected gamepad"
-        pure controls {joyId = Nothing, gc = Nothing}
-      else pure controls
-  processControllerEvents c t
-processControllerEvents controls (_ : t) = processControllerEvents controls t
-processControllerEvents controls [] = pure controls
+        pure (controls {joyId = Nothing, gc = Nothing}, T.add toaster "Gamepad disconnected")
+      else pure (controls, toaster)
+  processControllerEvents c toaster' t
+processControllerEvents controls toaster (_ : t) = processControllerEvents controls toaster t
+processControllerEvents controls toaster [] = pure (controls, toaster)
 
 init :: Controls
 init = Controls False False False False False False False Nothing Nothing
@@ -78,12 +78,15 @@ updateKeyboard controls events =
       menu = fromMaybe False $ isPressed SDL.KeycodeReturn events
     }
 
-update :: Controls -> [SDL.EventPayload] -> IO Controls
-update controls events = do
-  updated <- processControllerEvents controls events
-  pure $ case updated.joyId of
-    Just _ -> updateGamepad updated events
-    _ -> updateKeyboard updated events
+update :: Controls -> T.Toaster -> [SDL.EventPayload] -> IO (Controls, T.Toaster)
+update controls toaster events = do
+  (updated, toaster') <- processControllerEvents controls toaster events
+  pure
+    ( case updated.joyId of
+        Just _ -> updateGamepad updated events
+        _ -> updateKeyboard updated events,
+      toaster'
+    )
 
 isPressed :: SDL.Keycode -> [SDL.EventPayload] -> Maybe Bool
 isPressed code events
diff --git a/src/Game/Toaster.hs b/src/Game/Toaster.hs
new file mode 100644
index 0000000..e3fbc69
--- /dev/null
+++ b/src/Game/Toaster.hs
@@ -0,0 +1,56 @@
+module Game.Toaster
+  ( Toaster,
+    mkToaster,
+    add,
+    update,
+    render,
+  )
+where
+
+import qualified Game.BitmapFont as BM
+import qualified SDL
+
+toastDelay :: Int
+toastDelay = 128
+
+data Toast = Toast
+  { message :: String,
+    y :: Int,
+    delay :: Int
+  }
+
+data Toaster = Toaster
+  { font :: BM.BitmapFont,
+    gameHeight :: Int,
+    queue :: [String],
+    current :: Maybe Toast
+  }
+
+mkToaster :: BM.BitmapFont -> Int -> IO Toaster
+mkToaster font height = do
+  pure $ Toaster font height [] Nothing
+
+add :: Toaster -> String -> Toaster
+add t message =
+  t {queue = t.queue ++ [message]}
+
+update :: Toaster -> Toaster
+update t = case t.current of
+  Nothing -> case t.queue of
+    [] -> t
+    (next : _) -> t {current = Just $ Toast next t.gameHeight toastDelay, queue = tail t.queue}
+  -- FIXME: magic number
+  Just toast -> t {current = updateToast (t.gameHeight - 14) toast}
+  where
+    updateToast :: Int -> Toast -> Maybe Toast
+    updateToast height toast
+      | toast.y > height && toast.delay > 0 = Just $ toast {y = toast.y - 1}
+      | toast.delay > 0 = Just $ toast {delay = toast.delay - 1}
+      | toast.y < t.gameHeight = Just $ toast {y = toast.y + 1}
+      | otherwise = Nothing
+
+render :: SDL.Renderer -> Toaster -> IO ()
+render renderer t = case t.current of
+  Nothing -> pure ()
+  Just toast -> do
+    BM.renderTextSolid renderer t.font 4 toast.y toast.message