From 7b3aa61462dc5a1135e01beedcbc98efe47ffb13 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" 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/BitmapFont.hs | 11 ++++++++-- src/Game/Controller.hs | 41 +++++++++++++++++++----------------- src/Game/Toaster.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 21 deletions(-) create mode 100644 src/Game/Toaster.hs (limited to 'src/Game') 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 -- cgit v1.2.3