From 62a2e05ef222dd69263b819a400a83f8910816f9 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Thu, 19 Sep 2019 13:56:14 -0400
Subject: Add items and inventory

Add a new "Item" entity, which pulls from the previously-existent
ItemType raw, and add a "PickUp" command which takes the (currently
*only*) item off the ground and puts it into the inventory.
---
 src/Xanthous/Game.hs | 30 +++++++++++++-----------------
 1 file changed, 13 insertions(+), 17 deletions(-)

(limited to 'src/Xanthous/Game.hs')

diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
index ed65217e627b..777e05ee4149 100644
--- a/src/Xanthous/Game.hs
+++ b/src/Xanthous/Game.hs
@@ -5,7 +5,7 @@
 module Xanthous.Game
   ( GameState(..)
   , entities
-  , revealedEntities
+  , revealedPositions
   , messageHistory
   , randomGen
 
@@ -35,7 +35,6 @@ import           Test.QuickCheck
 import           Test.QuickCheck.Arbitrary.Generic
 import           Control.Monad.State.Class
 --------------------------------------------------------------------------------
-import           Xanthous.Util (appendVia)
 import           Xanthous.Data.EntityMap (EntityMap, EntityID)
 import qualified Xanthous.Data.EntityMap as EntityMap
 import           Xanthous.Data.EntityMap.Graphics
@@ -43,6 +42,7 @@ import           Xanthous.Data (Positioned, Position(..), positioned, position)
 import           Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs)
 import           Xanthous.Entities.Character
 import           Xanthous.Entities.Creature
+import           Xanthous.Entities.Item
 import           Xanthous.Entities.Arbitrary ()
 import           Xanthous.Orphans ()
 --------------------------------------------------------------------------------
@@ -71,12 +71,11 @@ hideMessage NoMessageHistory = NoMessageHistory
 hideMessage (MessageHistory msgs _) = MessageHistory msgs False
 
 data GameState = GameState
-  { _entities          :: EntityMap SomeEntity
-    -- | A subset of the overall set of entities
-  , _revealedEntities  :: EntityMap SomeEntity
-  , _characterEntityID :: EntityID
-  , _messageHistory    :: MessageHistory
-  , _randomGen         :: StdGen
+  { _entities          :: !(EntityMap SomeEntity)
+  , _revealedPositions :: !(Set Position)
+  , _characterEntityID :: !EntityID
+  , _messageHistory    :: !MessageHistory
+  , _randomGen         :: !StdGen
   }
   deriving stock (Show)
 makeLenses ''GameState
@@ -84,7 +83,7 @@ makeLenses ''GameState
 instance Eq GameState where
   (==) = (==) `on` \gs ->
     ( gs ^. entities
-    , gs ^. revealedEntities
+    , gs ^. revealedPositions
     , gs ^. characterEntityID
     , gs ^. messageHistory
     )
@@ -96,11 +95,7 @@ instance Arbitrary GameState where
     _messageHistory <- arbitrary
     (_characterEntityID, _entities) <- arbitrary <&>
       EntityMap.insertAtReturningID charPos (SomeEntity char)
-    revealedPositions <- sublistOf $ EntityMap.positions _entities
-    let _revealedEntities = mempty &~ do
-          for_ revealedPositions $ \pos -> do
-            let ents = _entities ^. EntityMap.atPosition pos
-            EntityMap.atPosition pos <>= ents
+    _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities
     _randomGen <- mkStdGen <$> arbitrary
     pure $ GameState {..}
 
@@ -114,7 +109,7 @@ getInitialState = do
           (SomeEntity char)
           mempty
       _messageHistory = NoMessageHistory
-      _revealedEntities = _entities
+      _revealedPositions = mempty
   pure GameState {..}
 
 positionedCharacter :: Lens' GameState (Positioned Character)
@@ -151,8 +146,8 @@ visionRadius = 12 -- TODO make this dynamic
 updateCharacterVision :: GameState -> GameState
 updateCharacterVision game =
   let charPos = game ^. characterPosition
-      visible = visibleEntities charPos visionRadius $ game ^. entities
-  in game & revealedEntities %~ appendVia EntityMap.Deduplicate visible
+      visible = visiblePositions charPos visionRadius $ game ^. entities
+  in game & revealedPositions <>~ visible
 
 
 --------------------------------------------------------------------------------
@@ -169,4 +164,5 @@ collisionAt pos = do
   pure $
     if | null ents -> Nothing
        | any (entityIs @Creature) ents -> pure Combat
+       | all (entityIs @Item) ents -> Nothing
        | otherwise -> pure Stop
-- 
cgit 1.4.1