about summary refs log tree commit diff
path: root/src
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-09-02T18·45-0400
committerGriffin Smith <root@gws.fyi>2019-09-02T18·45-0400
commit73a52e531d940858f0ac334d8b2ccda479ea7b5e (patch)
treefc7a953ddcb69691e2f734fa69f4585aff553e17 /src
parent4d270712aecf1b61249086718852b96968de2bd8 (diff)
Put a test gormlak on the screen
Implement a concrete "Creature" entity, and place one on the screen at
the game startup for testing.

This revealed a bug with drawing when getting the maximum entity
position, but that appears to be fixed now (yay)
Diffstat (limited to 'src')
-rw-r--r--src/Xanthous/App.hs38
-rw-r--r--src/Xanthous/Entities/Creature.hs32
-rw-r--r--src/Xanthous/Entities/Raws/gormlak.yaml2
-rw-r--r--src/Xanthous/Game/Draw.hs9
4 files changed, 63 insertions, 18 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 3561d35a3bb2..6cf22135a7a4 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -1,18 +1,25 @@
 module Xanthous.App (makeApp) where
 
-import Xanthous.Prelude
-import Brick hiding (App, halt, continue)
+import           Xanthous.Prelude
+import           Brick hiding (App, halt, continue, raw)
 import qualified Brick
-import Graphics.Vty.Attributes (defAttr)
-import Graphics.Vty.Input.Events (Event(EvKey))
-import Control.Monad.State (get)
+import           Graphics.Vty.Attributes (defAttr)
+import           Graphics.Vty.Input.Events (Event(EvKey))
+import           Control.Monad.State (get)
 
-import Xanthous.Game
-import Xanthous.Game.Draw (drawGame)
-import Xanthous.Resource (Name)
-import Xanthous.Command
-import Xanthous.Data (move)
-import Xanthous.Monad
+import           Xanthous.Command
+import           Xanthous.Data (move, Position(..))
+import qualified Xanthous.Data.EntityMap as EntityMap
+import           Xanthous.Game
+import           Xanthous.Game.Draw (drawGame)
+import           Xanthous.Monad
+import           Xanthous.Resource (Name)
+
+import           Xanthous.Entities.Creature (Creature)
+import qualified Xanthous.Entities.Creature as Creature
+import           Xanthous.Entities.RawTypes (EntityRaw(..))
+import           Xanthous.Entities.Raws (raw)
+import           Xanthous.Entities.SomeEntity
 
 type App = Brick.App GameState () Name
 type AppM a = AppT (EventM Name) a
@@ -29,8 +36,15 @@ makeApp = pure $ Brick.App
 runAppM :: AppM a -> GameState -> EventM Name a
 runAppM appm = fmap fst . runAppT appm
 
+testGormlak :: Creature
+testGormlak =
+  let Just (Creature gormlak) = raw "gormlak"
+  in Creature.newWithType gormlak
+
 startEvent :: AppM ()
-startEvent = say ["welcome"]
+startEvent = do
+  () <- say ["welcome"]
+  entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak)
 
 handleEvent :: BrickEvent Name () -> AppM (Next GameState)
 handleEvent (VtyEvent (EvKey k mods))
diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs
new file mode 100644
index 000000000000..983772090ee2
--- /dev/null
+++ b/src/Xanthous/Entities/Creature.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+-- |
+
+module Xanthous.Entities.Creature where
+
+import Data.Word
+
+import Xanthous.Prelude
+import Xanthous.Entities.RawTypes hiding (Creature)
+import Xanthous.Entities (Draw(..))
+
+data Creature = Creature
+  { _creatureType :: CreatureType
+  , _hitpoints :: Word16
+  }
+  deriving stock (Eq, Show, Generic)
+makeLenses ''Creature
+
+instance Draw Creature where
+  draw = draw .view (creatureType . char)
+
+newWithType :: CreatureType -> Creature
+newWithType _creatureType =
+  let _hitpoints = _creatureType ^. maxHitpoints
+  in Creature {..}
+
+damage :: Word16 -> Creature -> Creature
+damage amount = hitpoints %~ \hp ->
+  if hp <= amount
+  then 0
+  else hp - amount
diff --git a/src/Xanthous/Entities/Raws/gormlak.yaml b/src/Xanthous/Entities/Raws/gormlak.yaml
index fc3215f2f451..2441e7e7822e 100644
--- a/src/Xanthous/Entities/Raws/gormlak.yaml
+++ b/src/Xanthous/Entities/Raws/gormlak.yaml
@@ -6,7 +6,7 @@ Creature:
   char:
     char: g
     style:
-      color: red
+      foreground: red
   maxHitpoints: 5
   speed: 120
   friendly: false
diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
index 6527af743953..36abe161198e 100644
--- a/src/Xanthous/Game/Draw.hs
+++ b/src/Xanthous/Game/Draw.hs
@@ -35,16 +35,15 @@ drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage
 --   (MessageHistory (lastMessage :| _) True) -> txt lastMessage
 
 drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name
-drawEntities em@(fromNullable . positions -> Just entityPositions)
+drawEntities em
   = vBox rows
   where
-    maxPosition = maximum entityPositions
-    maxY = maxPosition ^. y
-    maxX = maxPosition ^. x
+    entityPositions = positions em
+    maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions
+    maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions
     rows = mkRow <$> [0..maxY]
     mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX]
     renderEntityAt pos = maybe (str " ") draw $ em ^? atPosition pos . folded
-drawEntities _ = emptyWidget
 
 drawMap :: GameState -> Widget Name
 drawMap game