Draft more state implementation and make engine verbose
This commit is contained in:
parent
7c18915e9b
commit
2e280d6e19
|
@ -1,3 +1,3 @@
|
||||||
packages:
|
packages:
|
||||||
./
|
./
|
||||||
./extern/*/
|
-- ./extern/*
|
||||||
|
|
|
@ -28,6 +28,10 @@ executable pituicat
|
||||||
, State.Loading.Load
|
, State.Loading.Load
|
||||||
, State.Loading.Update
|
, State.Loading.Update
|
||||||
, State.Loading.Draw
|
, State.Loading.Draw
|
||||||
|
, State.MainGame
|
||||||
|
, State.MainGame.Load
|
||||||
|
, State.MainGame.Update
|
||||||
|
, State.MainGame.Draw
|
||||||
, Map
|
, Map
|
||||||
, StateMachine
|
, StateMachine
|
||||||
, Texture
|
, Texture
|
||||||
|
|
|
@ -13,6 +13,7 @@ let
|
||||||
pname = "affection";
|
pname = "affection";
|
||||||
version = "0.0.0.10";
|
version = "0.0.0.10";
|
||||||
src = ./extern/affection;
|
src = ./extern/affection;
|
||||||
|
configureFlags = [ "-fverbose" ];
|
||||||
isLibrary = true;
|
isLibrary = true;
|
||||||
isExecutable = true;
|
isExecutable = true;
|
||||||
libraryHaskellDepends = [
|
libraryHaskellDepends = [
|
||||||
|
|
18
src/Main.hs
18
src/Main.hs
|
@ -19,7 +19,7 @@ import StateMachine
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
instance Affectionate GameData where
|
instance Affectionate GameData where
|
||||||
preLoop = smLoad Loading
|
preLoop = preLoad
|
||||||
handleEvents = handle
|
handleEvents = handle
|
||||||
update = Main.update
|
update = Main.update
|
||||||
draw = Main.draw
|
draw = Main.draw
|
||||||
|
@ -47,6 +47,11 @@ main = do
|
||||||
} :: AffectionConfig GameData
|
} :: AffectionConfig GameData
|
||||||
withAffection config
|
withAffection config
|
||||||
|
|
||||||
|
preLoad :: GameData -> Affection ()
|
||||||
|
preLoad gd = do
|
||||||
|
liftIO $ atomically $ writeTVar (gameState gd) Loading
|
||||||
|
|
||||||
|
|
||||||
handle :: GameData -> [SDL.EventPayload] -> Affection ()
|
handle :: GameData -> [SDL.EventPayload] -> Affection ()
|
||||||
handle gd evs = do
|
handle gd evs = do
|
||||||
state <- liftIO (atomically $ readTVar $ gameState gd)
|
state <- liftIO (atomically $ readTVar $ gameState gd)
|
||||||
|
@ -55,7 +60,13 @@ handle gd evs = do
|
||||||
update :: GameData -> Double -> Affection ()
|
update :: GameData -> Double -> Affection ()
|
||||||
update gd dt = do
|
update gd dt = do
|
||||||
state <- liftIO (atomically $ readTVar $ gameState gd)
|
state <- liftIO (atomically $ readTVar $ gameState gd)
|
||||||
smUpdate state gd dt
|
progressMeter <- liftIO $ atomically (fst <$> readTMVar (gameStateLoadProgress gd))
|
||||||
|
if progressMeter < 0
|
||||||
|
then do
|
||||||
|
-- liftIO (atomically (putTMVar (gameStateLoadProgress gd) (0, "Ohai!")))
|
||||||
|
smLoad state gd
|
||||||
|
else
|
||||||
|
smUpdate state gd dt
|
||||||
|
|
||||||
draw :: GameData -> Affection ()
|
draw :: GameData -> Affection ()
|
||||||
draw gd = do
|
draw gd = do
|
||||||
|
@ -65,7 +76,8 @@ draw gd = do
|
||||||
init :: IO GameData
|
init :: IO GameData
|
||||||
init = GameData
|
init = GameData
|
||||||
<$> newTVarIO Loading
|
<$> newTVarIO Loading
|
||||||
<*> newTVarIO EmptyData
|
<*> newTMVarIO (-1, "Ohai!")
|
||||||
|
<*> newTMVarIO EmptyData
|
||||||
<*> (Subsystems
|
<*> (Subsystems
|
||||||
<$> (SubWindow <$> newTVarIO [])
|
<$> (SubWindow <$> newTVarIO [])
|
||||||
<*> (SubMouse <$> newTVarIO [])
|
<*> (SubMouse <$> newTVarIO [])
|
||||||
|
|
|
@ -23,11 +23,8 @@ import Control.Concurrent.STM
|
||||||
import Types
|
import Types
|
||||||
import Map
|
import Map
|
||||||
|
|
||||||
initLoadLoad
|
initLoad
|
||||||
:: GameData
|
:: GameData
|
||||||
-> Affection ()
|
-> Affection ()
|
||||||
initLoadLoad gd = do
|
initLoad gd =
|
||||||
stateData <- liftIO (TestData <$> constructMap testLevelDesc 0)
|
liftIO $ atomically $ writeTVar (gameState gd) (MainGame Test)
|
||||||
liftIO $ atomically $ do
|
|
||||||
writeTVar (gameStateData gd) stateData
|
|
||||||
writeTVar (gameState gd) (MainGame Test)
|
|
||||||
|
|
|
@ -0,0 +1,7 @@
|
||||||
|
module State.MainGame
|
||||||
|
( module L
|
||||||
|
) where
|
||||||
|
|
||||||
|
import State.MainGame.Load as L
|
||||||
|
import State.MainGame.Update as L
|
||||||
|
import State.MainGame.Draw as L
|
|
@ -0,0 +1,10 @@
|
||||||
|
module State.MainGame.Draw where
|
||||||
|
|
||||||
|
import Affection
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Types
|
||||||
|
|
||||||
|
mainGameDraw :: GameData -> Affection ()
|
||||||
|
mainGameDraw gd = return ()
|
|
@ -0,0 +1,39 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module State.MainGame.Load where
|
||||||
|
|
||||||
|
import Affection
|
||||||
|
|
||||||
|
import Control.Concurrent (forkIO)
|
||||||
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Types
|
||||||
|
import Map
|
||||||
|
|
||||||
|
mainGameLoad
|
||||||
|
:: GameData
|
||||||
|
-> Affection ()
|
||||||
|
mainGameLoad gd = do
|
||||||
|
liftIO $ atomically $ do
|
||||||
|
_ <- takeTMVar (gameStateLoadProgress gd)
|
||||||
|
putTMVar (gameStateLoadProgress gd) (0, "Ohai!")
|
||||||
|
liftIO $ logIO Verbose "Entering main Game"
|
||||||
|
liftIO $ void $ forkIO $ loadFork (gameStateData gd) (gameStateLoadProgress gd)
|
||||||
|
|
||||||
|
loadFork
|
||||||
|
:: TMVar StateData
|
||||||
|
-> TMVar Progress
|
||||||
|
-> IO ()
|
||||||
|
loadFork dataContainer progress = do
|
||||||
|
atomically $ do
|
||||||
|
_ <- takeTMVar progress
|
||||||
|
putTMVar progress (0, "Loading test level...")
|
||||||
|
testData <- TestData <$> constructMap testLevelDesc 0
|
||||||
|
atomically $ do
|
||||||
|
_ <- takeTMVar dataContainer
|
||||||
|
putTMVar dataContainer testData
|
||||||
|
_ <- takeTMVar progress
|
||||||
|
putTMVar progress (1, "Loaded test level!")
|
|
@ -0,0 +1,17 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module State.MainGame.Update where
|
||||||
|
|
||||||
|
import Affection
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
|
|
||||||
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Types
|
||||||
|
|
||||||
|
mainGameUpdate :: GameData -> Double -> Affection ()
|
||||||
|
mainGameUpdate gd dt = do
|
||||||
|
progress <- liftIO $ atomically $ readTMVar (gameStateLoadProgress gd)
|
||||||
|
when (fst progress < 1) $ liftIO $ logIO Verbose (snd progress)
|
|
@ -11,16 +11,20 @@ import Control.Monad (void)
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
import State.Loading
|
import State.Loading
|
||||||
|
import State.MainGame
|
||||||
|
|
||||||
instance StateMachine GameData State where
|
instance StateMachine GameData State where
|
||||||
|
|
||||||
smLoad Loading = initLoadLoad
|
smLoad Loading = initLoad
|
||||||
|
smLoad (MainGame Test) = mainGameLoad
|
||||||
smLoad x = error ("State load not yet implemented: " <> show x)
|
smLoad x = error ("State load not yet implemented: " <> show x)
|
||||||
|
|
||||||
smUpdate Loading = initLoadUpdate
|
smUpdate Loading = initLoadUpdate
|
||||||
|
smUpdate (MainGame Test) = mainGameUpdate
|
||||||
smUpdate x = error ("State update not yet implemented: " <> show x)
|
smUpdate x = error ("State update not yet implemented: " <> show x)
|
||||||
|
|
||||||
smDraw Loading = initLoadDraw
|
smDraw Loading = initLoadDraw
|
||||||
|
smDraw (MainGame Test) = mainGameDraw
|
||||||
smDraw x = error ("State draw not yet implemented: " <> show x)
|
smDraw x = error ("State draw not yet implemented: " <> show x)
|
||||||
|
|
||||||
smEvent _ gd evs = do
|
smEvent _ gd evs = do
|
||||||
|
|
|
@ -8,6 +8,8 @@ import Control.Concurrent.STM
|
||||||
|
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Types.Subsystems
|
import Types.Subsystems
|
||||||
|
@ -15,7 +17,8 @@ import Types.GameMap
|
||||||
|
|
||||||
data GameData = GameData
|
data GameData = GameData
|
||||||
{ gameState :: TVar State
|
{ gameState :: TVar State
|
||||||
, gameStateData :: TVar StateData
|
, gameStateLoadProgress :: TMVar Progress
|
||||||
|
, gameStateData :: TMVar StateData
|
||||||
, gameSubsystems :: Subsystems
|
, gameSubsystems :: Subsystems
|
||||||
, gameActionTranslation :: TVar ActionTranslation
|
, gameActionTranslation :: TVar ActionTranslation
|
||||||
, gameRunning :: TVar Bool
|
, gameRunning :: TVar Bool
|
||||||
|
@ -61,6 +64,8 @@ data Level
|
||||||
| Test
|
| Test
|
||||||
deriving (Enum, Eq, Show)
|
deriving (Enum, Eq, Show)
|
||||||
|
|
||||||
|
type Progress = (Float, T.Text)
|
||||||
|
|
||||||
type ActionTranslation = M.Map SDL.Keycode Action
|
type ActionTranslation = M.Map SDL.Keycode Action
|
||||||
|
|
||||||
data StateData
|
data StateData
|
||||||
|
@ -68,3 +73,4 @@ data StateData
|
||||||
| TestData
|
| TestData
|
||||||
{ testMap :: LevelMap
|
{ testMap :: LevelMap
|
||||||
}
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
Loading…
Reference in New Issue