{-# LANGUAGE PatternSynonyms #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- World coordinates.
module Swarm.Game.World.Coords (
  Coords (..),
  locToCoords,
  coordsToLoc,
  addTuple,
  BoundsRectangle,
)
where

import Control.Lens (Rewrapped, Wrapped)
import Data.Array.IArray (Ix)
import Data.Int (Int32)
import GHC.Generics (Generic)
import Swarm.Game.Location (Location, pattern Location)

------------------------------------------------------------
-- World coordinates
------------------------------------------------------------

-- | World coordinates use @(row,column)@ format, with the row
--   increasing as we move down the screen.  We use this format for
--   indexing worlds internally, since it plays nicely with things
--   like drawing the screen, and reading maps from configuration
--   files. The 'locToCoords' and 'coordsToLoc' functions convert back
--   and forth between this type and t'Location', which is used when
--   presenting coordinates externally to the player.
newtype Coords = Coords {Coords -> (Int32, Int32)
unCoords :: (Int32, Int32)}
  deriving (Coords -> Coords -> Bool
(Coords -> Coords -> Bool)
-> (Coords -> Coords -> Bool) -> Eq Coords
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coords -> Coords -> Bool
== :: Coords -> Coords -> Bool
$c/= :: Coords -> Coords -> Bool
/= :: Coords -> Coords -> Bool
Eq, Eq Coords
Eq Coords =>
(Coords -> Coords -> Ordering)
-> (Coords -> Coords -> Bool)
-> (Coords -> Coords -> Bool)
-> (Coords -> Coords -> Bool)
-> (Coords -> Coords -> Bool)
-> (Coords -> Coords -> Coords)
-> (Coords -> Coords -> Coords)
-> Ord Coords
Coords -> Coords -> Bool
Coords -> Coords -> Ordering
Coords -> Coords -> Coords
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Coords -> Coords -> Ordering
compare :: Coords -> Coords -> Ordering
$c< :: Coords -> Coords -> Bool
< :: Coords -> Coords -> Bool
$c<= :: Coords -> Coords -> Bool
<= :: Coords -> Coords -> Bool
$c> :: Coords -> Coords -> Bool
> :: Coords -> Coords -> Bool
$c>= :: Coords -> Coords -> Bool
>= :: Coords -> Coords -> Bool
$cmax :: Coords -> Coords -> Coords
max :: Coords -> Coords -> Coords
$cmin :: Coords -> Coords -> Coords
min :: Coords -> Coords -> Coords
Ord, Int -> Coords -> ShowS
[Coords] -> ShowS
Coords -> String
(Int -> Coords -> ShowS)
-> (Coords -> String) -> ([Coords] -> ShowS) -> Show Coords
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coords -> ShowS
showsPrec :: Int -> Coords -> ShowS
$cshow :: Coords -> String
show :: Coords -> String
$cshowList :: [Coords] -> ShowS
showList :: [Coords] -> ShowS
Show, Ord Coords
Ord Coords =>
((Coords, Coords) -> [Coords])
-> ((Coords, Coords) -> Coords -> Int)
-> ((Coords, Coords) -> Coords -> Int)
-> ((Coords, Coords) -> Coords -> Bool)
-> ((Coords, Coords) -> Int)
-> ((Coords, Coords) -> Int)
-> Ix Coords
(Coords, Coords) -> Int
(Coords, Coords) -> [Coords]
(Coords, Coords) -> Coords -> Bool
(Coords, Coords) -> Coords -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Coords, Coords) -> [Coords]
range :: (Coords, Coords) -> [Coords]
$cindex :: (Coords, Coords) -> Coords -> Int
index :: (Coords, Coords) -> Coords -> Int
$cunsafeIndex :: (Coords, Coords) -> Coords -> Int
unsafeIndex :: (Coords, Coords) -> Coords -> Int
$cinRange :: (Coords, Coords) -> Coords -> Bool
inRange :: (Coords, Coords) -> Coords -> Bool
$crangeSize :: (Coords, Coords) -> Int
rangeSize :: (Coords, Coords) -> Int
$cunsafeRangeSize :: (Coords, Coords) -> Int
unsafeRangeSize :: (Coords, Coords) -> Int
Ix, (forall x. Coords -> Rep Coords x)
-> (forall x. Rep Coords x -> Coords) -> Generic Coords
forall x. Rep Coords x -> Coords
forall x. Coords -> Rep Coords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coords -> Rep Coords x
from :: forall x. Coords -> Rep Coords x
$cto :: forall x. Rep Coords x -> Coords
to :: forall x. Rep Coords x -> Coords
Generic)

instance Rewrapped Coords t
instance Wrapped Coords

-- | Convert an external @(x,y)@ location to an internal 'Coords' value.
locToCoords :: Location -> Coords
locToCoords :: Location -> Coords
locToCoords (Location Int32
x Int32
y) = (Int32, Int32) -> Coords
Coords (-Int32
y, Int32
x)

-- | Convert an internal 'Coords' value to an external @(x,y)@ location.
coordsToLoc :: Coords -> Location
coordsToLoc :: Coords -> Location
coordsToLoc (Coords (Int32
r, Int32
c)) = Int32 -> Int32 -> Location
Location Int32
c (-Int32
r)

addTuple :: Coords -> (Int32, Int32) -> Coords
addTuple :: Coords -> (Int32, Int32) -> Coords
addTuple (Coords (Int32
r, Int32
c)) (Int32
addR, Int32
addC) = (Int32, Int32) -> Coords
Coords (Int32
r Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
addR, Int32
c Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
addC)

-- | Represents the top-left and bottom-right coordinates
-- of a bounding rectangle of cells in the world map
type BoundsRectangle = (Coords, Coords)