build foundations for state machine

pituicat.cabal

@@ -24,13 +24,19 @@ executable pituicat
                      , Types.Texture
                      , Classes
                      , Classes.Bindable
+                     , State.Loading
+                     , State.Loading.Load
+                     , State.Loading.Update
+                     , State.Loading.Draw
                      , Map
+                     , StateMachine
                      , Texture
   -- other-extensions:
   build-depends:       base ^>=4.13.0.0
                      , affection
                      , stm
                      , OpenGL
+                     , OpenGLRaw
                      , sdl2
                      , containers
                      , linear
@@ -39,5 +45,6 @@ executable pituicat
                      , vector
                      , JuicyPixels
                      , JuicyPixels-extra
+                     , bytestring
   hs-source-dirs:      src
   default-language:    Haskell2010

shell.nix

@@ -24,16 +24,18 @@ let
       license = stdenv.lib.licenses.lgpl3;
     }) {};
 
-  f = { mkDerivation, aeson, base, containers, JuicyPixels, JuicyPixels-extra
-      , linear, OpenGL, stdenv , sdl2, stm, text, vector}:
+  f = { mkDerivation, aeson, base, bytestring, containers, JuicyPixels
+      , JuicyPixels-extra, linear, OpenGL, OpenGLRaw, stdenv , sdl2, stm, text
+      , vector}:
       mkDerivation {
         pname = "pituicat";
         version = "0.0.0.0";
         src = ./.;
         isLibrary = false;
         isExecutable = true;
-        executableHaskellDepends = [ aeson affection base linear containers
-        JuicyPixels JuicyPixels-extra OpenGL sdl2 stm text vector];
+        executableHaskellDepends = [ aeson affection base bytestring linear
+        containers JuicyPixels JuicyPixels-extra OpenGL OpenGLRaw sdl2 stm text
+        vector];
         license = stdenv.lib.licenses.gpl3;
       };
 

src/Main.hs

@@ -15,13 +15,14 @@ import Linear
 
 -- internal imports
 
+import StateMachine
 import Types
 
 instance Affectionate GameData where
-  preLoop _ = return ()
-  handleEvents _ _ = return ()
-  update _ _ = return ()
-  draw _ = return ()
+  preLoop = smLoad Loading
+  handleEvents = handle
+  update = Main.update
+  draw = Main.draw
   loadState = Main.init
   cleanUp _ = return ()
   hasNextStep = liftIO . atomically . readTVar . gameRunning
@@ -46,6 +47,21 @@ main = do
         } :: AffectionConfig GameData
   withAffection config
 
+handle :: GameData -> [SDL.EventPayload] -> Affection ()
+handle gd evs = do
+  state <- liftIO (atomically $ readTVar $ gameState gd)
+  smEvent state gd evs
+
+update :: GameData -> Double -> Affection ()
+update gd dt = do
+  state <- liftIO (atomically $ readTVar $ gameState gd)
+  smUpdate state gd dt
+
+draw :: GameData -> Affection ()
+draw gd = do
+  state <- liftIO (atomically $ readTVar $ gameState gd)
+  smDraw state gd
+
 init :: IO GameData
 init = GameData
   <$> newTVarIO Loading

src/State/Loading.hs

@@ -0,0 +1,7 @@
+module State.Loading
+  ( module L
+  ) where
+
+import State.Loading.Load as L
+import State.Loading.Update as L
+import State.Loading.Draw as L

src/State/Loading/Draw.hs

@@ -0,0 +1,10 @@
+module State.Loading.Draw where
+
+import Affection
+
+-- internal imports
+
+import Types
+
+initLoadDraw :: GameData -> Affection ()
+initLoadDraw gd = return ()

src/State/Loading/Load.hs

@@ -0,0 +1,33 @@
+module State.Loading.Load where
+
+import Affection
+
+import SDL (($=), get)
+import qualified SDL
+import qualified SDL.Internal.Numbered as SDL
+import qualified SDL.Raw.Video as SDL (glSetAttribute)
+import qualified SDL.Raw.Enum as SDL
+
+import qualified Graphics.Rendering.OpenGL as GL
+import qualified Graphics.GL as GLRaw
+
+import Foreign.Marshal.Array
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
+
+import Control.Concurrent.STM
+
+-- internal imports
+
+import Types
+import Map
+
+initLoadLoad
+  :: GameData
+  -> Affection ()
+initLoadLoad gd = do
+  stateData <- liftIO (TestData <$> constructMap testLevelDesc 0)
+  liftIO $ atomically $ do
+    writeTVar (gameStateData gd) stateData
+    writeTVar (gameState gd) (MainGame Test)

src/State/Loading/Update.hs

@@ -0,0 +1,10 @@
+module State.Loading.Update where
+
+import Affection
+
+-- internal imports
+
+import Types
+
+initLoadUpdate :: GameData -> Double -> Affection ()
+initLoadUpdate gd dt = return ()

src/StateMachine.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+module StateMachine where
+
+import Affection
+
+import Control.Monad (void)
+
+-- internal imports
+
+import Types
+
+import State.Loading
+
+instance StateMachine GameData State where
+
+  smLoad Loading = initLoadLoad
+  smLoad x       = error ("State load not yet implemented: " <> show x)
+
+  smUpdate Loading = initLoadUpdate
+  smUpdate x       = error ("State update not yet implemented: " <> show x)
+
+  smDraw Loading = initLoadDraw
+  smDraw x       = error ("State draw not yet implemented: " <> show x)
+
+  smEvent _ gd evs = do
+    let Subsystems w m k _ = gameSubsystems gd
+    void . (consumeSDLEvents k) =<<
+      consumeSDLEvents m =<<
+      consumeSDLEvents w evs
+
+  smClean x = error ("State clean not yet implemented: " <> show x)