{-# LANGUAGE OverloadedStrings #-}
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.Tagged (unTagged)
import Data.Text (Text)
import Data.Word (Word32)
import Linear.Affine ((.-.))
import Swarm.Game.CESK (TickNumber (..))
import Swarm.Game.Display (
Attribute (AEntity),
Display,
defaultEntityDisplay,
displayAttr,
displayChar,
displayPriority,
hidden,
)
import Swarm.Game.Entity
import Swarm.Game.Robot
import Swarm.Game.Scenario.Topography.EntityFacade
import Swarm.Game.State
import Swarm.Game.Terrain
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
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 Witch (from)
import Witch.Encoding qualified as Encoding
renderDisplay :: Display -> Widget n
renderDisplay :: forall n. Display -> Widget n
renderDisplay Display
disp = forall n. AttrName -> Widget n -> Widget n
withAttr (Display
disp forall s a. s -> Getting a s a -> a
^. Lens' Display Attribute
displayAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Attribute -> AttrName
toAttrName) forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str [Display -> Char
displayChar Display
disp]
drawLoc :: UIState -> GameState -> Cosmic W.Coords -> Widget Name
drawLoc :: UIState -> GameState -> Cosmic Coords -> Widget Name
drawLoc UIState
ui GameState
g cCoords :: Cosmic Coords
cCoords@(Cosmic SubworldName
_ Coords
coords) =
if UIState -> Coords -> Bool
shouldHideWorldCell UIState
ui Coords
coords
then forall n. String -> Widget n
str String
" "
else forall {n}. Widget n
drawCell
where
showRobots :: Bool
showRobots = UIState
ui forall s a. s -> Getting a s a -> a
^. Getter UIState Bool
uiShowRobots
we :: WorldOverdraw
we = UIState
ui forall s a. s -> Getting a s a -> a
^. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw
drawCell :: Widget n
drawCell = forall n. Display -> Widget n
renderDisplay forall a b. (a -> b) -> a -> b
$ Bool -> WorldOverdraw -> GameState -> Cosmic Coords -> Display
displayLoc Bool
showRobots WorldOverdraw
we GameState
g Cosmic Coords
cCoords
data RenderingInput = RenderingInput
{ RenderingInput -> MultiWorld Priority Entity
multiworldInfo :: W.MultiWorld Int Entity
, RenderingInput -> EntityPaint -> Bool
isKnownFunc :: EntityPaint -> Bool
}
displayTerrainCell ::
WorldOverdraw ->
RenderingInput ->
Cosmic W.Coords ->
Display
displayTerrainCell :: WorldOverdraw -> RenderingInput -> Cosmic Coords -> Display
displayTerrainCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
coords =
Map TerrainType Display
terrainMap forall k a. Ord k => Map k a -> k -> a
M.! WorldOverdraw
-> MultiWorld Priority Entity -> Cosmic Coords -> TerrainType
EU.getEditorTerrainAt WorldOverdraw
worldEditor (RenderingInput -> MultiWorld Priority Entity
multiworldInfo RenderingInput
ri) Cosmic Coords
coords
displayRobotCell ::
GameState ->
Cosmic W.Coords ->
[Display]
displayRobotCell :: GameState -> Cosmic Coords -> [Display]
displayRobotCell GameState
g Cosmic 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) forall a b. (a -> b) -> a -> b
$
Cosmic Location -> GameState -> [Robot]
robotsAtLocation (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coords -> Location
W.coordsToLoc Cosmic Coords
coords) GameState
g
mkEntityKnowledge :: GameState -> EntityKnowledgeDependencies
mkEntityKnowledge :: GameState -> EntityKnowledgeDependencies
mkEntityKnowledge GameState
gs =
EntityKnowledgeDependencies
{ isCreativeMode :: Bool
isCreativeMode = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode
, globallyKnownEntities :: [Text]
globallyKnownEntities = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery [Text]
knownEntities
, theFocusedRobot :: Maybe Robot
theFocusedRobot = GameState -> Maybe Robot
focusedRobot GameState
gs
}
data EntityKnowledgeDependencies = EntityKnowledgeDependencies
{ EntityKnowledgeDependencies -> Bool
isCreativeMode :: Bool
, EntityKnowledgeDependencies -> [Text]
globallyKnownEntities :: [Text]
, EntityKnowledgeDependencies -> Maybe Robot
theFocusedRobot :: Maybe Robot
}
getEntityIsKnown :: EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown :: EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown EntityKnowledgeDependencies
knowledge EntityPaint
ep = case EntityPaint
ep of
Facade (EntityFacade Text
_ Display
_) -> Bool
True
Ref Entity
e -> 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 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` EntityKnowledgeDependencies -> [Text]
globallyKnownEntities EntityKnowledgeDependencies
knowledge
, Bool
showBasedOnRobotKnowledge
]
showBasedOnRobotKnowledge :: Bool
showBasedOnRobotKnowledge = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Robot -> Entity -> Bool
`robotKnows` Entity
e) forall a b. (a -> b) -> a -> b
$ EntityKnowledgeDependencies -> Maybe Robot
theFocusedRobot EntityKnowledgeDependencies
knowledge
displayEntityCell ::
WorldOverdraw ->
RenderingInput ->
Cosmic W.Coords ->
[Display]
displayEntityCell :: WorldOverdraw -> RenderingInput -> Cosmic Coords -> [Display]
displayEntityCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
coords =
forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ EntityPaint -> Display
displayForEntity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EntityPaint
maybeEntity
where
(TerrainType
_, Maybe EntityPaint
maybeEntity) = WorldOverdraw
-> MultiWorld Priority Entity
-> Cosmic Coords
-> (TerrainType, Maybe EntityPaint)
EU.getEditorContentAt 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 forall a. a -> a
id else Display -> Display
hidden) forall a b. (a -> b) -> a -> b
$ EntityPaint -> Display
getDisplay EntityPaint
e
displayLoc :: Bool -> WorldOverdraw -> GameState -> Cosmic W.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
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) -> RenderingInput
RenderingInput (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld Priority Entity)
multiWorld) (EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown forall a b. (a -> b) -> a -> b
$ GameState -> EntityKnowledgeDependencies
mkEntityKnowledge GameState
g)
robots :: [Display]
robots =
if Bool
showRobots
then GameState -> Cosmic Coords -> [Display]
displayRobotCell GameState
g Cosmic Coords
cCoords
else []
displayLocRaw ::
WorldOverdraw ->
RenderingInput ->
[Display] ->
Cosmic W.Coords ->
Display
displayLocRaw :: WorldOverdraw
-> RenderingInput -> [Display] -> Cosmic Coords -> Display
displayLocRaw WorldOverdraw
worldEditor RenderingInput
ri [Display]
robotDisplays Cosmic 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]
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
staticDisplay :: GameState -> W.Coords -> Display
staticDisplay :: GameState -> Coords -> Display
staticDisplay GameState
g Coords
coords = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Word32 -> Display
displayStatic (GameState -> Coords -> Maybe Word32
getStatic GameState
g Coords
coords)
displayStatic :: Word32 -> Display
displayStatic :: Word32 -> Display
displayStatic Word32
s =
Char -> Display
defaultEntityDisplay (Word32 -> Char
staticChar Word32
s)
forall a b. a -> (a -> b) -> b
& Lens' Display Priority
displayPriority forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Bounded a => a
maxBound
forall a b. a -> (a -> b) -> b
& Lens' Display Attribute
displayAttr forall s t a b. ASetter s t a b -> b -> s -> t
.~ Attribute
AEntity
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
' '
getStatic :: GameState -> W.Coords -> Maybe Word32
getStatic :: GameState -> Coords -> Maybe Word32
getStatic GameState
g Coords
coords
| Bool
isStatic = forall a. a -> Maybe a
Just (Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
16)
| Bool
otherwise = forall a. Maybe a
Nothing
where
offset :: Diff (Point V2) Int32
offset = Coords -> Location
W.coordsToLoc Coords
coords forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar)
h :: Word32
h =
Word32 -> ByteString -> Word32
murmur3 Word32
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from @String @(Encoding.UTF_8 ByteString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$
(V2 Int32
offset, TickNumber -> Int64
getTickNumber (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks) forall a. Integral a => a -> a -> a
`div` Int64
16)
hp :: Double
hp :: Double
hp = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32)
isStatic :: Bool
isStatic = case GameState -> Maybe RobotRange
focusedRange GameState
g of
Maybe RobotRange
Nothing -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode
Just RobotRange
Close -> Bool
False
Just (MidRange Double
s) -> Double
hp forall a. Ord a => a -> a -> Bool
< Double
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
cos (Double
s forall a. Num a => a -> a -> a
* (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2))
Just RobotRange
Far -> Bool
True