-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.Editor.Util where

import Control.Applicative ((<|>))
import Control.Lens hiding (Const, from)
import Control.Monad (guard)
import Data.Map qualified as M
import Data.Map qualified as Map
import Data.Maybe qualified as Maybe
import Data.Vector qualified as V
import Swarm.Game.Entity
import Swarm.Game.Scenario.Topography.Area qualified as EA
import Swarm.Game.Scenario.Topography.Cell
import Swarm.Game.Scenario.Topography.EntityFacade
import Swarm.Game.Scenario.Topography.Grid
import Swarm.Game.Scenario.Topography.Structure.Overlay
import Swarm.Game.Scenario.Topography.WorldDescription
import Swarm.Game.Terrain (TerrainMap, TerrainType)
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.Game.World.Coords
import Swarm.TUI.Editor.Model
import Swarm.Util.Content
import Swarm.Util.Erasable

getEntitiesForList :: EntityMap -> V.Vector EntityFacade
getEntitiesForList :: EntityMap -> Vector EntityFacade
getEntitiesForList EntityMap
em =
  [EntityFacade] -> Vector EntityFacade
forall a. [a] -> Vector a
V.fromList ([EntityFacade] -> Vector EntityFacade)
-> [EntityFacade] -> Vector EntityFacade
forall a b. (a -> b) -> a -> b
$ (Entity -> EntityFacade) -> [Entity] -> [EntityFacade]
forall a b. (a -> b) -> [a] -> [b]
map Entity -> EntityFacade
mkFacade [Entity]
entities
 where
  entities :: [Entity]
entities = Map EntityName Entity -> [Entity]
forall k a. Map k a -> [a]
M.elems (Map EntityName Entity -> [Entity])
-> Map EntityName Entity -> [Entity]
forall a b. (a -> b) -> a -> b
$ EntityMap -> Map EntityName Entity
entitiesByName EntityMap
em

getEditingBounds :: WorldDescription -> (Bool, Cosmic BoundsRectangle)
getEditingBounds :: WorldDescription -> (Bool, Cosmic BoundsRectangle)
getEditingBounds WorldDescription
myWorld =
  (AreaDimensions -> Bool
EA.isEmpty AreaDimensions
a, Cosmic BoundsRectangle
newBounds)
 where
  newBounds :: Cosmic BoundsRectangle
newBounds = SubworldName -> BoundsRectangle -> Cosmic BoundsRectangle
forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
DefaultRootSubworld (Location -> Coords
locToCoords Location
upperLeftLoc, Location -> Coords
locToCoords Location
lowerRightLoc)
  upperLeftLoc :: Location
upperLeftLoc = PositionedGrid (Maybe (PCell Entity)) -> Location
forall a. PositionedGrid a -> Location
gridPosition (PositionedGrid (Maybe (PCell Entity)) -> Location)
-> PositionedGrid (Maybe (PCell Entity)) -> Location
forall a b. (a -> b) -> a -> b
$ WorldDescription -> PositionedGrid (Maybe (PCell Entity))
forall e. PWorldDescription e -> PositionedGrid (Maybe (PCell e))
area WorldDescription
myWorld
  a :: AreaDimensions
a = Grid (Maybe (PCell Entity)) -> AreaDimensions
forall a. Grid a -> AreaDimensions
EA.getGridDimensions (Grid (Maybe (PCell Entity)) -> AreaDimensions)
-> Grid (Maybe (PCell Entity)) -> AreaDimensions
forall a b. (a -> b) -> a -> b
$ PositionedGrid (Maybe (PCell Entity))
-> Grid (Maybe (PCell Entity))
forall a. PositionedGrid a -> Grid a
gridContent (PositionedGrid (Maybe (PCell Entity))
 -> Grid (Maybe (PCell Entity)))
-> PositionedGrid (Maybe (PCell Entity))
-> Grid (Maybe (PCell Entity))
forall a b. (a -> b) -> a -> b
$ WorldDescription -> PositionedGrid (Maybe (PCell Entity))
forall e. PWorldDescription e -> PositionedGrid (Maybe (PCell e))
area WorldDescription
myWorld
  lowerRightLoc :: Location
lowerRightLoc = AreaDimensions -> Location -> Location
EA.computeBottomRightFromUpperLeft AreaDimensions
a Location
upperLeftLoc

