{-# LANGUAGE PatternSynonyms #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- World coordinates.
module Swarm.Game.World.Coords (
  Coords (..),
  locToCoords,
  coordsToLoc,
  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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coords -> Coords -> Bool
$c/= :: Coords -> Coords -> Bool
== :: Coords -> Coords -> Bool
$c== :: Coords -> Coords -> Bool
Eq, Eq 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
min :: Coords -> Coords -> Coords
$cmin :: Coords -> Coords -> Coords
max :: Coords -> Coords -> Coords
$cmax :: Coords -> Coords -> Coords
>= :: Coords -> Coords -> Bool
$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
compare :: Coords -> Coords -> Ordering
$ccompare :: Coords -> Coords -> Ordering
Ord, Int -> Coords -> ShowS
[Coords] -> ShowS
Coords -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coords] -> ShowS
$cshowList :: [Coords] -> ShowS
show :: Coords -> String
$cshow :: Coords -> String
showsPrec :: Int -> Coords -> ShowS
$cshowsPrec :: Int -> Coords -> ShowS
Show, Ord 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
unsafeRangeSize :: (Coords, Coords) -> Int
$cunsafeRangeSize :: (Coords, Coords) -> Int
rangeSize :: (Coords, Coords) -> Int
$crangeSize :: (Coords, Coords) -> Int
inRange :: (Coords, Coords) -> Coords -> Bool
$cinRange :: (Coords, Coords) -> Coords -> Bool
unsafeIndex :: (Coords, Coords) -> Coords -> Int
$cunsafeIndex :: (Coords, Coords) -> Coords -> Int
index :: (Coords, Coords) -> Coords -> Int
$cindex :: (Coords, Coords) -> Coords -> Int
range :: (Coords, Coords) -> [Coords]
$crange :: (Coords, Coords) -> [Coords]
Ix, 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
$cto :: forall x. Rep Coords x -> Coords
$cfrom :: forall x. Coords -> Rep Coords x
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)

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