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
, positionFromPair
)
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data.EntityMap (EntityMap)
import Xanthous.Game
import Xanthous.Game.Draw (drawGame)
@ -74,7 +73,11 @@ handleEvent _ = continue
handleCommand :: Command -> AppM (Next GameState)
handleCommand Quit = halt
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
handleCommand PreviousMessage = do

View file

@ -1,3 +1,4 @@
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}
--------------------------------------------------------------------------------
@ -17,6 +18,10 @@ module Xanthous.Game
, pushMessage
, popMessage
, hideMessage
-- * collisions
, Collision(..)
, collisionAt
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
@ -26,12 +31,14 @@ import qualified Data.List.NonEmpty as NonEmpty
import System.Random
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic
import Control.Monad.State.Class
--------------------------------------------------------------------------------
import Xanthous.Data.EntityMap (EntityMap, EntityID)
import qualified Xanthous.Data.EntityMap as EntityMap
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.Creature
import Xanthous.Entities.Arbitrary ()
import Xanthous.Orphans ()
--------------------------------------------------------------------------------
@ -122,3 +129,19 @@ character = positionedCharacter . positioned
characterPosition :: Lens' GameState 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