{-# LANGUAGE OverloadedStrings #-}

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

import Data.Aeson (ToJSON)
import Data.Function (on)
import Data.Int (Int32)
import Data.List qualified as L
import Data.List.NonEmpty qualified as NE
import Data.Maybe (listToMaybe)
import Data.Semigroup
import GHC.Generics (Generic)
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
  }
  deriving (Int -> AreaDimensions -> ShowS
[AreaDimensions] -> ShowS
AreaDimensions -> String
(Int -> AreaDimensions -> ShowS)
-> (AreaDimensions -> String)
-> ([AreaDimensions] -> ShowS)
-> Show AreaDimensions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AreaDimensions -> ShowS
showsPrec :: Int -> AreaDimensions -> ShowS
$cshow :: AreaDimensions -> String
show :: AreaDimensions -> String
$cshowList :: [AreaDimensions] -> ShowS
showList :: [AreaDimensions] -> ShowS
Show, AreaDimensions -> AreaDimensions -> Bool
(AreaDimensions -> AreaDimensions -> Bool)
-> (AreaDimensions -> AreaDimensions -> Bool) -> Eq AreaDimensions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AreaDimensions -> AreaDimensions -> Bool
== :: AreaDimensions -> AreaDimensions -> Bool
$c/= :: AreaDimensions -> AreaDimensions -> Bool
/= :: AreaDimensions -> AreaDimensions -> Bool
Eq, (forall x. AreaDimensions -> Rep AreaDimensions x)
-> (forall x. Rep AreaDimensions x -> AreaDimensions)
-> Generic AreaDimensions
forall x. Rep AreaDimensions x -> AreaDimensions
forall x. AreaDimensions -> Rep AreaDimensions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AreaDimensions -> Rep AreaDimensions x
from :: forall x. AreaDimensions -> Rep AreaDimensions x
$cto :: forall x. Rep AreaDimensions x -> AreaDimensions
to :: forall x. Rep AreaDimensions x -> AreaDimensions
Generic, [AreaDimensions] -> Value
[AreaDimensions] -> Encoding
AreaDimensions -> Bool
AreaDimensions -> Value
AreaDimensions -> Encoding
(AreaDimensions -> Value)
-> (AreaDimensions -> Encoding)
-> ([AreaDimensions] -> Value)
-> ([AreaDimensions] -> Encoding)
-> (AreaDimensions -> Bool)
-> ToJSON AreaDimensions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AreaDimensions -> Value
toJSON :: AreaDimensions -> Value
$ctoEncoding :: AreaDimensions -> Encoding
toEncoding :: AreaDimensions -> Encoding
$ctoJSONList :: [AreaDimensions] -> Value
toJSONList :: [AreaDimensions] -> Value
$ctoEncodingList :: [AreaDimensions] -> Encoding
toEncodingList :: [AreaDimensions] -> Encoding
$comitField :: AreaDimensions -> Bool
omitField :: AreaDimensions -> Bool
ToJSON)

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

getNEGridDimensions :: NonEmptyGrid a -> AreaDimensions
getNEGridDimensions :: forall a. NonEmptyGrid a -> AreaDimensions
getNEGridDimensions (NonEmptyGrid NonEmpty (NonEmpty a)
xs) =
  (Int32 -> Int32 -> AreaDimensions
AreaDimensions (Int32 -> Int32 -> AreaDimensions)
-> (Int -> Int32) -> Int -> Int -> AreaDimensions
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    (NonEmpty a -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty a
firstRow)
    (NonEmpty (NonEmpty a) -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty (NonEmpty a)
xs)
 where
  firstRow :: NonEmpty a
firstRow = NonEmpty (NonEmpty a) -> NonEmpty a
forall a. NonEmpty a -> a
NE.head NonEmpty (NonEmpty a)
xs

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 =
  NonEmptyGrid a -> Grid a
forall c. NonEmptyGrid c -> Grid c
Grid
    (NonEmptyGrid a -> Grid a) -> (a -> NonEmptyGrid a) -> a -> Grid a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (NonEmpty a) -> NonEmptyGrid a
forall c. NonEmpty (NonEmpty c) -> NonEmptyGrid c
NonEmptyGrid
    (NonEmpty (NonEmpty a) -> NonEmptyGrid a)
-> (a -> NonEmpty (NonEmpty a)) -> a -> NonEmptyGrid 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