From 7b3aa61462dc5a1135e01beedcbc98efe47ffb13 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Sat, 15 Apr 2023 22:59:15 +0100
Subject: "Toaster" notifications

To provide feedback to the user when a controller is plugged/unplugged.
---
 src/Game/Toaster.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)
 create mode 100644 src/Game/Toaster.hs

(limited to 'src/Game/Toaster.hs')

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
-- 
cgit v1.2.3