diff options
author | Griffin Smith <root@gws.fyi> | 2019-09-02T18·45-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-09-02T18·45-0400 |
commit | 73a52e531d940858f0ac334d8b2ccda479ea7b5e (patch) | |
tree | fc7a953ddcb69691e2f734fa69f4585aff553e17 /src | |
parent | 4d270712aecf1b61249086718852b96968de2bd8 (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.hs | 38 | ||||
-rw-r--r-- | src/Xanthous/Entities/Creature.hs | 32 | ||||
-rw-r--r-- | src/Xanthous/Entities/Raws/gormlak.yaml | 2 | ||||
-rw-r--r-- | src/Xanthous/Game/Draw.hs | 9 |
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 |