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

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
This commit is contained in:
Griffin Smith 2021-11-24 17:10:47 -05:00 committed by grfn
parent bf4d8ab603
commit 4b11859d04
11 changed files with 164 additions and 97 deletions

View file

@ -1,8 +1,11 @@
{-# LANGUAGE RecordWildCards #-}
--------------------------------------------------------------------------------
module Xanthous.Entities.RawTypesSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude
--------------------------------------------------------------------------------
import Data.Interval (Extended(..), (<=..<=))
--------------------------------------------------------------------------------
import Xanthous.Entities.RawTypes
--------------------------------------------------------------------------------
@ -12,17 +15,31 @@ main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Entities.RawTypesSpec"
[ testGroup "CreatureGenerateParams"
[ testBatch $ monoid @CreatureGenerateParams mempty
, testGroup "canGenerate"
[ testProperty "no bounds" $ \level ->
let gps = CreatureGenerateParams Nothing Nothing
in canGenerate level gps
, testProperty "min bound" $ \level minB ->
let gps = CreatureGenerateParams (Just minB) Nothing
in canGenerate level gps === (level >= minB)
, testProperty "max bound" $ \level maxB ->
let gps = CreatureGenerateParams Nothing (Just maxB)
in canGenerate level gps === (level <= maxB)
[ testGroup "Ord laws"
[ testProperty "comparability" $ \(a :: CreatureGenerateParams) b ->
a <= b || b <= a
, testProperty "transitivity" $ \(a :: CreatureGenerateParams) b c ->
a <= b && b <= c ==> a <= c
, testProperty "reflexivity" $ \(a :: CreatureGenerateParams) ->
a <= a
, testProperty "antisymmetry" $ \(a :: CreatureGenerateParams) b ->
(a <= b && b <= a) == (a == b)
]
, testGroup "canGenerate" $
let makeParams minB maxB =
let _levelRange = maybe NegInf Finite minB <=..<= maybe PosInf Finite maxB
_equippedItem = Nothing
in CreatureGenerateParams {..}
in
[ testProperty "no bounds" $ \level ->
let gps = makeParams Nothing Nothing
in canGenerate level gps
, testProperty "min bound" $ \level minB ->
let gps = makeParams (Just minB) Nothing
in canGenerate level gps === (level >= minB)
, testProperty "max bound" $ \level maxB ->
let gps = makeParams Nothing (Just maxB)
in canGenerate level gps === (level <= maxB)
]
]
]

View file

@ -4,6 +4,8 @@ module Xanthous.Entities.RawsSpec (main, test) where
import Test.Prelude
import Xanthous.Entities.Raws
import Xanthous.Entities.RawTypes
(_Creature, entityName, generateParams, HasEquippedItem (equippedItem))
main :: IO ()
main = defaultMain test
@ -12,5 +14,17 @@ test :: TestTree
test = testGroup "Xanthous.Entities.Raws"
[ testGroup "raws"
[ testCase "are all valid" $ raws `deepseq` pure ()
, testCase "all CreatureEquippedItems reference existent entity names" $
let notFound
= raws
^.. folded
. _Creature
. generateParams
. _Just
. equippedItem
. _Just
. entityName
. filtered (isNothing . raw)
in null notFound @? ("Some entities weren't found: " <> show notFound)
]
]

View file

@ -4,9 +4,10 @@ module Xanthous.Game.StateSpec (main, test) where
import Test.Prelude
--------------------------------------------------------------------------------
import Xanthous.Game.State
import Xanthous.Entities.Raws (raws, entityFromRaw)
import Control.Monad.Random (evalRandT)
import System.Random (getStdGen)
import Xanthous.Entities.Raws (raws)
import Xanthous.Generators.Level.LevelContents (entityFromRaw)
import Control.Monad.Random (evalRandT)
import System.Random (getStdGen)
--------------------------------------------------------------------------------
main :: IO ()