{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Scenario.Topography.Area where

import Data.Int (Int32)
import Data.List qualified as L
import Data.Maybe (listToMaybe)
import Data.Semigroup
import Linear (V2 (..))
import Swarm.Game.Location
import Swarm.Game.Scenario.Topography.Grid
import Prelude hiding (zipWith)

-- | Height and width of a 2D map region
data AreaDimensions = AreaDimensions
  { AreaDimensions -> Int32
rectWidth :: Int32
  , AreaDimensions -> Int32
rectHeight :: Int32
  }

getGridDimensions :: Grid a -> AreaDimensions
getGridDimensions :: forall a. Grid a -> AreaDimensions
getGridDimensions Grid a
g = [[a]] -> AreaDimensions
forall a. [[a]] -> AreaDimensions
getAreaDimensions ([[a]] -> AreaDimensions) -> [[a]] -> AreaDimensions
forall a b. (a -> b) -> a -> b
$ Grid a -> [[a]]
forall a. Grid a -> [[a]]
getRows Grid a
g

asTuple :: AreaDimensions -> (Int32, Int32)
asTuple :: AreaDimensions -> (Int32, Int32)
asTuple (AreaDimensions Int32
x Int32
y) = (Int32
x, Int32
y)

renderRectDimensions :: AreaDimensions -> String
renderRectDimensions :: AreaDimensions -> String
renderRectDimensions (AreaDimensions Int32
w Int32
h) =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"x" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int32 -> String) -> [Int32] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> String
forall a. Show a => a -> String
show [Int32
w, Int32
h]

invertY :: V2 Int32 -> V2 Int32
invertY :: V2 Int32 -> V2 Int32
invertY (V2 Int32
x Int32
y) = Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
x (-Int32
y)

-- | Incorporates an offset by @-1@, since the area is
-- "inclusive" of the lower-right coordinate.
-- Inverse of 'cornersToArea'.
computeBottomRightFromUpperLeft :: AreaDimensions -> Location -> Location
computeBottomRightFromUpperLeft :: AreaDimensions -> Location -> Location
computeBottomRightFromUpperLeft AreaDimensions
a Location
upperLeft =
  Location
upperLeft Location -> Diff (Point V2) Int32 -> Location
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Int32
Diff (Point V2) Int32
displacement
 where
  displacement :: V2 Int32
displacement = V2 Int32 -> V2 Int32
invertY (V2 Int32 -> V2 Int32) -> V2 Int32 -> V2 Int32
forall a b. (a -> b) -> a -> b
$ AreaDimensions -> V2 Int32
computeAbsoluteCornerDisplacement AreaDimensions
a

computeAbsoluteCornerDisplacement :: AreaDimensions -> V2 Int32
computeAbsoluteCornerDisplacement :: AreaDimensions -> V2 Int32
computeAbsoluteCornerDisplacement (AreaDimensions Int32
w Int32
h) =
  Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
subtract Int32
1 (Int32 -> Int32) -> V2 Int32 -> V2 Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
w Int32
h

-- | Converts the displacement vector between the two
-- diagonal corners of the rectangle into an 'AreaDimensions' record.
-- Adds one to both dimensions since the corner coordinates are "inclusive".
-- Inverse of 'computeBottomRightFromUpperLeft'.
cornersToArea :: Location -> Location -> AreaDimensions
cornersToArea :: Location -> Location -> AreaDimensions
cornersToArea Location
upperLeft Location
bottomRight =
  Int32 -> Int32 -> AreaDimensions
AreaDimensions Int32
x Int32
y
 where
  V2 Int32
x Int32
y = (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) (Int32 -> Int32) -> V2 Int32 -> V2 Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 Int32 -> V2 Int32
invertY (Location
bottomRight 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
.-. Location
upperLeft)

-- | Has zero width or height.
isEmpty :: AreaDimensions -> Bool
isEmpty :: AreaDimensions -> Bool
isEmpty (AreaDimensions Int32
w Int32
h) = Int32
w Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 Bool -> Bool -> Bool
|| Int32
h Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0

-- | Extracts the dimensions of a map grid.
getAreaDimensions :: [[a]] -> AreaDimensions
getAreaDimensions :: forall a. [[a]] -> AreaDimensions
getAreaDimensions [[a]]
cellGrid =
  Int32 -> Int32 -> AreaDimensions
AreaDimensions Int32
w Int32
h
 where
  w :: Int32
w = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Int -> ([a] -> Int) -> Maybe [a] -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe [a] -> Int) -> Maybe [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> Maybe [a]
forall a. [a] -> Maybe a
listToMaybe [[a]]
cellGrid -- column count
  h :: Int32
h = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [[a]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
cellGrid -- row count

computeArea :: AreaDimensions -> Int32
computeArea :: AreaDimensions -> Int32
computeArea (AreaDimensions Int32
w Int32
h) = Int32
w Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
h

fillGrid :: AreaDimensions -> a -> Grid a
fillGrid :: forall a. AreaDimensions -> a -> Grid a
fillGrid (AreaDimensions Int32
0 Int32
_) a
_ = Grid a
forall c. Grid c
EmptyGrid
fillGrid (AreaDimensions Int32
_ Int32
0) a
_ = Grid a
forall c. Grid c
EmptyGrid
fillGrid (AreaDimensions Int32
w Int32
h) a
x =
  NonEmpty (NonEmpty a) -> Grid a
forall c. NonEmpty (NonEmpty c) -> Grid c
Grid
    (NonEmpty (NonEmpty a) -> Grid a)
-> (a -> NonEmpty (NonEmpty a)) -> a -> Grid a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)
forall b.
Integral b =>
b -> NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int32
h
    (NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a))
-> (a -> NonEmpty (NonEmpty a)) -> a -> NonEmpty (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> NonEmpty (NonEmpty a)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (NonEmpty a -> NonEmpty (NonEmpty a))
-> (a -> NonEmpty a) -> a -> NonEmpty (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> NonEmpty a -> NonEmpty a
forall b. Integral b => b -> NonEmpty a -> NonEmpty a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int32
w
    (NonEmpty a -> NonEmpty a) -> (a -> NonEmpty a) -> a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (a -> Grid a) -> a -> Grid a
forall a b. (a -> b) -> a -> b
$ a
x