{-# LANGUAGE OverloadedStrings #-}

-- |
-- Rendering of cells in the map view
--
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.View.CellDisplay where

import Brick
import Control.Lens (to, view, (&), (.~), (^.))
import Data.ByteString (ByteString)
import Data.Hash.Murmur
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (maybeToList)
import Data.Semigroup (sconcat)
import Data.Set (Set)
import Data.Set qualified as S
import Data.Tagged (unTagged)
import Data.Word (Word32)
import Graphics.Vty qualified as V
import Linear.Affine ((.-.))
import Swarm.Game.Display (
  Attribute (AEntity),
  Display,
  boundaryOverride,
  defaultEntityDisplay,
  displayAttr,
  displayChar,
  displayPriority,
  getBoundaryDisplay,
  hidden,
 )
import Swarm.Game.Entity
import Swarm.Game.Land
import Swarm.Game.Location (Point (..), toHeading)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Topography.EntityFacade
import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByLocation)
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Substate
import Swarm.Game.Terrain
import Swarm.Game.Tick (TickNumber (..))
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.Game.World.Coords
import Swarm.Language.Syntax.Direction (AbsoluteDir (..))
import Swarm.TUI.Editor.Masking
import Swarm.TUI.Editor.Model
import Swarm.TUI.Editor.Util qualified as EU
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.UI.Gameplay
import Swarm.TUI.View.Attribute.Attr
import Swarm.Util (applyWhen)
import Swarm.Util.Content (getContentAt)
import Witch (from)
import Witch.Encoding qualified as Encoding

-- | Render a display as a UI widget.
renderDisplay :: Display -> Widget n
renderDisplay :: forall n. Display -> Widget n
renderDisplay Display
disp = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (Display
disp Display -> Getting AttrName Display AttrName -> AttrName
forall s a. s -> Getting a s a -> a
^. (Attribute -> Const AttrName Attribute)
-> Display -> Const AttrName Display
Lens' Display Attribute
displayAttr ((Attribute -> Const AttrName Attribute)
 -> Display -> Const AttrName Display)
-> ((AttrName -> Const AttrName AttrName)
    -> Attribute -> Const AttrName Attribute)
-> Getting AttrName Display AttrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> AttrName)
-> (AttrName -> Const AttrName AttrName)
-> Attribute
-> Const AttrName Attribute
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Attribute -> AttrName
toAttrName) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str [Display -> Char
displayChar Display
disp]

-- | Render the 'Display' for a specific location.
drawLoc :: UIGameplay -> GameState -> Cosmic Coords -> Widget Name
drawLoc :: UIGameplay -> GameState -> Cosmic Coords -> Widget Name
drawLoc UIGameplay
ui GameState
g cCoords :: Cosmic Coords
cCoords@(Cosmic SubworldName
_ Coords
coords) =
  if UIGameplay -> Coords -> Bool
shouldHideWorldCell UIGameplay
ui Coords
coords
    then String -> Widget Name
forall n. String -> Widget n
str String
" "
    else Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
boldStructure Widget Name
forall {n}. Widget n
drawCell
 where
  showRobots :: Bool
showRobots = UIGameplay
ui UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIGameplay Bool
Getter UIGameplay Bool
uiShowRobots
  we :: WorldOverdraw
we = UIGameplay
ui UIGameplay
-> Getting WorldOverdraw UIGameplay WorldOverdraw -> WorldOverdraw
forall s a. s -> Getting a s a -> a
^. (WorldEditor Name -> Const WorldOverdraw (WorldEditor Name))
-> UIGameplay -> Const WorldOverdraw UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Const WorldOverdraw (WorldEditor Name))
 -> UIGameplay -> Const WorldOverdraw UIGameplay)
