module Swarm.TUI.View.CellDisplay where

import Brick
import Control.Lens
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (maybeToList)
import Data.Semigroup (sconcat)
import Swarm.Game.Display
import Swarm.Game.Entity as E
import Swarm.Game.Robot
import Swarm.Game.State
import Swarm.Game.Terrain (terrainMap)
import Swarm.Game.World qualified as W
import Swarm.TUI.Model.Name

-- | Render the 'Display' for a specific location.
drawLoc :: Bool -> GameState -> W.Coords -> Widget Name
drawLoc :: Bool -> GameState -> Coords -> Widget Name
drawLoc Bool
showRobots GameState
g = forall n. Display -> Widget n
renderDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GameState -> Coords -> Display
displayLoc Bool
showRobots GameState
g

displayTerrainCell :: GameState -> W.Coords -> Display
displayTerrainCell :: GameState -> Coords -> Display
displayTerrainCell GameState
g Coords
coords = Map TerrainType Display
terrainMap forall k a. Ord k => Map k a -> k -> a
M.! forall a. Enum a => Int -> a
toEnum (forall t e. IArray UArray t => Coords -> World t e -> t
W.lookupTerrain Coords
coords (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (World Int Entity)
world))

displayEntityCell, displayRobotCell :: GameState -> W.Coords -> [Display]
displayRobotCell :: GameState -> Coords -> [Display]
displayRobotCell GameState
g Coords
coords = forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Robot Display
robotDisplay) (Location -> GameState -> [Robot]
robotsAtLocation (Coords -> Location
W.coordsToLoc Coords
coords) GameState
g)
displayEntityCell :: GameState -> Coords -> [Display]
displayEntityCell GameState
g Coords
coords = forall a. Maybe a -> [a]
maybeToList (Entity -> Display
displayForEntity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t e. Coords -> World t e -> Maybe e
W.lookupEntity Coords
coords (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (World Int Entity)
world))
 where
  displayForEntity :: Entity -> Display
  displayForEntity :: Entity -> Display
displayForEntity Entity
e = (if Entity -> Bool
known Entity
e then forall a. a -> a
id else Display -> Display
hidden) (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Display
entityDisplay)

  known :: Entity -> Bool
known Entity
e =
    Entity
e
      Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Known
      Bool -> Bool -> Bool
|| (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)
      forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState [Text]
knownEntities)
      Bool -> Bool -> Bool
|| case GameState -> HideEntity
hidingMode GameState
g of
        HideEntity
HideAllEntities -> Bool
False
        HideEntity
HideNoEntity -> Bool
True
        HideEntityUnknownTo Robot
ro -> Robot
ro Robot -> Entity -> Bool
`robotKnows` Entity
e

-- | Get the 'Display' for a specific location, by combining the
--   'Display's for the terrain, entity, and robots at the location.
displayLoc :: Bool -> GameState -> W.Coords -> Display
displayLoc :: Bool -> GameState -> Coords -> Display
displayLoc Bool
showRobots GameState
g Coords
coords =
  forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ Display
terrain forall a. a -> [a] -> NonEmpty a
NE.:| [Display]
entity forall a. Semigroup a => a -> a -> a
<> [Display]
robots
 where
  terrain :: Display
terrain = GameState -> Coords -> Display
displayTerrainCell GameState
g Coords
coords
  entity :: [Display]
entity = GameState -> Coords -> [Display]
displayEntityCell GameState
g Coords
coords
  robots :: [Display]
robots =
    if Bool
showRobots
      then GameState -> Coords -> [Display]
displayRobotCell GameState
g Coords
coords
      else []

data HideEntity = HideAllEntities | HideNoEntity | HideEntityUnknownTo Robot

hidingMode :: GameState -> HideEntity
hidingMode :: GameState -> HideEntity
hidingMode GameState
g
  | GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode = HideEntity
HideNoEntity
  | Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe HideEntity
HideAllEntities Robot -> HideEntity
HideEntityUnknownTo forall a b. (a -> b) -> a -> b
$ GameState -> Maybe Robot
focusedRobot GameState
g