Browse Source

build foundations for state machine

master
nek0 1 year ago
parent
commit
7c18915e9b
  1. 7
      pituicat.cabal
  2. 10
      shell.nix
  3. 24
      src/Main.hs
  4. 7
      src/State/Loading.hs
  5. 10
      src/State/Loading/Draw.hs
  6. 33
      src/State/Loading/Load.hs
  7. 10
      src/State/Loading/Update.hs
  8. 32
      src/StateMachine.hs

7
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

10
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;
};

24
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

7
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

10
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 ()

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

10
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 ()

32
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)
Loading…
Cancel
Save