aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-04-15 22:59:15 +0100
committerJuan J. Martinez <jjm@usebox.net>2023-04-15 22:59:15 +0100
commit7b3aa61462dc5a1135e01beedcbc98efe47ffb13 (patch)
tree7969d4f80f2640f9b51690eb853993131ad48454 /src
parent631c611d929ea8fb633fdaa285485b6dbd5db702 (diff)
downloadspace-plat-hs-7b3aa61462dc5a1135e01beedcbc98efe47ffb13.tar.gz
space-plat-hs-7b3aa61462dc5a1135e01beedcbc98efe47ffb13.zip
"Toaster" notifications
To provide feedback to the user when a controller is plugged/unplugged.
Diffstat (limited to 'src')
-rw-r--r--src/Game.hs36
-rw-r--r--src/Game/BitmapFont.hs11
-rw-r--r--src/Game/Controller.hs41
-rw-r--r--src/Game/Toaster.hs56
4 files changed, 111 insertions, 33 deletions
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