start with Affectionate

src/Affection.hs

@@ -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))
+    (\wc -> SDL.createWindow windowTitle ((\(_,y,_) -> y) wc))
-    windowConfigs
+    windowConfigs <*>
-  mapM_ (SDL.showWindow . snd) windows
+    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
+  gameData <- loadState :: forall us. IO (Data us)
-    { quitEvent       = False
+  let initContainer = AffectionData
-    , userState       = x
+        { drawWindows     = windows
-    , drawWindows     = windows
+        , glContext       = contexts
-    , glContext       = contexts
+        , elapsedTime     = 0
-    , screenMode      = initScreenMode
+        , deltaTime       = 0
-    , elapsedTime     = 0
+        , sysTime         = execTime
-    , deltaTime       = 0
+        , pausedTime      = False
-    , sysTime         = execTime
+        }
-    , pausedTime      = False
-    }) <$> loadState
   (_, nState) <- runStateT ( A.runState $ do
     liftIO $ logIO Debug "Starting Loop"
-    preLoop
+    preLoop gameData
-    whileM_ (not . A.quitEvent <$> get)
+    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"

src/Affection/Types.hs

@@ -35,27 +35,12 @@ data AffectionConfig us = AffectionConfig
       -- ^ Window title
   , windowConfigs  ::
       [
-      ( Word             -- ^ Window identifier
+      ( Word             -- --^ Window identifier
-      , SDL.WindowConfig -- ^ Window config for given window
+      , 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.
+  { drawWindows     ::
-  , userState       :: us                 -- ^ State data provided by user
-  , drawWindows     ::
     [
-    ( Word                                -- ^ Window identifier
+    ( Word                                -- --^ Window identifier
-    , SDL.Window                          -- ^ Window linked with identifier
+    , SDL.Window                          -- --^ Window linked with identifier
+    , SDL.WindowMode                      -- -- ^ current screen mode
     )
     ]                                     -- ^ SDL windows
   , glContext       ::
     [
-    ( Word                                -- ^ Window identifier
+    ( Word                                -- --^ Window identifier
-    , SDL.GLContext                       -- ^ Associated OpenGL context
+    , 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
+newtype AffectionState sd m a = AffectionState
-  { runState :: AffectionStateInner us m a }
+  { runState :: AffectionStateInner sd m a }
-  deriving (Functor, Applicative, Monad, MonadIO, MonadState us)
+  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
 

src/Affection/Util.hs

@@ -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))