aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-03-01 20:23:56 +0000
committerJuan J. Martinez <jjm@usebox.net>2023-03-01 20:23:56 +0000
commit16039ab6f25b5c10421d9d0bd96a3d97a0d2d5c9 (patch)
tree1c0d2dd9f404f7501301b411b38df9c0bbf77d10
parentf0507125e06e3e8939f259e9468d797e9a8e668e (diff)
downloadspace-plat-hs-16039ab6f25b5c10421d9d0bd96a3d97a0d2d5c9.tar.gz
space-plat-hs-16039ab6f25b5c10421d9d0bd96a3d97a0d2d5c9.zip
Removed unnecessary IORef
-rw-r--r--src/Game.hs82
1 files changed, 38 insertions, 44 deletions
diff --git a/src/Game.hs b/src/Game.hs
index d8ce8b6..2d8c23a 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -40,8 +40,8 @@ data Env = Env
{ window :: SDL.Window,
renderer :: SDL.Renderer,
canvas :: SDL.Texture,
- fullscreen :: IORef Bool,
- renderRect :: IORef (SDL.Rectangle CInt),
+ fullscreen :: Bool,
+ renderRect :: SDL.Rectangle CInt,
controls :: IORef C.Controls,
map :: M.Map,
sprites :: S.SpriteSheet,
@@ -71,8 +71,6 @@ main = do
}
SDL.HintRenderScaleQuality $= SDL.ScaleNearest
canvas <- SDL.createTexture renderer SDL.RGBA8888 SDL.TextureAccessTarget (V2 gameWidth gameHeight)
- fullscreen <- newIORef False
- renderRect <- newIORef defaultRenderRect
tsTexture <- SDL.Image.loadTexture renderer "data/tiles.png"
ssTexture <- SDL.Image.loadTexture renderer "data/sprites.png"
bfTexture <- SDL.Image.loadTexture renderer "data/font.png"
@@ -97,8 +95,8 @@ main = do
{ window = window,
renderer = renderer,
canvas = canvas,
- fullscreen = fullscreen,
- renderRect = renderRect,
+ fullscreen = False,
+ renderRect = defaultRenderRect,
controls = controls,
map = map',
sprites = sprites,
@@ -110,43 +108,40 @@ main = do
SDL.destroyWindow window
SDL.quit
-toggleFullscreen :: Env -> IO ()
-toggleFullscreen env = do
- let fullscreen = env.fullscreen
- renderRect = env.renderRect
- renderer = env.renderer
- window = env.window
- fullscreen $~ not
- fs <- SDL.get fullscreen
- let mode = if fs then SDL.FullscreenDesktop else SDL.Windowed
- in SDL.setWindowMode window mode
-
- vp <- if fs then SDL.get $ SDL.rendererViewport renderer else pure Nothing
- let newRenderRect = case vp of
- Nothing -> defaultRenderRect
- Just (SDL.Rectangle _ (V2 w h)) ->
- SDL.Rectangle (SDL.P $ V2 rx ry) (V2 rw rh)
- where
- scale = min (w `div` gameWidth) (h `div` gameHeight)
- rx = (w - (gameWidth * scale)) `div` 2
- ry = (h - (gameHeight * scale)) `div` 2
- rw = gameWidth * scale
- rh = gameHeight * scale
- in renderRect $= newRenderRect
+toggleFullscreen :: Env -> IO Env
+toggleFullscreen env =
+ do
+ let fullscreen = not env.fullscreen
+ renderer = env.renderer
+ window = env.window
+ let mode = if fullscreen then SDL.FullscreenDesktop else SDL.Windowed
+ in SDL.setWindowMode window mode
+
+ vp <- if fullscreen then SDL.get $ SDL.rendererViewport renderer else pure Nothing
+ let renderRect = case vp of
+ Nothing -> defaultRenderRect
+ Just (SDL.Rectangle _ (V2 w h)) -> SDL.Rectangle (SDL.P $ V2 rx ry) (V2 rw rh)
+ where
+ scale = min (w `div` gameWidth) (h `div` gameHeight)
+ rx = (w - (gameWidth * scale)) `div` 2
+ ry = (h - (gameHeight * scale)) `div` 2
+ rw = gameWidth * scale
+ rh = gameHeight * scale
+ pure env {fullscreen = fullscreen, renderRect = renderRect}
gameLoop :: Env -> IO ()
-gameLoop env = do
+gameLoop e = do
+ events <- map SDL.eventPayload <$> SDL.pollEvents
+
+ -- F11 for fullscreen / windowed
+ env <- if fromMaybe False $ U.isPressed SDL.KeycodeF11 events then toggleFullscreen e else pure e
+
let renderer = env.renderer
canvas = env.canvas
renderRect = env.renderRect
controls = env.controls
stateRef = env.state
- events <- map SDL.eventPayload <$> SDL.pollEvents
-
- -- F11 for fullscreen / windowed
- when (fromMaybe False $ U.isPressed SDL.KeycodeF11 events) $ toggleFullscreen env
-
-- ESC or close the window to quit
let quit = fromMaybe False (U.isPressed SDL.KeycodeEscape events) || SDL.QuitEvent `elem` events
unless quit $ do
@@ -163,8 +158,7 @@ gameLoop env = do
SDL.rendererRenderTarget renderer $= Nothing
SDL.clear renderer
- rect <- SDL.get renderRect
- SDL.copy renderer canvas Nothing (Just rect)
+ SDL.copy renderer canvas Nothing (Just renderRect)
SDL.present renderer
@@ -172,10 +166,10 @@ gameLoop env = do
where
playLoop :: IO ()
playLoop = do
- let renderer = env.renderer
- map' = env.map
- entities = env.entities
- hud = env.hud
+ let renderer = e.renderer
+ map' = e.map
+ entities = e.entities
+ hud = e.hud
updated <- E.updateAll =<< readIORef entities
entities $= updated
@@ -196,9 +190,9 @@ gameLoop env = do
gameOverLoop :: IO ()
gameOverLoop = do
- let renderer = env.renderer
- sprites = env.sprites
- hud = env.hud
+ let renderer = e.renderer
+ sprites = e.sprites
+ hud = e.hud
H.render renderer hud
title <- S.get sprites "game-over"