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:
parent
c06edf3cc6
commit
33c831d23d
2 changed files with 29 additions and 3 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue