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:
parent
dd16166665
commit
d632a30d05
7 changed files with 96 additions and 35 deletions
|
@ -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'
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 {..}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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}}!
|
||||
|
|
Loading…
Reference in a new issue