-- | -- 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.WorldDescription import Swarm.Game.Terrain (TerrainType) import Swarm.Game.Universe import Swarm.Game.World qualified as W import Swarm.TUI.Editor.Model import Swarm.Util.Erasable getEntitiesForList :: EntityMap -> V.Vector EntityFacade getEntitiesForList em = V.fromList $ map mkFacade entities where entities = M.elems $ entitiesByName em getEditingBounds :: WorldDescription -> (Bool, Cosmic W.BoundsRectangle) getEditingBounds myWorld = (EA.isEmpty a, newBounds) where newBounds = Cosmic DefaultRootSubworld (W.locToCoords upperLeftLoc, W.locToCoords lowerRightLoc) upperLeftLoc = ul myWorld a = EA.getAreaDimensions $ area myWorld lowerRightLoc = EA.upperLeftToBottomRight a upperLeftLoc getContentAt :: W.MultiWorld Int e -> Cosmic W.Coords -> (TerrainType, Maybe e) getContentAt w coords = (underlyingCellTerrain, underlyingCellEntity) where underlyingCellEntity = W.lookupCosmicEntity coords w underlyingCellTerrain = W.lookupCosmicTerrain coords w getEditorContentAt :: WorldOverdraw -> W.MultiWorld Int Entity -> Cosmic W.Coords -> (TerrainType, Maybe EntityPaint) getEditorContentAt editorOverdraw w coords = (terrainWithOverride, entityWithOverride) where terrainWithOverride = Maybe.fromMaybe underlyingCellTerrain $ do (terrainOverride, _) <- maybePaintedCell return terrainOverride maybeEntityOverride :: Maybe EntityPaint maybeEntityOverride = do (_, e) <- maybePaintedCell Facade <$> erasableToMaybe e maybePaintedCell = do guard $ editorOverdraw ^. isWorldEditorEnabled Map.lookup (coords ^. planar) pm pm = editorOverdraw ^. paintedTerrain entityWithOverride = (Ref <$> underlyingCellEntity) <|> maybeEntityOverride (underlyingCellTerrain, underlyingCellEntity) = getContentAt w coords getEditorTerrainAt :: WorldOverdraw -> W.MultiWorld Int Entity -> Cosmic W.Coords -> TerrainType getEditorTerrainAt editor w coords = fst $ getEditorContentAt editor w coords isOutsideTopLeftCorner :: -- | top left corner coords W.Coords -> -- | current coords W.Coords -> Bool isOutsideTopLeftCorner (W.Coords (yTop, xLeft)) (W.Coords (y, x)) = x < xLeft || y < yTop isOutsideBottomRightCorner :: -- | bottom right corner coords W.Coords -> -- | current coords W.Coords -> Bool isOutsideBottomRightCorner (W.Coords (yBottom, xRight)) (W.Coords (y, x)) = x > xRight || y > yBottom isOutsideRegion :: -- | full bounds W.BoundsRectangle -> -- | current coords W.Coords -> Bool isOutsideRegion (tl, br) coord = isOutsideTopLeftCorner tl coord || isOutsideBottomRightCorner br coord getEditedMapRectangle :: WorldOverdraw -> Maybe (Cosmic W.BoundsRectangle) -> W.MultiWorld Int Entity -> [[CellPaintDisplay]] getEditedMapRectangle _ Nothing _ = [] getEditedMapRectangle worldEditor (Just (Cosmic subworldName coords)) w = getMapRectangle toFacade getContent coords where getContent = getEditorContentAt worldEditor w . Cosmic subworldName getMapRectangle :: (d -> e) -> (W.Coords -> (TerrainType, Maybe d)) -> W.BoundsRectangle -> [[PCell e]] getMapRectangle paintTransform contentFunc coords = map renderRow [yTop .. yBottom] where (W.Coords (yTop, xLeft), W.Coords (yBottom, xRight)) = coords drawCell f rowIndex colIndex = Cell terrain (f <$> maybeToErasable erasableEntity) [] where (terrain, erasableEntity) = contentFunc $ W.Coords (rowIndex, colIndex) renderRow rowIndex = map (drawCell paintTransform rowIndex) [xLeft .. xRight]