{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Swarm.Game.Location (
Location,
pattern Location,
Heading,
applyTurn,
relativeTo,
toDirection,
toAbsDirection,
nearestDirection,
fromDirection,
isCardinal,
north,
south,
east,
west,
manhattan,
euclidean,
getElemsInArea,
Affine (..),
Point (..),
origin,
) where
import Control.Arrow ((&&&))
import Data.Aeson (FromJSONKey, ToJSONKey)
import Data.Function (on, (&))
import Data.Int (Int32)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Yaml (FromJSON (parseJSON), ToJSON (toJSON))
import Linear (Additive (..), V2 (..), negated, norm, perp, unangle)
import Linear.Affine (Affine (..), Point (..), origin)
import Swarm.Language.Syntax (AbsoluteDir (..), Direction (..), PlanarRelativeDir (..), RelativeDir (..), isCardinal)
import Swarm.Util qualified as Util
type Location = Point V2 Int32
pattern Location :: Int32 -> Int32 -> Location
pattern $bLocation :: Int32 -> Int32 -> Location
$mLocation :: forall {r}. Location -> (Int32 -> Int32 -> r) -> ((# #) -> r) -> r
Location x y = P (V2 x y)
{-# COMPLETE Location #-}
instance FromJSON Location where
parseJSON :: Value -> Parser Location
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. f a -> Point f a
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON Location where
toJSON :: Location -> Value
toJSON (P V2 Int32
v) = forall a. ToJSON a => a -> Value
toJSON V2 Int32
v
type Heading = V2 Int32
deriving instance ToJSON (V2 Int32)
deriving instance FromJSON (V2 Int32)
deriving instance FromJSONKey (V2 Int32)
deriving instance ToJSONKey (V2 Int32)
toHeading :: AbsoluteDir -> Heading
toHeading :: AbsoluteDir -> V2 Int32
toHeading = \case
AbsoluteDir
DNorth -> V2 Int32
north
AbsoluteDir
DSouth -> V2 Int32
south
AbsoluteDir
DEast -> V2 Int32
east
AbsoluteDir
DWest -> V2 Int32
west
north :: Heading
north :: V2 Int32
north = forall a. a -> a -> V2 a
V2 Int32
0 Int32
1
south :: Heading
south :: V2 Int32
south = forall a. a -> a -> V2 a
V2 Int32
0 (-Int32
1)
east :: Heading
east :: V2 Int32
east = forall a. a -> a -> V2 a
V2 Int32
1 Int32
0
west :: Heading
west :: V2 Int32
west = forall a. a -> a -> V2 a
V2 (-Int32
1) Int32
0
down :: Heading
down :: V2 Int32
down = forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
applyTurn :: Direction -> Heading -> Heading
applyTurn :: Direction -> V2 Int32 -> V2 Int32
applyTurn Direction
d = case Direction
d of
DRelative RelativeDir
e -> case RelativeDir
e of
DPlanar PlanarRelativeDir
DLeft -> forall a. Num a => V2 a -> V2 a
perp
DPlanar PlanarRelativeDir
DRight -> forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => V2 a -> V2 a
perp
DPlanar PlanarRelativeDir
DBack -> forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated
DPlanar PlanarRelativeDir
DForward -> forall a. a -> a
id
RelativeDir
DDown -> forall a b. a -> b -> a
const V2 Int32
down
DAbsolute AbsoluteDir
e -> forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ AbsoluteDir -> V2 Int32
toHeading AbsoluteDir
e
cardinalDirs :: M.Map Heading AbsoluteDir
cardinalDirs :: Map (V2 Int32) AbsoluteDir
cardinalDirs =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (AbsoluteDir -> V2 Int32
toHeading forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) forall e. (Enum e, Bounded e) => [e]
Util.listEnums
toDirection :: Heading -> Maybe Direction
toDirection :: V2 Int32 -> Maybe Direction
toDirection = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbsoluteDir -> Direction
DAbsolute forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 Int32 -> Maybe AbsoluteDir
toAbsDirection
toAbsDirection :: Heading -> Maybe AbsoluteDir
toAbsDirection :: V2 Int32 -> Maybe AbsoluteDir
toAbsDirection V2 Int32
v = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup V2 Int32
v Map (V2 Int32) AbsoluteDir
cardinalDirs
relativeTo :: AbsoluteDir -> AbsoluteDir -> PlanarRelativeDir
relativeTo :: AbsoluteDir -> AbsoluteDir -> PlanarRelativeDir
relativeTo AbsoluteDir
targetDir AbsoluteDir
referenceDir =
forall a. Enum a => Int -> a
toEnum Int
indexDiff
where
enumCount :: Int
enumCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall e. (Enum e, Bounded e) => [e]
Util.listEnums :: [AbsoluteDir])
indexDiff :: Int
indexDiff = ((-) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Enum a => a -> Int
fromEnum) AbsoluteDir
targetDir AbsoluteDir
referenceDir forall a. Integral a => a -> a -> a
`mod` Int
enumCount
nearestDirection :: Heading -> AbsoluteDir
nearestDirection :: V2 Int32 -> AbsoluteDir
nearestDirection V2 Int32
coord =
forall b a. Integral b => NonEmpty a -> b -> a
Util.indexWrapNonEmpty NonEmpty AbsoluteDir
orderedDirs Int
index
where
angle :: Double
angle :: Double
angle = forall a. (Floating a, Ord a) => V2 a -> a
unangle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral V2 Int32
coord) forall a. Fractional a => a -> a -> a
/ (Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi)
index :: Int
index :: Int
index = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty AbsoluteDir
orderedDirs) forall a. Num a => a -> a -> a
* Double
angle
orderedDirs :: NonEmpty AbsoluteDir
orderedDirs = forall e. (Enum e, Bounded e) => NonEmpty e
Util.listEnumsNonempty
fromDirection :: Direction -> Heading
fromDirection :: Direction -> V2 Int32
fromDirection = \case
DAbsolute AbsoluteDir
x -> AbsoluteDir -> V2 Int32
toHeading AbsoluteDir
x
Direction
_ -> forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
manhattan :: Location -> Location -> Int32
manhattan :: Location -> Location -> Int32
manhattan (Location Int32
x1 Int32
y1) (Location Int32
x2 Int32
y2) = forall a. Num a => a -> a
abs (Int32
x1 forall a. Num a => a -> a -> a
- Int32
x2) forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs (Int32
y1 forall a. Num a => a -> a -> a
- Int32
y2)
euclidean :: Location -> Location -> Double
euclidean :: Location -> Location -> Double
euclidean Location
p1 Location
p2 = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location
p2 forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Location
p1))
getElemsInArea :: Location -> Int32 -> Map Location e -> [e]
getElemsInArea :: forall e. Location -> Int32 -> Map Location e -> [e]
getElemsInArea o :: Location
o@(Location Int32
x Int32
y) Int32
d Map Location e
m = forall k a. Map k a -> [a]
M.elems Map Location e
sm'
where
sm :: Map Location e
sm =
Map Location e
m
forall a b. a -> (a -> b) -> b
& forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
M.split (Int32 -> Int32 -> Location
Location (Int32
x forall a. Num a => a -> a -> a
- Int32
d) (Int32
y forall a. Num a => a -> a -> a
- Int32
1))
forall a b. a -> (a -> b) -> b
& forall a b. (a, b) -> b
snd
forall a b. a -> (a -> b) -> b
& forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
M.split (Int32 -> Int32 -> Location
Location (Int32
x forall a. Num a => a -> a -> a
+ Int32
d) (Int32
y forall a. Num a => a -> a -> a
+ Int32
1))
forall a b. a -> (a -> b) -> b
& forall a b. (a, b) -> a
fst
sm' :: Map Location e
sm' = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ord a => a -> a -> Bool
<= Int32
d) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> Location -> Int32
manhattan Location
o) Map Location e
sm