Implement collision

Check if there's a wall or other entity where the character is going,
and stop the character from going there

2 files changed, 29 insertions, 3 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 0dc24b9d4165..82c32f05a3fc 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -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
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