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.hs | 36 +++++++++++++++++++++----------- src/Game/BitmapFont.hs | 11 ++++++++-- src/Game/Controller.hs | 41 +++++++++++++++++++----------------- src/Game/Toaster.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 111 insertions(+), 33 deletions(-) create mode 100644 src/Game/Toaster.hs (limited to 'src') diff --git a/src/Game.hs b/src/Game.hs index c2f6083..d0092b6 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -12,6 +12,7 @@ import qualified Game.Hud as H import qualified Game.Map as M import qualified Game.Sprites as S import qualified Game.State as GS +import qualified Game.Toaster as T import SDL (($=)) import qualified SDL import qualified SDL.Image @@ -45,8 +46,9 @@ data Env = Env font :: BF.BitmapFont, entities :: E.Entities, hud :: H.Hud, + toaster :: T.Toaster, state :: GS.State, - controls :: IORef C.Controls + controlsRef :: IORef C.Controls } defaultRenderRect :: SDL.Rectangle CInt @@ -76,9 +78,10 @@ main = do map' <- M.load (head mapList) tsTexture sprites <- S.load "data/sprites.json" ssTexture font <- BF.load "data/font.json" bfTexture - controls <- newIORef C.init - entities <- E.mkEntities sprites map' controls + controlsRef <- newIORef C.init + entities <- E.mkEntities sprites map' controlsRef hud <- H.mkHud sprites font + toaster <- T.mkToaster font (fromIntegral gameHeight) gameLoop Env { window = window, @@ -93,8 +96,9 @@ main = do font = font, entities = entities, hud = hud, + toaster = toaster, state = GS.initialState map', - controls = controls + controlsRef = controlsRef } SDL.destroyWindow window SDL.quit @@ -133,22 +137,30 @@ gameLoop e = do let renderer = env.renderer canvas = env.canvas renderRect = env.renderRect - controls = env.controls + controlsRef = env.controlsRef state = env.state -- ESC or close the window to quit let quit = fromMaybe False (C.isPressed SDL.KeycodeEscape events) || SDL.QuitEvent `elem` events unless quit $ do -- update controls - writeIORef controls =<< (`C.update` events) =<< readIORef controls + updatedToasterEnv <- do + ctl <- readIORef controlsRef + C.update ctl env.toaster events + >>= ( \(ctl', toaster) -> do + writeIORef controlsRef ctl' + pure env {toaster = T.update toaster} + ) SDL.rendererRenderTarget renderer $= Just canvas SDL.clear renderer updatedEnv <- if state.gameOverDelay /= 1 - then playLoop =<< updateState env - else gameOverLoop env + then playLoop =<< updateState updatedToasterEnv + else gameOverLoop updatedToasterEnv + + T.render renderer updatedEnv.toaster SDL.rendererRenderTarget renderer $= Nothing SDL.clear renderer @@ -167,7 +179,7 @@ gameLoop e = do pure env {entities = es, state = state {GS.exit = True}} | state.levelCompleted == GS.ExitDone = do map' <- M.load (env.mapList !! (env.state.currentLevel + 1)) env.tsTexture - entities <- E.mkEntities env.sprites map' env.controls + entities <- E.mkEntities env.sprites map' env.controlsRef pure $ env { map = map', @@ -211,14 +223,14 @@ gameOverLoop e = do hud = e.hud font = e.font map' = e.map - controls = e.controls + controlsRef = e.controlsRef - ctl <- readIORef controls + ctl <- readIORef controlsRef if ctl.a then do -- retry last level - entities <- E.mkEntities sprites map' controls + entities <- E.mkEntities sprites map' controlsRef pure e {state = (GS.levelState e.state map') {GS.lives = GS.maxLives}, entities = entities} else do 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