{-# 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,
  defaultEntityDisplay,
  displayAttr,
  displayChar,
  displayPriority,
  hidden,
 )
import Swarm.Game.Entity
import Swarm.Game.Land
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.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
import Swarm.TUI.View.Attribute.Attr
import Swarm.Util (applyWhen)
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 StructureCells Entity)
sMap = FoundRegistry StructureCells Entity
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
forall b a.
FoundRegistry b a -> Map (Cosmic Location) (FoundStructure b a)
foundByLocation (FoundRegistry StructureCells Entity
 -> Map (Cosmic Location) (FoundStructure StructureCells Entity))
-> FoundRegistry StructureCells Entity
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
forall a b. (a -> b) -> a -> b
$ GameState
g GameState
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
-> FoundRegistry StructureCells Entity
forall s a. s -> Getting a s a -> a
^. (Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> GameState
-> Const (FoundRegistry StructureCells Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const (FoundRegistry StructureCells Entity) Discovery)
 -> GameState
 -> Const (FoundRegistry StructureCells Entity) GameState)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> Discovery
    -> Const (FoundRegistry StructureCells Entity) Discovery)
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (FoundRegistry StructureCells Entity)
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (StructureRecognizer StructureCells Entity))
-> (FoundRegistry StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (FoundRegistry StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (FoundRegistry StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (FoundRegistry StructureCells Entity)
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(FoundRegistry b a -> f (FoundRegistry b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
foundStructures
    isStructure :: Bool
isStructure = Cosmic Location
-> Map (Cosmic Location) (FoundStructure StructureCells 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 StructureCells 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
$ EntityPaint -> Display
displayForEntity (EntityPaint -> Display) -> Maybe EntityPaint -> Maybe Display
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EntityPaint
maybeEntity
 where
  (TerrainType
_, Maybe EntityPaint
maybeEntity) = 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) Cosmic Coords
coords

  displayForEntity :: EntityPaint -> Display
  displayForEntity :: EntityPaint -> Display
displayForEntity EntityPaint
e = (if RenderingInput -> EntityPaint -> Bool
isKnownFunc RenderingInput
ri EntityPaint
e then Display -> Display
forall a. a -> a
id else 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