about summary refs log blame commit diff
path: root/src/Xanthous/Game/Draw.hs
blob: bb6508acdff74a6ddb970ebea11e70402b3e434a (plain) (tree)
1
2
3
4
5
6
7
8
9
10

                             




                         
                         

                                 
                                         
 
                                                    

                                                      
                        


                    
                    



                      
                                   
                          
 


                                                   






                                                                             
 




                                               

             
                                            

                                                               

                                                                         
                        
                                                     

                                                      
 
                                   
            
                             
                                                          


                              

                                      


                           
                                           
                           
{-# LANGUAGE ViewPatterns #-}

module Xanthous.Game.Draw
  ( drawGame
  ) where

import Xanthous.Prelude
import Brick hiding (loc)
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Data.List.NonEmpty(NonEmpty((:|)))

import Xanthous.Data (Position(Position), x, y, loc)
import Xanthous.Data.EntityMap (EntityMap, atPosition)
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Entities
import Xanthous.Game
  ( GameState(..)
  , entities
  , revealedEntities
  , characterPosition
  , MessageHistory(..)
  , messageHistory
  )
import Xanthous.Resource (Name(..))
import Xanthous.Orphans ()

drawMessages :: MessageHistory -> Widget Name
drawMessages NoMessageHistory = emptyWidget
drawMessages (MessageHistory _ False) = emptyWidget
drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage

-- an attempt to still take up a row even when no messages
-- drawMessages msgs = vLimit 1 . Widget Greedy Fixed . render $ case msgs of
--   NoMessageHistory -> padTop (Pad 2) $ str " "
--   (MessageHistory _ False) -> padTop (Pad 2) $ str " "
--   (MessageHistory (lastMessage :| _) True) -> txt lastMessage

drawEntities
  :: EntityMap SomeEntity -- ^ visible entities
  -> EntityMap SomeEntity -- ^ all entities
  -> Widget Name
drawEntities em allEnts
  = vBox rows
  where
    entityPositions = EntityMap.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 =
      let neighbors = EntityMap.neighbors pos allEnts
      in maybe (str " ") (drawWithNeighbors neighbors)
         $ em ^? atPosition pos . folded

drawMap :: GameState -> Widget Name
drawMap game
  = viewport MapViewport Both
  . showCursor Character (game ^. characterPosition . loc)
  $ drawEntities
    (game ^. revealedEntities)
    (game ^. entities)

drawGame :: GameState -> [Widget Name]
drawGame game
  = pure
  . withBorderStyle unicode
  $   drawMessages (game ^. messageHistory)
  <=> border (drawMap game)