about summary refs log tree commit diff
path: root/src/Xanthous/Game.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-09-14T19·10-0400
committerGriffin Smith <root@gws.fyi>2019-09-14T19·10-0400
commit33c831d23d09d1e80a1dcfacb373dcedec55f694 (patch)
treef6ac83a343dafc40cfd09e417c9b2fce98eec3fe /src/Xanthous/Game.hs
parentc06edf3cc698f36e995719dc6e192c5663110f6d (diff)
Implement collision
Check if there's a wall or other entity where the character is going,
and stop the character from going there
Diffstat (limited to 'src/Xanthous/Game.hs')
-rw-r--r--src/Xanthous/Game.hs25
1 files changed, 24 insertions, 1 deletions
diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
index e967098015af..6a4689610689 100644
--- a/src/Xanthous/Game.hs
+++ b/src/Xanthous/Game.hs
@@ -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