Implement collision

Check if there's a wall or other entity where the character is going,
and stop the character from going there
This commit is contained in:
Griffin Smith 2019-09-14 15:10:51 -04:00
parent c06edf3cc6
commit 33c831d23d
2 changed files with 29 additions and 3 deletions

View file

@ -16,7 +16,6 @@ import Xanthous.Data
, Dimensions , Dimensions
, positionFromPair , positionFromPair
) )
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data.EntityMap (EntityMap) import Xanthous.Data.EntityMap (EntityMap)
import Xanthous.Game import Xanthous.Game
import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Draw (drawGame)
@ -74,7 +73,11 @@ handleEvent _ = continue
handleCommand :: Command -> AppM (Next GameState) handleCommand :: Command -> AppM (Next GameState)
handleCommand Quit = halt handleCommand Quit = halt
handleCommand (Move dir) = do handleCommand (Move dir) = do
characterPosition %= move dir newPos <- uses characterPosition $ move dir
collisionAt newPos >>= \case
Nothing -> characterPosition .= newPos
Just Combat -> undefined
Just Stop -> pure ()
continue continue
handleCommand PreviousMessage = do handleCommand PreviousMessage = do

View file

@ -1,3 +1,4 @@
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -17,6 +18,10 @@ module Xanthous.Game
, pushMessage , pushMessage
, popMessage , popMessage
, hideMessage , hideMessage
-- * collisions
, Collision(..)
, collisionAt
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Prelude import Xanthous.Prelude
@ -26,12 +31,14 @@ import qualified Data.List.NonEmpty as NonEmpty
import System.Random import System.Random
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic import Test.QuickCheck.Arbitrary.Generic
import Control.Monad.State.Class
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityMap (EntityMap, EntityID)
import qualified Xanthous.Data.EntityMap as EntityMap import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data (Positioned, Position(..), positioned, position) import Xanthous.Data (Positioned, Position(..), positioned, position)
import Xanthous.Entities (SomeEntity(..), downcastEntity) import Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs)
import Xanthous.Entities.Character import Xanthous.Entities.Character
import Xanthous.Entities.Creature
import Xanthous.Entities.Arbitrary () import Xanthous.Entities.Arbitrary ()
import Xanthous.Orphans () import Xanthous.Orphans ()
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -122,3 +129,19 @@ character = positionedCharacter . positioned
characterPosition :: Lens' GameState Position characterPosition :: Lens' GameState Position
characterPosition = positionedCharacter . position characterPosition = positionedCharacter . position
--------------------------------------------------------------------------------
data Collision
= Stop
| Combat
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData)
collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
collisionAt pos = do
ents <- use $ entities . EntityMap.atPosition pos
pure $
if | null ents -> Nothing
| any (entityIs @Creature) ents -> pure Combat
| otherwise -> pure Stop