getEditorContentAt ::
  TerrainMap ->
  WorldOverdraw ->
  W.MultiWorld Int Entity ->
  Cosmic Coords ->
  (TerrainType, Maybe EntityPaint)
getEditorContentAt :: TerrainMap
-> WorldOverdraw
-> MultiWorld Int Entity
-> Cosmic Coords
-> (TerrainType, Maybe EntityPaint)
getEditorContentAt TerrainMap
tm WorldOverdraw
editorOverdraw MultiWorld Int Entity
w Cosmic Coords
coords =
  (TerrainType
terrainWithOverride, Maybe EntityPaint
entityWithOverride)
 where
  terrainWithOverride :: TerrainType
terrainWithOverride = TerrainType -> Maybe TerrainType -> TerrainType
forall a. a -> Maybe a -> a
Maybe.fromMaybe TerrainType
underlyingCellTerrain (Maybe TerrainType -> TerrainType)
-> Maybe TerrainType -> TerrainType
forall a b. (a -> b) -> a -> b
$ do
    (TerrainType
terrainOverride, Erasable EntityFacade
_) <- Maybe (TerrainType, Erasable EntityFacade)
maybePaintedCell
    TerrainType -> Maybe TerrainType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return TerrainType
terrainOverride

  maybeEntityOverride :: Maybe EntityPaint
  maybeEntityOverride :: Maybe EntityPaint
maybeEntityOverride = do
    (TerrainType
_, Erasable EntityFacade
e) <- Maybe (TerrainType, Erasable EntityFacade)
maybePaintedCell
    EntityFacade -> EntityPaint
Facade (EntityFacade -> EntityPaint)
-> Maybe EntityFacade -> Maybe EntityPaint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Erasable EntityFacade -> Maybe EntityFacade
forall e. Erasable e -> Maybe e
erasableToMaybe Erasable EntityFacade
e

  maybePaintedCell :: Maybe (TerrainType, Erasable EntityFacade)
maybePaintedCell = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ WorldOverdraw
editorOverdraw WorldOverdraw -> Getting Bool WorldOverdraw Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool WorldOverdraw Bool
Lens' WorldOverdraw Bool
isWorldEditorEnabled
    Coords
-> Map Coords (TerrainType, Erasable EntityFacade)
-> Maybe (TerrainType, Erasable EntityFacade)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Cosmic Coords
coords Cosmic Coords -> Getting Coords (Cosmic Coords) Coords -> Coords
forall s a. s -> Getting a s a -> a
^. Getting Coords (Cosmic Coords) Coords
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar) Map Coords (TerrainType, Erasable EntityFacade)
pm

  pm :: Map Coords (TerrainType, Erasable EntityFacade)
pm = WorldOverdraw
editorOverdraw WorldOverdraw
-> Getting
     (Map Coords (TerrainType, Erasable EntityFacade))
     WorldOverdraw
     (Map Coords (TerrainType, Erasable EntityFacade))
-> Map Coords (TerrainType, Erasable EntityFacade)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Coords (TerrainType, Erasable EntityFacade))
  WorldOverdraw
  (Map Coords (TerrainType, Erasable EntityFacade))
Lens'
  WorldOverdraw (Map Coords (TerrainType, Erasable EntityFacade))
paintedTerrain

  entityWithOverride :: Maybe EntityPaint
entityWithOverride = (Entity -> EntityPaint
Ref (Entity -> EntityPaint) -> Maybe Entity -> Maybe EntityPaint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Entity
underlyingCellEntity) Maybe EntityPaint -> Maybe EntityPaint -> Maybe EntityPaint
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe EntityPaint
maybeEntityOverride
  (TerrainType
underlyingCellTerrain, Maybe Entity
underlyingCellEntity) = TerrainMap
-> MultiWorld Int Entity
-> Cosmic Coords
-> (TerrainType, Maybe Entity)
forall e.
TerrainMap
-> MultiWorld Int e -> Cosmic Coords -> (TerrainType, Maybe e)
getContentAt TerrainMap
tm MultiWorld Int Entity
w Cosmic Coords
coords

getEditorTerrainAt ::
  TerrainMap ->
  WorldOverdraw ->
  W.MultiWorld Int Entity ->
  Cosmic Coords ->
  TerrainType
