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:
parent
bf4d8ab603
commit
4b11859d04
11 changed files with 164 additions and 97 deletions
|
|
@ -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)
|
||||
]
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue