Implement combat

Put a bunch of gormlaks randomly on the level, and implement combat via
damaging those gormlaks by one point.
This commit is contained in:
Griffin Smith 2019-09-21 12:43:54 -04:00
parent dd16166665
commit d632a30d05
7 changed files with 96 additions and 35 deletions

View file

@ -36,6 +36,8 @@ import qualified Xanthous.Entities.Character as Character
import Xanthous.Entities.Character (characterName)
import Xanthous.Entities
import Xanthous.Entities.Item (Item)
import Xanthous.Entities.Creature (Creature)
import qualified Xanthous.Entities.Creature as Creature
import Xanthous.Entities.Environment (Door, open, locked)
import Xanthous.Entities.Character
import Xanthous.Generators
@ -64,18 +66,25 @@ runAppM appm = fmap fst . runAppT appm
startEvent :: AppM ()
startEvent = do
level <-
generateLevel SCaveAutomata CaveAutomata.defaultParams
$ Dimensions 80 80
entities <>= (SomeEntity <$> level ^. levelWalls)
entities <>= (SomeEntity <$> level ^. levelItems)
characterPosition .= level ^. levelCharacterPosition
initLevel
modify updateCharacterVision
prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable
$ \(StringResult s) -> do
character . characterName ?= s
say ["welcome"] =<< use character
initLevel :: AppM ()
initLevel = do
level <-
generateLevel SCaveAutomata CaveAutomata.defaultParams
$ Dimensions 80 80
entities <>= (SomeEntity <$> level ^. levelWalls)
entities <>= (SomeEntity <$> level ^. levelItems)
entities <>= (SomeEntity <$> level ^. levelCreatures)
characterPosition .= level ^. levelCharacterPosition
handleEvent :: BrickEvent Name () -> AppM (Next GameState)
handleEvent ev = use promptState >>= \case
NoPrompt -> handleNoPromptEvent ev
@ -98,7 +107,7 @@ handleCommand (Move dir) = do
characterPosition .= newPos
describeEntitiesAt newPos
modify updateCharacterVision
Just Combat -> undefined
Just Combat -> attackAt newPos
Just Stop -> pure ()
continue
@ -214,3 +223,22 @@ describeEntitiesAt pos =
let descriptions = description <$> ents
in say ["entities", "description"] $ object
["entityDescriptions" A..= toSentence descriptions]
attackAt :: Position -> AppM ()
attackAt pos =
uses entities (entitiesAtPositionWithType @Creature pos) >>= \case
Empty -> say_ ["combat", "nothingToAttack"]
(creature :< Empty) -> attackCreature creature
creatures -> undefined
where
attackCreature (creatureID, creature) = do
charDamage <- use $ character . characterDamage
let creature' = Creature.damage charDamage creature
msgParams = object ["creature" A..= creature']
if Creature.isDead creature'
then do
say ["combat", "killed"] msgParams
entities . at creatureID .= Nothing
else do
say ["combat", "hit"] msgParams
entities . ix creatureID . positioned .= SomeEntity creature'

View file

@ -3,6 +3,7 @@ module Xanthous.Entities.Character
( Character(..)
, characterName
, inventory
, characterDamage
, mkCharacter
, pickUpItem
) where
@ -22,6 +23,7 @@ import Xanthous.Entities.Item
data Character = Character
{ _inventory :: !(Vector Item)
, _characterName :: !(Maybe Text)
, _characterDamage :: !Word
}
deriving stock (Show, Eq, Generic)
deriving anyclass (CoArbitrary, Function)
@ -50,6 +52,7 @@ mkCharacter :: Character
mkCharacter = Character
{ _inventory = mempty
, _characterName = Nothing
, _characterDamage = 1
}
pickUpItem :: Item -> Character -> Character

View file

@ -7,12 +7,14 @@ module Xanthous.Entities.Creature
, hitpoints
, newWithType
, damage
, isDead
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
--------------------------------------------------------------------------------
import Data.Word
import Test.QuickCheck.Arbitrary.Generic
import Data.Aeson.Generic.DerivingVia
import Data.Aeson (ToJSON, FromJSON)
--------------------------------------------------------------------------------
import Xanthous.Entities.RawTypes hiding (Creature, description)
import qualified Xanthous.Entities.RawTypes as Raw
@ -21,10 +23,13 @@ import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..))
data Creature = Creature
{ _creatureType :: CreatureType
, _hitpoints :: Word16
, _hitpoints :: Word
}
deriving stock (Eq, Show, Generic)
deriving Draw via DrawRawChar "_creatureType" Creature
deriving (ToJSON, FromJSON)
via WithOptions '[ FieldLabelModifier '[Drop 1] ]
Creature
makeLenses ''Creature
instance Arbitrary Creature where
@ -39,8 +44,11 @@ newWithType _creatureType =
let _hitpoints = _creatureType ^. maxHitpoints
in Creature {..}
damage :: Word16 -> Creature -> Creature
damage :: Word -> Creature -> Creature
damage amount = hitpoints %~ \hp ->
if hp <= amount
then 0
else hp - amount
isDead :: Creature -> Bool
isDead = views hitpoints (== 0)

View file

@ -19,7 +19,6 @@ import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic
import Data.Aeson.Generic.DerivingVia
import Data.Aeson (ToJSON, FromJSON)
import Data.Word
--------------------------------------------------------------------------------
import Xanthous.Entities (EntityChar, HasChar(..))
--------------------------------------------------------------------------------
@ -27,12 +26,12 @@ data CreatureType = CreatureType
{ _name :: Text
, _description :: Text
, _char :: EntityChar
, _maxHitpoints :: Word16
, _maxHitpoints :: Word
, _friendly :: Bool
}
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData)
deriving (FromJSON)
deriving (ToJSON, FromJSON)
via WithOptions '[ FieldLabelModifier '[Drop 1] ]
CreatureType
makeFieldsNoPrefix ''CreatureType

View file

@ -12,6 +12,7 @@ module Xanthous.Generators
, Level(..)
, levelWalls
, levelItems
, levelCreatures
, levelCharacterPosition
, generateLevel
) where
@ -29,7 +30,8 @@ import Xanthous.Data (Dimensions, Position(Position))
import Xanthous.Data.EntityMap (EntityMap)
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Entities.Environment
import Xanthous.Entities.Item
import Xanthous.Entities.Item (Item)
import Xanthous.Entities.Creature (Creature)
--------------------------------------------------------------------------------
data Generator = CaveAutomata
@ -38,9 +40,6 @@ data Generator = CaveAutomata
data SGenerator (gen :: Generator) where
SCaveAutomata :: SGenerator 'CaveAutomata
data AGenerator where
AGenerator :: forall gen. SGenerator gen -> AGenerator
type family Params (gen :: Generator) :: Type where
Params 'CaveAutomata = CaveAutomata.Params
@ -89,9 +88,10 @@ cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells
--------------------------------------------------------------------------------
data Level = Level
{ _levelWalls :: EntityMap Wall
, _levelItems :: EntityMap Item
, _levelCharacterPosition :: Position
{ _levelWalls :: !(EntityMap Wall)
, _levelItems :: !(EntityMap Item)
, _levelCreatures :: !(EntityMap Creature)
, _levelCharacterPosition :: !Position
}
makeLenses ''Level
@ -101,5 +101,6 @@ generateLevel gen ps dims = do
let cells = generate gen ps dims rand
_levelWalls = cellsToWalls cells
_levelItems <- randomItems cells
_levelCreatures <- randomCreatures cells
_levelCharacterPosition <- chooseCharacterPosition cells
pure Level {..}

View file

@ -2,6 +2,7 @@
module Xanthous.Generators.LevelContents
( chooseCharacterPosition
, randomItems
, randomCreatures
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
@ -13,28 +14,40 @@ import Xanthous.Generators.Util
import Xanthous.Random
import Xanthous.Data (Position, positionFromPair)
import Xanthous.Data.EntityMap (EntityMap, _EntityMap)
import Xanthous.Entities.Item (Item(..))
import Xanthous.Entities.Raws
import Xanthous.Entities.RawTypes
import Xanthous.Entities.Raws (rawsWithType, RawType)
import qualified Xanthous.Entities.Item as Item
import Xanthous.Entities.Item (Item)
import qualified Xanthous.Entities.Creature as Creature
import Xanthous.Entities.Creature (Creature)
--------------------------------------------------------------------------------
chooseCharacterPosition :: MonadRandom m => Cells -> m Position
chooseCharacterPosition = randomPosition
randomItems :: MonadRandom m => Cells -> m (EntityMap Item)
randomItems cells = do
let len = rangeSize $ bounds cells
(numItems :: Int) <- floor . (* fromIntegral len)
<$> getRandomR @_ @Float (0.0004, 0.001)
items <- for [0..numItems] $ const $ do
pos <- randomPosition cells
itemType <- fmap (fromMaybe (error "no item raws!"))
. choose . ChooseElement
$ rawsWithType @ItemType
let item = Item.newWithType itemType
pure (pos, item)
pure $ _EntityMap # items
randomItems = randomEntities Item.newWithType (0.0004, 0.001)
randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature)
randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003)
randomEntities
:: forall entity raw m. (MonadRandom m, RawType raw)
=> (raw -> entity)
-> (Float, Float)
-> Cells
-> m (EntityMap entity)
randomEntities newWithType sizeRange cells =
case fromNullable $ rawsWithType @raw of
Nothing -> pure mempty
Just raws -> do
let len = rangeSize $ bounds cells
(numEntities :: Int) <- floor . (* fromIntegral len) <$> getRandomR sizeRange
entities <- for [0..numEntities] $ const $ do
pos <- randomPosition cells
raw <- choose raws
let entity = newWithType raw
pure (pos, entity)
pure $ _EntityMap # entities
randomPosition :: MonadRandom m => Cells -> m Position
randomPosition cells = fmap positionFromPair . choose $ impureNonNull candidates

View file

@ -15,3 +15,12 @@ open:
character:
namePrompt: "What's your name? "
combat:
nothingToAttack: There's nothing to attack there
hit:
- You hit the {{creature.creatureType.name}}
- You attack the {{creature.creatureType.name}}
killed:
- You kill the {{creature.creatureType.name}}!
- You've killed the {{creature.creatureType.name}}!