{-# 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 Linear (V2 (..))
import Swarm.Game.Location

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

renderRectDimensions :: AreaDimensions -> String
renderRectDimensions :: AreaDimensions -> String
renderRectDimensions (AreaDimensions Int32
w Int32
h) =
  forall a. [a] -> [[a]] -> [a]
L.intercalate String
"x" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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) = 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'.
upperLeftToBottomRight :: AreaDimensions -> Location -> Location
upperLeftToBottomRight :: AreaDimensions -> Location -> Location
upperLeftToBottomRight (AreaDimensions Int32
w Int32
h) Location
upperLeft =
  Location
upperLeft forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Int32
displacement
 where
  displacement :: V2 Int32
displacement = V2 Int32 -> V2 Int32
invertY forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
subtract Int32
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 'upperLeftToBottomRight'.
cornersToArea :: Location -> Location -> AreaDimensions
cornersToArea :: Location -> Location -> AreaDimensions
cornersToArea Location
upperLeft Location
lowerRight =
  Int32 -> Int32 -> AreaDimensions
AreaDimensions Int32
x Int32
y
 where
  V2 Int32
x Int32
y = (forall a. Num a => a -> a -> a
+ Int32
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 Int32 -> V2 Int32
invertY (Location
lowerRight 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 forall a. Eq a => a -> a -> Bool
== Int32
0 Bool -> Bool -> Bool
|| Int32
h 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [[a]]
cellGrid -- column count
  h :: Int32
h = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
cellGrid -- row count