-> ((WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
    -> WorldEditor Name -> Const WorldOverdraw (WorldEditor Name))
-> Getting WorldOverdraw UIGameplay WorldOverdraw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
-> WorldEditor Name -> Const WorldOverdraw (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw
  drawCell :: Widget n
drawCell = Display -> Widget n
forall n. Display -> Widget n
renderDisplay (Display -> Widget n) -> Display -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> WorldOverdraw -> GameState -> Cosmic Coords -> Display
displayLoc Bool
showRobots WorldOverdraw
we GameState
g Cosmic Coords
cCoords

  boldStructure :: Widget n -> Widget n
boldStructure = Bool -> (Widget n -> Widget n) -> Widget n -> Widget n
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
isStructure ((Widget n -> Widget n) -> Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ (Attr -> Attr) -> Widget n -> Widget n
forall n. (Attr -> Attr) -> Widget n -> Widget n
modifyDefAttr (Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
   where
    sMap :: Map
  (Cosmic Location)
  (FoundStructure RecognizableStructureContent Entity)
sMap = FoundRegistry RecognizableStructureContent Entity
-> Map
     (Cosmic Location)
     (FoundStructure RecognizableStructureContent Entity)
forall b a.
FoundRegistry b a -> Map (Cosmic Location) (FoundStructure b a)
foundByLocation (FoundRegistry RecognizableStructureContent Entity
 -> Map
      (Cosmic Location)
      (FoundStructure RecognizableStructureContent Entity))
-> FoundRegistry RecognizableStructureContent Entity
-> Map
     (Cosmic Location)
     (FoundStructure RecognizableStructureContent Entity)
forall a b. (a -> b) -> a -> b
$ GameState
g GameState
-> Getting
     (FoundRegistry RecognizableStructureContent Entity)
     GameState
     (FoundRegistry RecognizableStructureContent Entity)
-> FoundRegistry RecognizableStructureContent Entity
forall s a. s -> Getting a s a -> a
^. (Discovery
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> GameState
-> Const
     (FoundRegistry RecognizableStructureContent Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const
       (FoundRegistry RecognizableStructureContent Entity) Discovery)
 -> GameState
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) GameState)
-> ((FoundRegistry RecognizableStructureContent Entity
     -> Const
          (FoundRegistry RecognizableStructureContent Entity)
          (FoundRegistry RecognizableStructureContent Entity))
    -> Discovery
    -> Const
         (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> Getting
     (FoundRegistry RecognizableStructureContent Entity)
     GameState
     (FoundRegistry RecognizableStructureContent Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognitionState RecognizableStructureContent Entity
 -> Const
      (FoundRegistry RecognizableStructureContent Entity)
      (RecognitionState RecognizableStructureContent Entity))
-> Discovery
-> Const
     (FoundRegistry RecognizableStructureContent Entity) Discovery
Lens'
  Discovery (RecognitionState RecognizableStructureContent Entity)
structureRecognition ((RecognitionState RecognizableStructureContent Entity
  -> Const
       (FoundRegistry RecognizableStructureContent Entity)
       (RecognitionState RecognizableStructureContent Entity))
 -> Discovery
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> ((FoundRegistry RecognizableStructureContent Entity
     -> Const
          (FoundRegistry RecognizableStructureContent Entity)
          (FoundRegistry RecognizableStructureContent Entity))
    -> RecognitionState RecognizableStructureContent Entity
    -> Const
         (FoundRegistry RecognizableStructureContent Entity)
         (RecognitionState RecognizableStructureContent Entity))
-> (FoundRegistry RecognizableStructureContent Entity
    -> Const
         (FoundRegistry RecognizableStructureContent Entity)
         (FoundRegistry RecognizableStructureContent Entity))
-> Discovery
-> Const
     (FoundRegistry RecognizableStructureContent Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry RecognizableStructureContent Entity
 -> Const
      (FoundRegistry RecognizableStructureContent Entity)
      (FoundRegistry RecognizableStructureContent Entity))
-> RecognitionState RecognizableStructureContent Entity
-> Const
     (FoundRegistry RecognizableStructureContent Entity)
     (RecognitionState RecognizableStructureContent Entity)
forall b1 a b2 (f :: * -> *).
Functor f =>
(FoundRegistry b1 a -> f (FoundRegistry b2 a))
-> RecognitionState b1 a -> f (RecognitionState b2 a)
foundStructures
    isStructure :: Bool
isStructure = Cosmic Location
-> Map
     (Cosmic Location)
     (FoundStructure RecognizableStructureContent Entity)
-> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member (Coords -> Location
coordsToLoc (Coords -> Location) -> Cosmic Coords -> Cosmic Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cosmic Coords
cCoords) Map
  (Cosmic Location)
  (FoundStructure RecognizableStructureContent Entity)
sMap

-- | Subset of the game state needed to render the world
data RenderingInput = RenderingInput
  { RenderingInput -> MultiWorld Priority Entity
multiworldInfo :: W.MultiWorld Int Entity
  , RenderingInput -> EntityPaint -> Bool
isKnownFunc :: EntityPaint -> Bool
  , RenderingInput -> TerrainMap
terrMap :: TerrainMap
  }

displayTerrainCell ::
  WorldOverdraw ->
  RenderingInput ->
  Cosmic Coords ->
  Display
displayTerrainCell :: WorldOverdraw -> RenderingInput -> Cosmic Coords -> Display
displayTerrainCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
coords =
  Display -> (TerrainObj -> Display) -> Maybe TerrainObj -> Display
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Display
forall a. Monoid a => a
mempty TerrainObj -> Display
terrainDisplay (Maybe TerrainObj -> Display) -> Maybe TerrainObj -> Display
forall a b. (a -> b) -> a -> b
$ TerrainType -> Map TerrainType TerrainObj -> Maybe TerrainObj
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TerrainType
t Map TerrainType TerrainObj
tm
 where
  tm :: Map TerrainType TerrainObj
tm = TerrainMap -> Map TerrainType TerrainObj
terrainByName (TerrainMap -> Map TerrainType TerrainObj)
-> TerrainMap -> Map TerrainType TerrainObj
forall a b. (a -> b) -> a -> b
$ RenderingInput -> TerrainMap
terrMap RenderingInput
ri
  t :: TerrainType
t = TerrainMap
-> WorldOverdraw
-> MultiWorld Priority Entity
-> Cosmic Coords
-> TerrainType
EU.getEditorTerrainAt (RenderingInput -> TerrainMap
terrMap RenderingInput
ri) WorldOverdraw
worldEditor (RenderingInput -> MultiWorld Priority Entity
multiworldInfo RenderingInput
ri) Cosmic Coords
coords

displayRobotCell ::
  GameState ->
  Cosmic Coords ->
  [Display]
displayRobotCell :: GameState -> Cosmic Coords -> [Display]
displayRobotCell GameState
g Cosmic Coords
coords =
  (Robot -> Display) -> [Robot] -> [Display]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Display Robot Display -> Robot -> Display
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Display Robot Display
Lens' Robot Display
robotDisplay) ([Robot] -> [Display]) -> [Robot] -> [Display]
forall a b. (a -> b) -> a -> b
$
    Cosmic Location -> GameState -> [Robot]
robotsAtLocation ((Coords -> Location) -> Cosmic Coords -> Cosmic Location
forall a b. (a -> b) -> Cosmic a -> Cosmic b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coords -> Location
coordsToLoc Cosmic Coords
coords) GameState
g

-- | Extract the relevant subset of information from the 'GameState' to be able
-- to compute whether an entity is "known".
mkEntityKnowledge :: GameState -> EntityKnowledgeDependencies
mkEntityKnowledge :: GameState -> EntityKnowledgeDependencies
mkEntityKnowledge GameState
gs =
  EntityKnowledgeDependencies
    { isCreativeMode :: Bool
isCreativeMode = GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool GameState Bool
Lens' GameState Bool
creativeMode
    , globallyKnownEntities :: Set EntityName
globallyKnownEntities = GameState
gs GameState
-> Getting (Set EntityName) GameState (Set EntityName)
-> Set EntityName
forall s a. s -> Getting a s a -> a
^. (Discovery -> Const (Set EntityName) Discovery)
-> GameState -> Const (Set EntityName) GameState
Lens' GameState Discovery
discovery ((Discovery -> Const (Set EntityName) Discovery)
 -> GameState -> Const (Set EntityName) GameState)
-> ((Set EntityName -> Const (Set EntityName) (Set EntityName))
    -> Discovery -> Const (Set EntityName) Discovery)
-> Getting (Set EntityName) GameState (Set EntityName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set EntityName -> Const (Set EntityName) (Set EntityName))
-> Discovery -> Const (Set EntityName) Discovery
Lens' Discovery (Set EntityName)
knownEntities
    , theFocusedRobot :: Maybe Robot
theFocusedRobot = GameState -> Maybe Robot
focusedRobot GameState
gs
    }

-- | The subset of information required to compute whether
-- an entity is "known", and therefore should be rendered
-- normally vs as a question mark.
data EntityKnowledgeDependencies = EntityKnowledgeDependencies
  { EntityKnowledgeDependencies -> Bool
isCreativeMode :: Bool
  , EntityKnowledgeDependencies -> Set EntityName
globallyKnownEntities :: Set EntityName
  , EntityKnowledgeDependencies -> Maybe Robot
theFocusedRobot :: Maybe Robot
  }

-- | Determines whether an entity should be rendered
-- normally vs as a question mark.
getEntityIsKnown :: EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown :: EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown EntityKnowledgeDependencies
knowledge EntityPaint
ep = case EntityPaint
ep of
  Facade (EntityFacade EntityName
_ Display
_) -> Bool
True
  Ref Entity
e -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
reasonsToShow
   where
    reasonsToShow :: [Bool]
reasonsToShow =
      [ EntityKnowledgeDependencies -> Bool
isCreativeMode EntityKnowledgeDependencies
knowledge
      , Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Known
      , (Entity
e Entity -> Getting EntityName Entity EntityName -> EntityName
forall s a. s -> Getting a s a -> a
^. Getting EntityName Entity EntityName
Lens' Entity EntityName
entityName) EntityName -> Set EntityName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` EntityKnowledgeDependencies -> Set EntityName
globallyKnownEntities EntityKnowledgeDependencies
knowledge
      , Bool
showBasedOnRobotKnowledge
      ]
    showBasedOnRobotKnowledge :: Bool
showBasedOnRobotKnowledge = Bool -> (Robot -> Bool) -> Maybe Robot -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Robot -> Entity -> Bool
`robotKnows` Entity
e) (Maybe Robot -> Bool) -> Maybe Robot -> Bool
forall a b. (a -> b) -> a -> b
$ EntityKnowledgeDependencies -> Maybe Robot
theFocusedRobot EntityKnowledgeDependencies
knowledge

displayEntityCell ::
  WorldOverdraw ->
  RenderingInput ->
  Cosmic Coords ->
  [Display]
displayEntityCell :: WorldOverdraw -> RenderingInput -> Cosmic Coords -> [Display]
displayEntityCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
coords =
  Maybe Display -> [Display]
forall a. Maybe a -> [a]
maybeToList (Maybe Display -> [Display]) -> Maybe Display -> [Display]
forall a b. (a -> b) -> a -> b
$ Display -> Display
assignBoundaryOverride (Display -> Display)
-> (EntityPaint -> Display) -> EntityPaint -> Display
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityPaint -> Display
displayForEntity (EntityPaint -> Display) -> Maybe EntityPaint -> Maybe Display
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EntityPaint
maybeEntityPaint
 where
  maybeEntityPaint :: Maybe EntityPaint
maybeEntityPaint = Cosmic Coords -> Maybe EntityPaint
getEntPaintAtCoord Cosmic Coords
coords

  getEntPaintAtCoord :: Cosmic Coords -> Maybe EntityPaint
getEntPaintAtCoord = (TerrainType, Maybe EntityPaint) -> Maybe EntityPaint
forall a b. (a, b) -> b
snd ((TerrainType, Maybe EntityPaint) -> Maybe EntityPaint)
-> (Cosmic Coords -> (TerrainType, Maybe EntityPaint))
-> Cosmic Coords
-> Maybe EntityPaint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TerrainMap
-> WorldOverdraw
-> MultiWorld Priority Entity
-> Cosmic Coords
-> (TerrainType, Maybe EntityPaint)
EU.getEditorContentAt (RenderingInput -> TerrainMap
terrMap RenderingInput
ri) WorldOverdraw
worldEditor (RenderingInput -> MultiWorld Priority Entity
multiworldInfo RenderingInput
ri)
  coordHasBoundary :: Cosmic Coords -> Bool
coordHasBoundary = Bool -> (Entity -> Bool) -> Maybe Entity -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Boundary) (Maybe Entity -> Bool)
-> (Cosmic Coords -> Maybe Entity) -> Cosmic Coords -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainType, Maybe Entity) -> Maybe Entity
forall a b. (a, b) -> b
snd ((TerrainType, Maybe Entity) -> Maybe Entity)
-> (Cosmic Coords -> (TerrainType, Maybe Entity))
-> Cosmic Coords
-> Maybe Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TerrainMap
-> MultiWorld Priority Entity
-> Cosmic Coords
-> (TerrainType, Maybe Entity)
forall e.
TerrainMap
-> MultiWorld Priority e -> Cosmic Coords -> (TerrainType, Maybe e)
getContentAt (RenderingInput -> TerrainMap
terrMap RenderingInput
ri) (RenderingInput -> MultiWorld Priority Entity
multiworldInfo RenderingInput
ri)

  assignBoundaryOverride :: Display -> Display
assignBoundaryOverride = Bool -> (Display -> Display) -> Display -> Display
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Cosmic Coords -> Bool
coordHasBoundary Cosmic Coords
coords) ((Maybe Char -> Identity (Maybe Char))
-> Display -> Identity Display
Lens' Display (Maybe Char)
boundaryOverride ((Maybe Char -> Identity (Maybe Char))
 -> Display -> Identity Display)
-> Maybe Char -> Display -> Display
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (AbsoluteDir -> Bool) -> Maybe Char
getBoundaryDisplay AbsoluteDir -> Bool
checkPresence)
   where
    checkPresence :: AbsoluteDir -> Bool
    checkPresence :: AbsoluteDir -> Bool
checkPresence AbsoluteDir
d = Cosmic Coords -> Bool
coordHasBoundary Cosmic Coords
offsettedCoord
     where
      offsettedCoord :: Cosmic Coords
offsettedCoord = (Coords -> (Int32, Int32) -> Coords
`addTuple` (Int32, Int32)
xy) (Coords -> Coords) -> Cosmic Coords -> Cosmic Coords
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cosmic Coords
coords
      Coords (Int32, Int32)
xy = Location -> Coords
locToCoords (Location -> Coords) -> Location -> Coords
forall a b. (a -> b) -> a -> b
$ V2 Int32 -> Location
forall (f :: * -> *) a. f a -> Point f a
P (V2 Int32 -> Location) -> V2 Int32 -> Location
forall a b. (a -> b) -> a -> b
$ AbsoluteDir -> V2 Int32
toHeading AbsoluteDir
d

  displayForEntity :: EntityPaint -> Display
  displayForEntity :: EntityPaint -> Display
displayForEntity EntityPaint
e = Bool -> (Display -> Display) -> Display -> Display
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RenderingInput -> EntityPaint -> Bool
isKnownFunc RenderingInput
ri EntityPaint
e) Display -> Display
hidden (Display -> Display) -> Display -> Display
forall a b. (a -> b) -> a -> b
$ EntityPaint -> Display
getDisplay EntityPaint
e

-- | Get the 'Display' for a specific location, by combining the
--   'Display's for the terrain, entity, and robots at the location, and
--   taking into account "static" based on the distance to the robot
--   being @view@ed.
displayLoc :: Bool -> WorldOverdraw -> GameState -> Cosmic Coords -> Display
displayLoc :: Bool -> WorldOverdraw -> GameState -> Cosmic Coords -> Display
displayLoc Bool
showRobots WorldOverdraw
we GameState
g cCoords :: Cosmic Coords
cCoords@(Cosmic SubworldName
_ Coords
coords) =
  GameState -> Coords -> Display
staticDisplay GameState
g Coords
coords
    Display -> Display -> Display
forall a. Semigroup a => a -> a -> a
<> WorldOverdraw
-> RenderingInput -> [Display] -> Cosmic Coords -> Display
displayLocRaw WorldOverdraw
we RenderingInput
ri [Display]
robots Cosmic Coords
cCoords
 where
  ri :: RenderingInput
ri =
    MultiWorld Priority Entity
-> (EntityPaint -> Bool) -> TerrainMap -> RenderingInput
RenderingInput
      (GameState
g GameState
-> Getting
     (MultiWorld Priority Entity) GameState (MultiWorld Priority Entity)
-> MultiWorld Priority Entity
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const (MultiWorld Priority Entity) Landscape)
-> GameState -> Const (MultiWorld Priority Entity) GameState
Lens' GameState Landscape
landscape ((Landscape -> Const (MultiWorld Priority Entity) Landscape)
 -> GameState -> Const (MultiWorld Priority Entity) GameState)
-> ((MultiWorld Priority Entity
     -> Const (MultiWorld Priority Entity) (MultiWorld Priority Entity))
    -> Landscape -> Const (MultiWorld Priority Entity) Landscape)
-> Getting
     (MultiWorld Priority Entity) GameState (MultiWorld Priority Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiWorld Priority Entity
 -> Const (MultiWorld Priority Entity) (MultiWorld Priority Entity))
-> Landscape -> Const (MultiWorld Priority Entity) Landscape
Lens' Landscape (MultiWorld Priority Entity)
multiWorld)
      (EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown (EntityKnowledgeDependencies -> EntityPaint -> Bool)
-> EntityKnowledgeDependencies -> EntityPaint -> Bool
forall a b. (a -> b) -> a -> b
$ GameState -> EntityKnowledgeDependencies
mkEntityKnowledge GameState
g)
      (GameState
g GameState -> Getting TerrainMap GameState TerrainMap -> TerrainMap
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const TerrainMap Landscape)
-> GameState -> Const TerrainMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const TerrainMap Landscape)
 -> GameState -> Const TerrainMap GameState)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> Landscape -> Const TerrainMap Landscape)
-> Getting TerrainMap GameState TerrainMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> Landscape -> Const TerrainMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
 -> Landscape -> Const TerrainMap Landscape)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> Landscape
-> Const TerrainMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainMap -> Const TerrainMap TerrainMap)
-> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps
Lens' TerrainEntityMaps TerrainMap
terrainMap)

  robots :: [Display]
robots =
    if Bool
showRobots
      then GameState -> Cosmic Coords -> [Display]
displayRobotCell GameState
g Cosmic Coords
cCoords
      else []

-- | Get the 'Display' for a specific location, by combining the
--   'Display's for the terrain, entity, and robots at the location.
displayLocRaw ::
  WorldOverdraw ->
  RenderingInput ->
  -- | Robot displays
  [Display] ->
  Cosmic Coords ->
  Display
displayLocRaw :: WorldOverdraw
-> RenderingInput -> [Display] -> Cosmic Coords -> Display
displayLocRaw WorldOverdraw
worldEditor RenderingInput
ri [Display]
robotDisplays Cosmic Coords
coords =
  NonEmpty Display -> Display
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Display -> Display) -> NonEmpty Display -> Display
forall a b. (a -> b) -> a -> b
$ Display
terrain Display -> [Display] -> NonEmpty Display
forall a. a -> [a] -> NonEmpty a
NE.:| [Display]
entity [Display] -> [Display] -> [Display]
forall a. Semigroup a => a -> a -> a
<> [Display]
robotDisplays
 where
  terrain :: Display
terrain = WorldOverdraw -> RenderingInput -> Cosmic Coords -> Display
displayTerrainCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
coords
  entity :: [Display]
entity = WorldOverdraw -> RenderingInput -> Cosmic Coords -> [Display]
displayEntityCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
coords

-- | Random "static" based on the distance to the robot being
--   @view@ed.
staticDisplay :: GameState -> Coords -> Display
staticDisplay :: GameState -> Coords -> Display
staticDisplay GameState
g Coords
coords = Display -> (Word32 -> Display) -> Maybe Word32 -> Display
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Display
forall a. Monoid a => a
mempty Word32 -> Display
displayStatic (GameState -> Coords -> Maybe Word32
getStatic GameState
g Coords
coords)

-- | Draw static given a number from 0-15 representing the state of
--   the four quarter-pixels in a cell
displayStatic :: Word32 -> Display
displayStatic :: Word32 -> Display
displayStatic Word32
s =
  Char -> Display
defaultEntityDisplay (Word32 -> Char
staticChar Word32
s)
    Display -> (Display -> Display) -> Display
forall a b. a -> (a -> b) -> b
& (Priority -> Identity Priority) -> Display -> Identity Display
Lens' Display Priority
displayPriority ((Priority -> Identity Priority) -> Display -> Identity Display)
-> Priority -> Display -> Display
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Priority
forall a. Bounded a => a
maxBound -- Static has higher priority than anything else
    Display -> (Display -> Display) -> Display
forall a b. a -> (a -> b) -> b
& (Attribute -> Identity Attribute) -> Display -> Identity Display
Lens' Display Attribute
displayAttr ((Attribute -> Identity Attribute) -> Display -> Identity Display)
-> Attribute -> Display -> Display
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Attribute
AEntity

-- | Given a value from 0--15, considered as 4 bits, pick the
--   character with the corresponding quarter pixels turned on.
staticChar :: Word32 -> Char
staticChar :: Word32 -> Char
staticChar = \case
  Word32
0 -> Char
' '
  Word32
1 -> Char
'▖'
  Word32
2 -> Char
'▗'
  Word32
3 -> Char
'▄'
  Word32
4 -> Char
'▘'
  Word32
5 -> Char
'▌'
  Word32
6 -> Char
'▚'
  Word32
7 -> Char
'▙'
  Word32
8 -> Char
'▝'
  Word32
9 -> Char
'▞'
  Word32
10 -> Char
'▐'
  Word32
11 -> Char
'▟'
  Word32
12 -> Char
'▀'
  Word32
13 -> Char
'▛'
  Word32
14 -> Char
'▜'
  Word32
15 -> Char
'█'
  Word32
_ -> Char
' '

-- | Random "static" based on the distance to the robot being
--   @view@ed.  A cell can either be static-free (represented by
--   @Nothing@) or can have one of sixteen values (representing the
--   state of the four quarter-pixels in one cell).
getStatic :: GameState -> Coords -> Maybe Word32
getStatic :: GameState -> Coords -> Maybe Word32
getStatic GameState
g Coords
coords
  | Bool
isStatic = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32
h Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
16)
  | Bool
otherwise = Maybe Word32
forall a. Maybe a
Nothing
 where
  -- Offset from the location of the view center to the location under
  -- consideration for display.
  offset :: Diff (Point V2) Int32
offset = Coords -> Location
coordsToLoc Coords
coords Location -> Location -> Diff (Point V2) Int32
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. (GameState
g GameState -> Getting Location GameState Location -> Location
forall s a. s -> Getting a s a -> a
^. (Robots -> Const Location Robots)
-> GameState -> Const Location GameState
Lens' GameState Robots
robotInfo ((Robots -> Const Location Robots)
 -> GameState -> Const Location GameState)
-> ((Location -> Const Location Location)
    -> Robots -> Const Location Robots)
-> Getting Location GameState Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Const Location (Cosmic Location))
-> Robots -> Const Location Robots
Getter Robots (Cosmic Location)
viewCenter ((Cosmic Location -> Const Location (Cosmic Location))
 -> Robots -> Const Location Robots)
-> ((Location -> Const Location Location)
    -> Cosmic Location -> Const Location (Cosmic Location))
-> (Location -> Const Location Location)
-> Robots
-> Const Location Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Location -> Const Location Location)
-> Cosmic Location -> Const Location (Cosmic Location)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar)

  -- Hash.
  h :: Word32
h =
    Word32 -> ByteString -> Word32
murmur3 Word32
1 (ByteString -> Word32)
-> ((V2 Int32, Int64) -> ByteString) -> (V2 Int32, Int64) -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTF_8 ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
unTagged (UTF_8 ByteString -> ByteString)
-> ((V2 Int32, Int64) -> UTF_8 ByteString)
-> (V2 Int32, Int64)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from @String @(Encoding.UTF_8 ByteString) (String -> UTF_8 ByteString)
-> ((V2 Int32, Int64) -> String)
-> (V2 Int32, Int64)
-> UTF_8 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 Int32, Int64) -> String
forall a. Show a => a -> String
show ((V2 Int32, Int64) -> Word32) -> (V2 Int32, Int64) -> Word32
forall a b. (a -> b) -> a -> b
$
      -- include the current tick count / 16 in the hash, so the pattern of static
      -- changes once every 16 ticks
      (V2 Int32
offset, TickNumber -> Int64
getTickNumber (GameState
g GameState -> Getting TickNumber GameState TickNumber -> TickNumber
forall s a. s -> Getting a s a -> a
^. (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> Getting TickNumber GameState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
16)

  -- Hashed probability, i.e. convert the hash into a floating-point number between 0 and 1
  hp :: Double
  hp :: Double
hp = Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)

  isStatic :: Bool
isStatic = case GameState -> Maybe RobotRange
focusedRange GameState
g of
    -- If we're not viewing a robot, display static.  This
    -- can happen if e.g. the robot we were viewing drowned.
    -- This is overridden by creative mode, e.g. when no robots
    -- have been defined for the scenario.
    Maybe RobotRange
Nothing -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ GameState
g GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool GameState Bool
Lens' GameState Bool
creativeMode
    -- Don't display static if the robot is close, or when we're in
    -- creative mode or the player is allowed to scroll the world.
    Just RobotRange
Close -> Bool
False
    -- At medium distances, replace cell with static with a
    -- probability that increases with distance.
    Just (MidRange Double
s) -> Double
hp Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
cos (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))
    -- Far away, everything is static.
    Just RobotRange
Far -> Bool
True