Add 'users/glittershark/xanthous/' from commit '53b56744f4'

git-subtree-dir: users/glittershark/xanthous
git-subtree-mainline: 91f53f02d8
git-subtree-split: 53b56744f4
This commit is contained in:
Vincent Ambo 2020-06-16 01:05:44 +01:00
commit 2edb963b97
96 changed files with 10030 additions and 0 deletions

View file

@ -0,0 +1,40 @@
--------------------------------------------------------------------------------
module Xanthous.App.Time
( stepGame
, stepGameBy
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
--------------------------------------------------------------------------------
import System.Exit
--------------------------------------------------------------------------------
import Xanthous.Data (Ticks)
import Xanthous.App.Prompt
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Entities.Character (isDead)
import Xanthous.Game.State
import Xanthous.Game.Prompt
import Xanthous.Game.Lenses
import Control.Monad.State (modify)
--------------------------------------------------------------------------------
stepGameBy :: Ticks -> AppM ()
stepGameBy ticks = do
ents <- uses entities EntityMap.toEIDsAndPositioned
for_ ents $ \(eid, pEntity) -> do
pEntity' <- step ticks pEntity
entities . ix eid .= pEntity'
modify updateCharacterVision
whenM (uses character isDead)
. prompt_ @'Continue ["dead"] Uncancellable
. const . lift . liftIO
$ exitSuccess
ticksPerTurn :: Ticks
ticksPerTurn = 100
stepGame :: AppM ()
stepGame = stepGameBy ticksPerTurn