build foundations for state machine
This commit is contained in:
parent
cf520852d0
commit
7c18915e9b
|
@ -24,13 +24,19 @@ executable pituicat
|
||||||
, Types.Texture
|
, Types.Texture
|
||||||
, Classes
|
, Classes
|
||||||
, Classes.Bindable
|
, Classes.Bindable
|
||||||
|
, State.Loading
|
||||||
|
, State.Loading.Load
|
||||||
|
, State.Loading.Update
|
||||||
|
, State.Loading.Draw
|
||||||
, Map
|
, Map
|
||||||
|
, StateMachine
|
||||||
, Texture
|
, Texture
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: base ^>=4.13.0.0
|
build-depends: base ^>=4.13.0.0
|
||||||
, affection
|
, affection
|
||||||
, stm
|
, stm
|
||||||
, OpenGL
|
, OpenGL
|
||||||
|
, OpenGLRaw
|
||||||
, sdl2
|
, sdl2
|
||||||
, containers
|
, containers
|
||||||
, linear
|
, linear
|
||||||
|
@ -39,5 +45,6 @@ executable pituicat
|
||||||
, vector
|
, vector
|
||||||
, JuicyPixels
|
, JuicyPixels
|
||||||
, JuicyPixels-extra
|
, JuicyPixels-extra
|
||||||
|
, bytestring
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
10
shell.nix
10
shell.nix
|
@ -24,16 +24,18 @@ let
|
||||||
license = stdenv.lib.licenses.lgpl3;
|
license = stdenv.lib.licenses.lgpl3;
|
||||||
}) {};
|
}) {};
|
||||||
|
|
||||||
f = { mkDerivation, aeson, base, containers, JuicyPixels, JuicyPixels-extra
|
f = { mkDerivation, aeson, base, bytestring, containers, JuicyPixels
|
||||||
, linear, OpenGL, stdenv , sdl2, stm, text, vector}:
|
, JuicyPixels-extra, linear, OpenGL, OpenGLRaw, stdenv , sdl2, stm, text
|
||||||
|
, vector}:
|
||||||
mkDerivation {
|
mkDerivation {
|
||||||
pname = "pituicat";
|
pname = "pituicat";
|
||||||
version = "0.0.0.0";
|
version = "0.0.0.0";
|
||||||
src = ./.;
|
src = ./.;
|
||||||
isLibrary = false;
|
isLibrary = false;
|
||||||
isExecutable = true;
|
isExecutable = true;
|
||||||
executableHaskellDepends = [ aeson affection base linear containers
|
executableHaskellDepends = [ aeson affection base bytestring linear
|
||||||
JuicyPixels JuicyPixels-extra OpenGL sdl2 stm text vector];
|
containers JuicyPixels JuicyPixels-extra OpenGL OpenGLRaw sdl2 stm text
|
||||||
|
vector];
|
||||||
license = stdenv.lib.licenses.gpl3;
|
license = stdenv.lib.licenses.gpl3;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
24
src/Main.hs
24
src/Main.hs
|
@ -15,13 +15,14 @@ import Linear
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
|
import StateMachine
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
instance Affectionate GameData where
|
instance Affectionate GameData where
|
||||||
preLoop _ = return ()
|
preLoop = smLoad Loading
|
||||||
handleEvents _ _ = return ()
|
handleEvents = handle
|
||||||
update _ _ = return ()
|
update = Main.update
|
||||||
draw _ = return ()
|
draw = Main.draw
|
||||||
loadState = Main.init
|
loadState = Main.init
|
||||||
cleanUp _ = return ()
|
cleanUp _ = return ()
|
||||||
hasNextStep = liftIO . atomically . readTVar . gameRunning
|
hasNextStep = liftIO . atomically . readTVar . gameRunning
|
||||||
|
@ -46,6 +47,21 @@ main = do
|
||||||
} :: AffectionConfig GameData
|
} :: AffectionConfig GameData
|
||||||
withAffection config
|
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 :: IO GameData
|
||||||
init = GameData
|
init = GameData
|
||||||
<$> newTVarIO Loading
|
<$> newTVarIO Loading
|
||||||
|
|
|
@ -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
|
|
@ -0,0 +1,10 @@
|
||||||
|
module State.Loading.Draw where
|
||||||
|
|
||||||
|
import Affection
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Types
|
||||||
|
|
||||||
|
initLoadDraw :: GameData -> Affection ()
|
||||||
|
initLoadDraw gd = return ()
|
|
@ -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)
|
|
@ -0,0 +1,10 @@
|
||||||
|
module State.Loading.Update where
|
||||||
|
|
||||||
|
import Affection
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Types
|
||||||
|
|
||||||
|
initLoadUpdate :: GameData -> Double -> Affection ()
|
||||||
|
initLoadUpdate gd dt = return ()
|
|
@ -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…
Reference in New Issue