start with Affectionate
This commit is contained in:
parent
65d47f7477
commit
13f67c6cd1
3 changed files with 48 additions and 77 deletions
|
|
@ -1,5 +1,8 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
module Affection
|
||||
( withAffection
|
||||
, get
|
||||
|
|
@ -22,6 +25,7 @@ import Control.Monad.IO.Class (liftIO)
|
|||
import Foreign.C.Types (CInt(..))
|
||||
|
||||
import Affection.Types as A
|
||||
import Affection.Class as A
|
||||
import Affection.StateMachine as A
|
||||
import Affection.Util as A
|
||||
import Affection.MessageBus as A
|
||||
|
|
@ -34,7 +38,8 @@ import qualified Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
|
|||
|
||||
-- | Main function which bootstraps everything else.
|
||||
withAffection
|
||||
:: AffectionConfig us -- ^ Configuration of the Game and its engine.
|
||||
:: (Affectionate us)
|
||||
=> AffectionConfig us -- ^ Configuration of the Game and its engine.
|
||||
-> IO ()
|
||||
withAffection AffectionConfig{..} = do
|
||||
liftIO $ logIO Debug "Affection starting"
|
||||
|
|
@ -54,38 +59,39 @@ withAffection AffectionConfig{..} = do
|
|||
logIO Warn "Linear texture filtering not enabled!"
|
||||
-- construct window
|
||||
liftIO $ logIO Debug "Creating Window(s)"
|
||||
windows <- zip (map fst windowConfigs) <$>
|
||||
windows <- zip3 (map (\(x,_,_) -> x) windowConfigs) <$>
|
||||
mapM
|
||||
(\wc -> SDL.createWindow windowTitle (snd wc))
|
||||
windowConfigs
|
||||
mapM_ (SDL.showWindow . snd) windows
|
||||
(\wc -> SDL.createWindow windowTitle ((\(_,y,_) -> y) wc))
|
||||
windowConfigs <*>
|
||||
pure (map (\(_,_,z) -> z) windowConfigs)
|
||||
|
||||
mapM_ (SDL.showWindow . (\(_,y,_) -> y)) windows
|
||||
_ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
|
||||
contexts <- zip (map fst windows) <$> mapM (SDL.glCreateContext . snd) windows
|
||||
contexts <- zip (map (\(x,_,_) -> x) windows) <$>
|
||||
mapM (SDL.glCreateContext . (\(_,y,_) -> y)) windows
|
||||
-- let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfigs
|
||||
-- (w, h) = case canvasSize of
|
||||
-- Just (cw, ch) -> (cw, ch)
|
||||
-- Nothing -> (fromIntegral rw, fromIntegral rh)
|
||||
mapM_ (flip SDL.setWindowMode initScreenMode . snd) windows
|
||||
mapM_ (\w -> flip SDL.setWindowMode ((\(_,_,z) -> z) w) ((\(_,y,_) -> y) w)) windows
|
||||
-- SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows
|
||||
liftIO $ logIO Debug "Getting Time"
|
||||
-- get current time
|
||||
execTime <- getTime Monotonic
|
||||
liftIO $ logIO Debug "Loading initial data container"
|
||||
initContainer <- (\x -> AffectionData
|
||||
{ quitEvent = False
|
||||
, userState = x
|
||||
, drawWindows = windows
|
||||
gameData <- loadState :: forall us. IO (Data us)
|
||||
let initContainer = AffectionData
|
||||
{ drawWindows = windows
|
||||
, glContext = contexts
|
||||
, screenMode = initScreenMode
|
||||
, elapsedTime = 0
|
||||
, deltaTime = 0
|
||||
, sysTime = execTime
|
||||
, pausedTime = False
|
||||
}) <$> loadState
|
||||
}
|
||||
(_, nState) <- runStateT ( A.runState $ do
|
||||
liftIO $ logIO Debug "Starting Loop"
|
||||
preLoop
|
||||
whileM_ (not . A.quitEvent <$> get)
|
||||
preLoop gameData
|
||||
whileM_ (hasNextStep gameData)
|
||||
(do
|
||||
-- get state
|
||||
ad <- get
|
||||
|
|
@ -103,15 +109,15 @@ withAffection AffectionConfig{..} = do
|
|||
-- poll events
|
||||
evs <- preHandleEvents =<< liftIO SDL.pollEvents
|
||||
-- handle events
|
||||
eventLoop evs
|
||||
handleEvents gameData evs
|
||||
-- execute user defined update loop
|
||||
unless (pausedTime ad) (updateLoop dt)
|
||||
unless (pausedTime ad) (update gameData dt)
|
||||
-- execute user defined draw loop
|
||||
liftIO $ GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
|
||||
drawLoop
|
||||
draw gameData
|
||||
liftIO GL.flush
|
||||
-- actual displaying of newly drawn frame
|
||||
mapM_ (SDL.glSwapWindow . snd) windows
|
||||
mapM_ (SDL.glSwapWindow . (\(_,y,_) -> y)) windows
|
||||
-- save new time
|
||||
ad3 <- get
|
||||
when (sysTime ad == sysTime ad3) (
|
||||
|
|
@ -122,9 +128,9 @@ withAffection AffectionConfig{..} = do
|
|||
)
|
||||
) initContainer
|
||||
liftIO $ logIO Debug "Loop ended. Cleaning"
|
||||
cleanUp $ userState nState
|
||||
cleanUp gameData
|
||||
liftIO $ logIO Debug "Destroying Window"
|
||||
mapM_ (SDL.glDeleteContext . snd) contexts
|
||||
mapM_ (SDL.destroyWindow . snd) windows
|
||||
mapM_ (SDL.destroyWindow . (\(_,y,_) -> y)) windows
|
||||
-- SDL.quit -- <- This causes segfaults depending on hardware
|
||||
liftIO $ logIO Debug "This is the end"
|
||||
|
|
|
|||
|
|
@ -35,27 +35,12 @@ data AffectionConfig us = AffectionConfig
|
|||
-- ^ Window title
|
||||
, windowConfigs ::
|
||||
[
|
||||
( Word -- ^ Window identifier
|
||||
, SDL.WindowConfig -- ^ Window config for given window
|
||||
( Word -- --^ Window identifier
|
||||
, SDL.WindowConfig -- --^ Window config for given window
|
||||
, SDL.WindowMode -- -- ^ Window mode to start in
|
||||
)
|
||||
]
|
||||
-- ^ Window configurations
|
||||
, canvasSize :: Maybe (Int, Int)
|
||||
-- ^ size of the texture canvas
|
||||
, initScreenMode :: SDL.WindowMode
|
||||
-- ^ Window mode to start in
|
||||
, loadState :: IO us
|
||||
-- ^ Provide your own load function to create this data.
|
||||
, preLoop :: Affection us ()
|
||||
-- ^ Actions to be performed, before loop starts
|
||||
, eventLoop :: [SDL.EventPayload] -> Affection us ()
|
||||
-- ^ Main update function. Takes fractions of a second as input.
|
||||
, updateLoop :: Double -> Affection us ()
|
||||
-- ^ Main update function. Takes fractions of a second as input.
|
||||
, drawLoop :: Affection us ()
|
||||
-- ^ Function for updating graphics.
|
||||
, cleanUp :: us -> IO ()
|
||||
-- ^ Provide your own finisher function to clean your data.
|
||||
}
|
||||
|
||||
-- | Components to initialize in SDL.
|
||||
|
|
@ -65,18 +50,17 @@ data InitComponents
|
|||
|
||||
-- | Main type for defining the look, feel and action of the whole application.
|
||||
data AffectionData us = AffectionData
|
||||
{ quitEvent :: Bool -- ^ Loop breaker.
|
||||
, userState :: us -- ^ State data provided by user
|
||||
, drawWindows ::
|
||||
{ drawWindows ::
|
||||
[
|
||||
( Word -- ^ Window identifier
|
||||
, SDL.Window -- ^ Window linked with identifier
|
||||
( Word -- --^ Window identifier
|
||||
, SDL.Window -- --^ Window linked with identifier
|
||||
, SDL.WindowMode -- -- ^ current screen mode
|
||||
)
|
||||
] -- ^ SDL windows
|
||||
, glContext ::
|
||||
[
|
||||
( Word -- ^ Window identifier
|
||||
, SDL.GLContext -- ^ Associated OpenGL context
|
||||
( Word -- --^ Window identifier
|
||||
, SDL.GLContext -- --^ Associated OpenGL context
|
||||
)
|
||||
] -- ^ OpenGL rendering contexts
|
||||
, screenMode :: SDL.WindowMode -- ^ current screen mode
|
||||
|
|
@ -87,14 +71,14 @@ data AffectionData us = AffectionData
|
|||
}
|
||||
|
||||
-- | Inner 'StateT' monad for the update state
|
||||
type AffectionStateInner us a = StateT us a
|
||||
type AffectionStateInner sd a = StateT sd a
|
||||
|
||||
-- | Affection's state monad
|
||||
newtype AffectionState us m a = AffectionState
|
||||
{ runState :: AffectionStateInner us m a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadState us)
|
||||
newtype AffectionState sd m a = AffectionState
|
||||
{ runState :: AffectionStateInner sd m a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadState sd)
|
||||
|
||||
instance MP.MonadParallel m => MP.MonadParallel (AffectionState us m)
|
||||
instance MP.MonadParallel m => MP.MonadParallel (AffectionState sd m)
|
||||
|
||||
type Affection us a = AffectionState (AffectionData us) IO a
|
||||
|
||||
|
|
|
|||
|
|
@ -19,19 +19,6 @@ preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload]
|
|||
preHandleEvents evs =
|
||||
return $ map SDL.eventPayload evs
|
||||
|
||||
-- | Return the userstate to the user
|
||||
getAffection :: Affection us us
|
||||
getAffection = gets userState
|
||||
|
||||
-- | Put altered user state back
|
||||
putAffection
|
||||
:: us -- User state
|
||||
-> Affection us ()
|
||||
putAffection us = do
|
||||
ad <- get
|
||||
put $ ad
|
||||
{ userState = us }
|
||||
|
||||
-- | block a thread for a specified amount of time
|
||||
delaySec
|
||||
:: Int -- ^ Number of seconds
|
||||
|
|
@ -46,12 +33,6 @@ getElapsedTime = gets elapsedTime
|
|||
getDelta :: Affection us Double
|
||||
getDelta = gets deltaTime
|
||||
|
||||
-- | Quit the engine loop
|
||||
quit :: Affection us ()
|
||||
quit = do
|
||||
ad <- get
|
||||
put $ ad { quitEvent = True }
|
||||
|
||||
-- | Toggle the Screen mode between 'SDL.Windowed' and 'SDL.FullscreenDesktop'.
|
||||
-- Pauses the Engine in the process.
|
||||
toggleScreen :: Affection us ()
|
||||
|
|
@ -59,10 +40,10 @@ toggleScreen = do
|
|||
ad <- get
|
||||
newMode <- case screenMode ad of
|
||||
SDL.Windowed -> do
|
||||
mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . snd) (drawWindows ad)
|
||||
mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . (\(_,y,_) -> y)) (drawWindows ad)
|
||||
return SDL.FullscreenDesktop
|
||||
SDL.FullscreenDesktop -> do
|
||||
mapM_ (flip SDL.setWindowMode SDL.Windowed . snd) (drawWindows ad)
|
||||
mapM_ (flip SDL.setWindowMode SDL.Windowed . (\(_,y,_) -> y)) (drawWindows ad)
|
||||
return SDL.Windowed
|
||||
x -> do
|
||||
liftIO $ logIO Warn ("Unexpected Screen mode: " <> fromString (show x))
|
||||
|
|
|
|||
Loading…
Reference in a new issue