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

import Control.Lens hiding (Const, from)
import Data.Maybe (fromMaybe)
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.TUI.Editor.Model
import Swarm.TUI.Editor.Util qualified as EU
import Swarm.TUI.Model.UI

shouldHideWorldCell :: UIState -> W.Coords -> Bool
shouldHideWorldCell :: UIState -> Coords -> Bool
shouldHideWorldCell UIState
ui Coords
coords =
  Bool
isOutsideSingleSelectedCorner Bool -> Bool -> Bool
|| Bool
isOutsideMapSaveBounds
 where
  we :: WorldEditor Name
we = UIState
ui forall s a. s -> Getting a s a -> a
^. Lens' UIState (WorldEditor Name)
uiWorldEditor
  withinTimeout :: Bool
withinTimeout = UIState
ui forall s a. s -> Getting a s a -> a
^. Lens' UIState TimeSpec
lastFrameTime forall a. Ord a => a -> a -> Bool
< WorldEditor Name
we forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds TimeSpec
boundsPersistDisplayUntil

  isOutsideMapSaveBounds :: Bool
isOutsideMapSaveBounds =
    Bool
withinTimeout
      Bool -> Bool -> Bool
&& forall a. a -> Maybe a -> a
fromMaybe
        Bool
False
        ( do
            Cosmic BoundsRectangle
bounds <- WorldEditor Name
we forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds (Maybe (Cosmic BoundsRectangle))
boundsRect
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BoundsRectangle -> Coords -> Bool
EU.isOutsideRegion (Cosmic BoundsRectangle
bounds forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) Coords
coords
        )

  isOutsideSingleSelectedCorner :: Bool
isOutsideSingleSelectedCorner = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
    Cosmic SubworldName
_ Coords
cornerCoords <- case WorldEditor Name
we forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep of
      LowerRightPending Cosmic Coords
cornerCoords -> forall a. a -> Maybe a
Just Cosmic Coords
cornerCoords
      BoundsSelectionStep
_ -> forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Coords -> Coords -> Bool
EU.isOutsideTopLeftCorner Coords
cornerCoords Coords
coords