linted
This commit is contained in:
parent
26e6825d0e
commit
5567b515e8
1 changed files with 15 additions and 16 deletions
31
src/Main.hs
31
src/Main.hs
|
@ -10,7 +10,7 @@ import qualified SDL.Raw.Enum as SDL
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import Control.Monad (when, void)
|
import Control.Monad (when, void, unless)
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
|
@ -35,7 +35,7 @@ instance Affectionate GameData where
|
||||||
draw = Main.draw
|
draw = Main.draw
|
||||||
loadState = Main.init
|
loadState = Main.init
|
||||||
cleanUp _ = return ()
|
cleanUp _ = return ()
|
||||||
hasNextStep = liftIO . atomically . readTVar . gameRunning
|
hasNextStep = liftIO . readTVarIO . gameRunning
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -63,14 +63,13 @@ preLoad gd = do
|
||||||
(subKeyboard $ gameSubsystems gd)
|
(subKeyboard $ gameSubsystems gd)
|
||||||
(\mesg ->
|
(\mesg ->
|
||||||
case mesg of
|
case mesg of
|
||||||
(MsgKeyboardEvent time win motion False keysym) -> do
|
(MsgKeyboardEvent time _ motion False keysym) -> do
|
||||||
translator <- liftIO $ atomically $ readTVar (gameActionTranslation gd)
|
translator <- liftIO $ readTVarIO (gameActionTranslation gd)
|
||||||
case
|
case
|
||||||
(
|
( SDL.keysymScancode keysym
|
||||||
( SDL.keysymScancode keysym
|
, translateSDLModifiers (SDL.keysymModifier keysym)
|
||||||
, translateSDLModifiers (SDL.keysymModifier keysym)
|
) `M.lookup`
|
||||||
) `M.lookup`
|
translator
|
||||||
translator)
|
|
||||||
of
|
of
|
||||||
Just action ->
|
Just action ->
|
||||||
partEmit
|
partEmit
|
||||||
|
@ -84,9 +83,9 @@ preLoad gd = do
|
||||||
windowCloseUUID <- partSubscribe
|
windowCloseUUID <- partSubscribe
|
||||||
(subWindow $ gameSubsystems gd)
|
(subWindow $ gameSubsystems gd)
|
||||||
(\mesg -> case mesg of
|
(\mesg -> case mesg of
|
||||||
MsgWindowClose time win ->
|
MsgWindowClose _ _ ->
|
||||||
liftIO $ atomically $ writeTVar (gameRunning gd) False
|
liftIO $ atomically $ writeTVar (gameRunning gd) False
|
||||||
MsgWindowResize _ _ _ ->
|
MsgWindowResize {} ->
|
||||||
fitViewport (800 / 600) mesg
|
fitViewport (800 / 600) mesg
|
||||||
_ ->
|
_ ->
|
||||||
return ()
|
return ()
|
||||||
|
@ -97,7 +96,7 @@ preLoad gd = do
|
||||||
|
|
||||||
handle :: GameData -> [SDL.EventPayload] -> Affection ()
|
handle :: GameData -> [SDL.EventPayload] -> Affection ()
|
||||||
handle gd evs = do
|
handle gd evs = do
|
||||||
state <- liftIO (atomically $ readTVar $ gameState gd)
|
state <- liftIO (readTVarIO $ gameState gd)
|
||||||
smEvent state gd evs
|
smEvent state gd evs
|
||||||
|
|
||||||
update :: GameData -> Double -> Affection ()
|
update :: GameData -> Double -> Affection ()
|
||||||
|
@ -105,7 +104,7 @@ update gd dt = do
|
||||||
loadProgress <- liftIO $ atomically $ readTMVar $ gameStateLoadProgress gd
|
loadProgress <- liftIO $ atomically $ readTMVar $ gameStateLoadProgress gd
|
||||||
when (fst loadProgress < 1) $
|
when (fst loadProgress < 1) $
|
||||||
liftIO (logIO Verbose ("Progress: " <> snd loadProgress))
|
liftIO (logIO Verbose ("Progress: " <> snd loadProgress))
|
||||||
state <- liftIO $ atomically $ readTVar $ gameState gd
|
state <- liftIO $ readTVarIO $ gameState gd
|
||||||
isStagePresent <- liftIO $ atomically $ fmap not $ isEmptyTMVar $ gameScene gd
|
isStagePresent <- liftIO $ atomically $ fmap not $ isEmptyTMVar $ gameScene gd
|
||||||
if isStagePresent
|
if isStagePresent
|
||||||
then do
|
then do
|
||||||
|
@ -127,12 +126,12 @@ update gd dt = do
|
||||||
|
|
||||||
draw :: GameData -> Affection ()
|
draw :: GameData -> Affection ()
|
||||||
draw gd = do
|
draw gd = do
|
||||||
state <- liftIO (atomically $ readTVar $ gameState gd)
|
state <- liftIO (readTVarIO $ gameState gd)
|
||||||
liftIO $ logIO Verbose (fromString $ "now drawing: " <> show state)
|
liftIO $ logIO Verbose (fromString $ "now drawing: " <> show state)
|
||||||
GL.clearColor $= GL.Color4 0 0 0 1
|
GL.clearColor $= GL.Color4 0 0 0 1
|
||||||
smDraw state gd
|
smDraw state gd
|
||||||
err <- SDL.get GL.errors
|
err <- SDL.get GL.errors
|
||||||
when (not $ null err) (liftIO $ logIO Error ("loop errors: " <> fromString (show err)))
|
unless (null err) (liftIO $ logIO Error ("loop errors: " <> fromString (show err)))
|
||||||
|
|
||||||
init :: IO GameData
|
init :: IO GameData
|
||||||
init = do
|
init = do
|
||||||
|
@ -140,7 +139,7 @@ init = do
|
||||||
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
|
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
|
||||||
void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
|
void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
|
||||||
GameData
|
GameData
|
||||||
<$> (newTMVarIO =<< (Stage <$> (initScene :: IO Test)))
|
<$> (newTMVarIO . Stage =<< (initScene :: IO Test))
|
||||||
<*> newTVarIO Loading
|
<*> newTVarIO Loading
|
||||||
<*> newTMVarIO (0, "Ohai!")
|
<*> newTMVarIO (0, "Ohai!")
|
||||||
<*> (Subsystems
|
<*> (Subsystems
|
||||||
|
|
Loading…
Reference in a new issue