Browse Source

Draft more state implementation and make engine verbose

master
nek0 1 year ago
parent
commit
2e280d6e19
  1. 2
      cabal.project
  2. 4
      pituicat.cabal
  3. 1
      shell.nix
  4. 18
      src/Main.hs
  5. 9
      src/State/Loading/Load.hs
  6. 7
      src/State/MainGame.hs
  7. 10
      src/State/MainGame/Draw.hs
  8. 39
      src/State/MainGame/Load.hs
  9. 17
      src/State/MainGame/Update.hs
  10. 6
      src/StateMachine.hs
  11. 8
      src/Types/Application.hs

2
cabal.project

@ -1,3 +1,3 @@
packages:
./
./extern/*/
-- ./extern/*

4
pituicat.cabal

@ -28,6 +28,10 @@ executable pituicat
, State.Loading.Load
, State.Loading.Update
, State.Loading.Draw
, State.MainGame
, State.MainGame.Load
, State.MainGame.Update
, State.MainGame.Draw
, Map
, StateMachine
, Texture

1
shell.nix

@ -13,6 +13,7 @@ let
pname = "affection";
version = "0.0.0.10";
src = ./extern/affection;
configureFlags = [ "-fverbose" ];
isLibrary = true;
isExecutable = true;
libraryHaskellDepends = [

18
src/Main.hs

@ -19,7 +19,7 @@ import StateMachine
import Types
instance Affectionate GameData where
preLoop = smLoad Loading
preLoop = preLoad
handleEvents = handle
update = Main.update
draw = Main.draw
@ -47,6 +47,11 @@ main = do
} :: AffectionConfig GameData
withAffection config
preLoad :: GameData -> Affection ()
preLoad gd = do
liftIO $ atomically $ writeTVar (gameState gd) Loading
handle :: GameData -> [SDL.EventPayload] -> Affection ()
handle gd evs = do
state <- liftIO (atomically $ readTVar $ gameState gd)
@ -55,7 +60,13 @@ handle gd evs = do
update :: GameData -> Double -> Affection ()
update gd dt = do
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 gd = do
@ -65,7 +76,8 @@ draw gd = do
init :: IO GameData
init = GameData
<$> newTVarIO Loading
<*> newTVarIO EmptyData
<*> newTMVarIO (-1, "Ohai!")
<*> newTMVarIO EmptyData
<*> (Subsystems
<$> (SubWindow <$> newTVarIO [])
<*> (SubMouse <$> newTVarIO [])

9
src/State/Loading/Load.hs

@ -23,11 +23,8 @@ import Control.Concurrent.STM
import Types
import Map
initLoadLoad
initLoad
:: GameData
-> Affection ()
initLoadLoad gd = do
stateData <- liftIO (TestData <$> constructMap testLevelDesc 0)
liftIO $ atomically $ do
writeTVar (gameStateData gd) stateData
writeTVar (gameState gd) (MainGame Test)
initLoad gd =
liftIO $ atomically $ writeTVar (gameState gd) (MainGame Test)

7
src/State/MainGame.hs

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

10
src/State/MainGame/Draw.hs

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

39
src/State/MainGame/Load.hs

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

17
src/State/MainGame/Update.hs

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

6
src/StateMachine.hs

@ -11,16 +11,20 @@ import Control.Monad (void)
import Types
import State.Loading
import State.MainGame
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)
smUpdate Loading = initLoadUpdate
smUpdate (MainGame Test) = mainGameUpdate
smUpdate x = error ("State update not yet implemented: " <> show x)
smDraw Loading = initLoadDraw
smDraw (MainGame Test) = mainGameDraw
smDraw x = error ("State draw not yet implemented: " <> show x)
smEvent _ gd evs = do

8
src/Types/Application.hs

@ -8,6 +8,8 @@ import Control.Concurrent.STM
import qualified Data.Map.Strict as M
import qualified Data.Text as T
-- internal imports
import Types.Subsystems
@ -15,7 +17,8 @@ import Types.GameMap
data GameData = GameData
{ gameState :: TVar State
, gameStateData :: TVar StateData
, gameStateLoadProgress :: TMVar Progress
, gameStateData :: TMVar StateData
, gameSubsystems :: Subsystems
, gameActionTranslation :: TVar ActionTranslation
, gameRunning :: TVar Bool
@ -61,6 +64,8 @@ data Level
| Test
deriving (Enum, Eq, Show)
type Progress = (Float, T.Text)
type ActionTranslation = M.Map SDL.Keycode Action
data StateData
@ -68,3 +73,4 @@ data StateData
| TestData
{ testMap :: LevelMap
}
deriving (Eq, Show)

Loading…
Cancel
Save