From 73a52e531d940858f0ac334d8b2ccda479ea7b5e Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 2 Sep 2019 14:45:36 -0400 Subject: 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) --- src/Xanthous/App.hs | 38 ++++++++++++++++++++++----------- src/Xanthous/Entities/Creature.hs | 32 +++++++++++++++++++++++++++ src/Xanthous/Entities/Raws/gormlak.yaml | 2 +- src/Xanthous/Game/Draw.hs | 9 ++++---- xanthous.cabal | 4 +++- 5 files changed, 66 insertions(+), 19 deletions(-) create mode 100644 src/Xanthous/Entities/Creature.hs diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 3561d35a3b..6cf22135a7 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 0000000000..983772090e --- /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 fc3215f2f4..2441e7e782 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 6527af7439..36abe16119 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 diff --git a/xanthous.cabal b/xanthous.cabal index 390d0dbfc3..7f7d12932c 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 897c9cda436c62269dd43a0fc47226b24a310e52522fa6ebfe18cedc2394f6ea +-- hash: 1e2605418faf05255c5de59433688704543e21d7d3edf669e7e18a99977c0241 name: xanthous version: 0.1.0.0 @@ -36,6 +36,7 @@ library Xanthous.Data.EntityMap Xanthous.Entities Xanthous.Entities.Character + Xanthous.Entities.Creature Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Entities.SomeEntity @@ -95,6 +96,7 @@ executable xanthous Xanthous.Data.EntityMap Xanthous.Entities Xanthous.Entities.Character + Xanthous.Entities.Creature Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Entities.SomeEntity -- cgit 1.4.1