diff options
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous/Game/Draw.hs')
-rw-r--r-- | users/glittershark/xanthous/src/Xanthous/Game/Draw.hs | 143 |
1 files changed, 0 insertions, 143 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/Game/Draw.hs b/users/glittershark/xanthous/src/Xanthous/Game/Draw.hs deleted file mode 100644 index 2375ae8c557e..000000000000 --- a/users/glittershark/xanthous/src/Xanthous/Game/Draw.hs +++ /dev/null @@ -1,143 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Game.Draw - ( drawGame - ) where --------------------------------------------------------------------------------- -import Xanthous.Prelude -import Brick hiding (loc, on) -import Brick.Widgets.Border -import Brick.Widgets.Border.Style -import Brick.Widgets.Edit --------------------------------------------------------------------------------- -import Xanthous.Data -import Xanthous.Data.App (ResourceName, Panel(..)) -import qualified Xanthous.Data.App as Resource -import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Game.State -import Xanthous.Entities.Character -import Xanthous.Entities.Item (Item) -import Xanthous.Game - ( characterPosition - , character - , revealedEntitiesAtPosition - ) -import Xanthous.Game.Prompt -import Xanthous.Orphans () --------------------------------------------------------------------------------- - -cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName -cursorPosition game - | WaitingPrompt _ (Prompt _ SPointOnMap (PointOnMapPromptState pos) _ _) - <- game ^. promptState - = showCursor Resource.Prompt (pos ^. loc) - | otherwise - = showCursor Resource.Character (game ^. characterPosition . loc) - -drawMessages :: MessageHistory -> Widget ResourceName -drawMessages = txtWrap . (<> " ") . unwords . reverse . oextract - -drawPromptState :: GamePromptState m -> Widget ResourceName -drawPromptState NoPrompt = emptyWidget -drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = - case (pt, ps, pri) of - (SStringPrompt, StringPromptState edit, _) -> - txtWrap msg <+> txt " " <+> renderEditor (txt . fold) True edit - (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg - (SContinue, _, _) -> txtWrap msg - (SMenu, _, menuItems) -> - txtWrap msg - <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) - _ -> txtWrap msg - where - drawMenuItem (chr, MenuOption m _) = - str ("[" <> pure chr <> "] ") <+> txtWrap m - -drawEntities - :: GameState - -> Widget ResourceName -drawEntities game = vBox rows - where - allEnts = game ^. entities - entityPositions = EntityMap.positions allEnts - 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 - = renderTopEntity pos $ revealedEntitiesAtPosition pos game - renderTopEntity pos ents - = let neighbors = EntityMap.neighbors pos allEnts - in maybe (str " ") (drawWithNeighbors neighbors) - $ maximumBy (compare `on` drawPriority) - <$> fromNullable ents - -drawMap :: GameState -> Widget ResourceName -drawMap game - = viewport Resource.MapViewport Both - . cursorPosition game - $ drawEntities game - -bullet :: Char -bullet = '•' - -drawInventoryPanel :: GameState -> Widget ResourceName -drawInventoryPanel game - = drawWielded (game ^. character . inventory . wielded) - <=> drawBackpack (game ^. character . inventory . backpack) - where - drawWielded (Hands Nothing Nothing) = emptyWidget - drawWielded (DoubleHanded i) = - txtWrap $ "You are holding " <> description i <> " in both hands" - drawWielded (Hands l r) = drawHand "left" l <=> drawHand "right" r - drawHand side = maybe emptyWidget $ \i -> - txtWrap ( "You are holding " - <> description i - <> " in your " <> side <> " hand" - ) - <=> txt " " - - drawBackpack :: Vector Item -> Widget ResourceName - drawBackpack Empty = txtWrap "Your backpack is empty right now." - drawBackpack backpackItems - = txtWrap ( "You are currently carrying the following items in your " - <> "backpack:") - <=> txt " " - <=> foldl' (<=>) emptyWidget - (map - (txtWrap . ((bullet <| " ") <>) . description) - backpackItems) - - -drawPanel :: GameState -> Panel -> Widget ResourceName -drawPanel game panel - = border - . hLimit 35 - . viewport (Resource.Panel panel) Vertical - . case panel of - InventoryPanel -> drawInventoryPanel - $ game - -drawCharacterInfo :: Character -> Widget ResourceName -drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints - where - charName | Just n <- ch ^. characterName - = txt $ n <> " " - | otherwise - = emptyWidget - charHitpoints - = txt "Hitpoints: " - <+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp) - -drawGame :: GameState -> [Widget ResourceName] -drawGame game - = pure - . withBorderStyle unicode - $ case game ^. promptState of - NoPrompt -> drawMessages (game ^. messageHistory) - _ -> emptyWidget - <=> drawPromptState (game ^. promptState) - <=> - (maybe emptyWidget (drawPanel game) (game ^. activePanel) - <+> border (drawMap game) - ) - <=> drawCharacterInfo (game ^. character) |