about summary refs log tree commit diff
path: root/src/Xanthous/App.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-09-21T16·43-0400
committerGriffin Smith <root@gws.fyi>2019-09-21T16·43-0400
commitd632a30d057f9a2775c4516570168b195c053879 (patch)
tree3bfebac7b14567edfb11d3917e9b2fd9114becb9 /src/Xanthous/App.hs
parentdd1616666593f65bab70f1363b5d040fe5edd054 (diff)
Implement combat
Put a bunch of gormlaks randomly on the level, and implement combat via
damaging those gormlaks by one point.
Diffstat (limited to 'src/Xanthous/App.hs')
-rw-r--r--src/Xanthous/App.hs40
1 files changed, 34 insertions, 6 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index fce2beed13..8353df437b 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -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,17 +66,24 @@ runAppM appm = fmap fst . runAppT appm
 
 startEvent :: AppM ()
 startEvent = do
+  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
-  modify updateCharacterVision
-  prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable
-    $ \(StringResult s) -> do
-      character . characterName ?= s
-      say ["welcome"] =<< use character
 
 handleEvent :: BrickEvent Name () -> AppM (Next GameState)
 handleEvent ev = use promptState >>= \case
@@ -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'