getEditorTerrainAt :: TerrainMap
-> WorldOverdraw
-> MultiWorld Int Entity
-> Cosmic Coords
-> TerrainType
getEditorTerrainAt TerrainMap
tm WorldOverdraw
editor MultiWorld Int Entity
w Cosmic Coords
coords =
  (TerrainType, Maybe EntityPaint) -> TerrainType
forall a b. (a, b) -> a
fst ((TerrainType, Maybe EntityPaint) -> TerrainType)
-> (TerrainType, Maybe EntityPaint) -> TerrainType
forall a b. (a -> b) -> a -> b
$ TerrainMap
-> WorldOverdraw
-> MultiWorld Int Entity
-> Cosmic Coords
-> (TerrainType, Maybe EntityPaint)
getEditorContentAt TerrainMap
tm WorldOverdraw
editor MultiWorld Int Entity
w Cosmic Coords
coords

isOutsideTopLeftCorner ::
  -- | top left corner coords
  Coords ->
  -- | current coords
  Coords ->
  Bool
isOutsideTopLeftCorner :: Coords -> Coords -> Bool
isOutsideTopLeftCorner (Coords (Int32
yTop, Int32
xLeft)) (Coords (Int32
y, Int32
x)) =
  Int32
x Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
xLeft Bool -> Bool -> Bool
|| Int32
y Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
yTop

isOutsideBottomRightCorner ::
  -- | bottom right corner coords
  Coords ->
  -- | current coords
  Coords ->
  Bool
isOutsideBottomRightCorner :: Coords -> Coords -> Bool
isOutsideBottomRightCorner (Coords (Int32
yBottom, Int32
xRight)) (Coords (Int32
y, Int32
x)) =
  Int32
x Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
xRight Bool -> Bool -> Bool
|| Int32
y Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
yBottom

isOutsideRegion ::
  -- | full bounds
  BoundsRectangle ->
  -- | current coords
  Coords ->
  Bool
isOutsideRegion :: BoundsRectangle -> Coords -> Bool
isOutsideRegion (Coords
tl, Coords
br) Coords
coord =
  Coords -> Coords -> Bool
isOutsideTopLeftCorner Coords
tl Coords
coord Bool -> Bool -> Bool
|| Coords -> Coords -> Bool
isOutsideBottomRightCorner Coords
br Coords
coord

getEditedMapRectangle ::
  TerrainMap ->
  WorldOverdraw ->
  Maybe (Cosmic BoundsRectangle) ->
  W.MultiWorld Int Entity ->
  Grid CellPaintDisplay
getEditedMapRectangle :: TerrainMap
-> WorldOverdraw
-> Maybe (Cosmic BoundsRectangle)
-> MultiWorld Int Entity
-> Grid CellPaintDisplay
getEditedMapRectangle TerrainMap
_ WorldOverdraw
_ Maybe (Cosmic BoundsRectangle)
Nothing MultiWorld Int Entity
_ = Grid CellPaintDisplay
forall c. Grid c
EmptyGrid
getEditedMapRectangle TerrainMap
tm WorldOverdraw
worldEditor (Just (Cosmic SubworldName
subworldName BoundsRectangle
coords)) MultiWorld Int Entity
w =
  (EntityPaint -> EntityFacade)
-> (Coords -> (TerrainType, Maybe EntityPaint))
-> BoundsRectangle
-> Grid CellPaintDisplay
forall d e.
(d -> e)
-> (Coords -> (TerrainType, Maybe d))
-> BoundsRectangle
-> Grid (PCell e)
getMapRectangle EntityPaint -> EntityFacade
toFacade Coords -> (TerrainType, Maybe EntityPaint)
getContent BoundsRectangle
coords
 where
  getContent :: Coords -> (TerrainType, Maybe EntityPaint)
getContent = TerrainMap
-> WorldOverdraw
-> MultiWorld Int Entity
-> Cosmic Coords
-> (TerrainType, Maybe EntityPaint)
getEditorContentAt TerrainMap
tm WorldOverdraw
worldEditor MultiWorld Int Entity
w (Cosmic Coords -> (TerrainType, Maybe EntityPaint))
-> (Coords -> Cosmic Coords)
-> Coords
-> (TerrainType, Maybe EntityPaint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubworldName -> Coords -> Cosmic Coords
forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
subworldName