feat(gs/xanthous): Allow generating creatures with items r/3097

Add an `equippedItems` field to the CreatureType raw, which provides a
chance for generating that creature with an item equipped, which goes
into a new `inventory` field on the creature entity itself. Currently
the creature doesn't actually *use* this equipped item, but it's a step.

This commit also adds a broken-dagger equipped 90% of the time to the
"husk" creature.

Change-Id: I6416c0678ba7bc1b002c5ce6119f7dc97dd86437

1 files changed, 49 insertions, 5 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs
index fcca118743e9..4f8a2f42ee16 100644
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs
+++ b/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 --------------------------------------------------------------------------------
 module Xanthous.Generators.Level.LevelContents
   ( chooseCharacterPosition
@@ -6,6 +7,7 @@ module Xanthous.Generators.Level.LevelContents
   , randomDoors
   , placeDownStaircase
   , tutorialMessage
+  , entityFromRaw
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude hiding (any, toList)
@@ -17,14 +19,15 @@ import           Data.Foldable (any, toList)
 import           Linear.V2
 --------------------------------------------------------------------------------
 import           Xanthous.Generators.Level.Util
-import           Xanthous.Random
+import           Xanthous.Random hiding (chance)
+import qualified Xanthous.Random as Random
 import           Xanthous.Data
                  ( positionFromV2,  Position, _Position
                  , rotations, arrayNeighbors, Neighbors(..)
                  , neighborPositions
                  )
 import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
-import           Xanthous.Entities.Raws (rawsWithType, RawType)
+import           Xanthous.Entities.Raws (rawsWithType, RawType, raw)
 import qualified Xanthous.Entities.Item as Item
 import           Xanthous.Entities.Item (Item)
 import qualified Xanthous.Entities.Creature as Creature
@@ -33,6 +36,10 @@ import           Xanthous.Entities.Environment
                  (GroundMessage(..), Door(..), unlockedDoor, Staircase(..))
 import           Xanthous.Messages (message_)
 import           Xanthous.Util.Graphics (circle)
+import           Xanthous.Entities.RawTypes
+import           Xanthous.Entities.Creature.Hippocampus (initialHippocampus)
+import           Xanthous.Entities.Common (inRightHand, asWieldedItem, wielded)
+import           Xanthous.Game.State (SomeEntity(SomeEntity))
 --------------------------------------------------------------------------------
 
 chooseCharacterPosition :: MonadRandom m => Cells -> m Position
@@ -82,7 +89,40 @@ randomCreatures
   -> Cells
   -> m (EntityMap Creature)
 randomCreatures levelNumber
-  = randomEntities (Creature.newOnLevelWithType levelNumber) (0.0007, 0.002)
+  = randomEntities maybeNewCreature (0.0007, 0.002)
+  where
+    maybeNewCreature cType
+      | maybe True (canGenerate levelNumber) $ cType ^. generateParams
+      = Just <$> newCreatureWithType cType
+      | otherwise
+      = pure Nothing
+
+newCreatureWithType :: MonadRandom m => CreatureType -> m Creature
+newCreatureWithType _creatureType = do
+  let _hitpoints = _creatureType ^. maxHitpoints
+      _hippocampus = initialHippocampus
+
+  equipped <- fmap join
+            . traverse genEquipped
+            $ _creatureType
+            ^.. generateParams . _Just . equippedItem . _Just
+  let _inventory = maybe id (\ei -> wielded .~ inRightHand ei) (headMay equipped) mempty
+  pure Creature.Creature {..}
+  where
+    genEquipped cei = do
+      doGen <- Random.chance $ cei ^. chance
+      let entName = cei ^. entityName
+          itemType =
+            fromMaybe (error $ "raw \"" <> unpack entName <> "\" not of type Item")
+            . preview _Item
+            . fromMaybe (error $ "Could not find raw: " <> unpack entName)
+            $ raw entName
+      item <- Item.newWithType itemType
+      if doGen
+        then pure [fromMaybe (error $ "raw \"" <> unpack entName <> "\" not wieldable")
+                  $ preview asWieldedItem item]
+        else pure []
+
 
 tutorialMessage :: MonadRandom m
   => Cells
@@ -118,8 +158,8 @@ randomEntities newWithType sizeRange cells =
         floor . (* fromIntegral len) <$> getRandomR sizeRange
       entities <- for [0..numEntities] $ const $ do
         pos <- randomPosition cells
-        raw <- choose raws
-        entities <- newWithType raw
+        r <- choose raws
+        entities <- newWithType r
         pure $ (pos, ) <$> entities
       pure $ _EntityMap # (entities >>= toList)
 
@@ -136,3 +176,7 @@ cellCandidates
   . regions
   -- cells ends up with true = wall, we want true = can put an item here
   . amap not
+
+entityFromRaw :: MonadRandom m => EntityRaw -> m SomeEntity
+entityFromRaw (Creature ct) = SomeEntity <$> newCreatureWithType ct
+entityFromRaw (Item it) = SomeEntity <$> Item.newWithType it