module Helm
(
Cmd(..)
, Engine
, GameConfig(..)
, Graphics(..)
, Image
, Sub(..)
, run
) where
import Control.Exception (finally)
import Control.Monad (foldM, void)
import Control.Monad.Trans.State.Lazy (evalStateT)
import FRP.Elerea.Param (start, embed)
import Helm.Asset (Image)
import Helm.Engine (Cmd(..), Sub(..), GameConfig(..), Engine(..))
import Helm.Graphics
data Game e m a = Game
{ gameConfig :: GameConfig e m a
, gameModel :: m
, actionSmp :: e -> IO [a]
}
prepare :: Engine e => e -> GameConfig e m a -> IO (Game e m a)
prepare engine config = do
smp <- start $ embed (return engine) gen
return Game
{ gameConfig = config
, gameModel = fst initialFn
, actionSmp = smp
}
where
GameConfig { initialFn, subscriptionsFn = Sub gen } = config
run :: Engine e => e -> GameConfig e m a -> IO ()
run engine config@GameConfig { initialFn } =
void $ (prepare engine config >>= stepInitial >>= step engine) `finally` cleanup engine
where
Cmd monad = snd initialFn
stepInitial game@Game { gameModel } = do
actions <- evalStateT monad engine
model <- foldM (stepModel engine game) gameModel actions
return game { gameModel = model }
step :: Engine e => e -> Game e m a -> IO ()
step engine game = do
mayhaps <- tick engine
case mayhaps of
Nothing -> return ()
Just sunkEngine -> do
actions <- actionSmp sunkEngine
model <- foldM (stepModel sunkEngine game) gameModel actions
render sunkEngine $ viewFn model
step sunkEngine $ game { gameModel = model }
where
Game { actionSmp, gameModel, gameConfig = GameConfig { viewFn } } = game
stepModel :: Engine e => e -> Game e m a -> m -> a -> IO m
stepModel engine game model action =
evalStateT monad engine >>= foldM (stepModel engine game) upModel
where
Game { gameConfig = GameConfig { updateFn } } = game
(upModel, Cmd monad) = updateFn model action