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

import Data.Aeson (ToJSON)
import GHC.Generics (Generic)
import Swarm.Game.Location
import Swarm.Game.Scenario.Topography.Structure.Named
import Swarm.Language.Syntax.Direction (AbsoluteDir)

data RotationalSymmetry
  = -- | Aka 1-fold symmetry
    NoSymmetry
  | -- | Equivalent under rotation by 180 degrees
    TwoFold
  | -- | Equivalent under rotation by 90 degrees
    FourFold
  deriving (Int -> RotationalSymmetry -> ShowS
[RotationalSymmetry] -> ShowS
RotationalSymmetry -> String
(Int -> RotationalSymmetry -> ShowS)
-> (RotationalSymmetry -> String)
-> ([RotationalSymmetry] -> ShowS)
-> Show RotationalSymmetry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RotationalSymmetry -> ShowS
showsPrec :: Int -> RotationalSymmetry -> ShowS
$cshow :: RotationalSymmetry -> String
show :: RotationalSymmetry -> String
$cshowList :: [RotationalSymmetry] -> ShowS
showList :: [RotationalSymmetry] -> ShowS
Show, RotationalSymmetry -> RotationalSymmetry -> Bool
(RotationalSymmetry -> RotationalSymmetry -> Bool)
-> (RotationalSymmetry -> RotationalSymmetry -> Bool)
-> Eq RotationalSymmetry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RotationalSymmetry -> RotationalSymmetry -> Bool
== :: RotationalSymmetry -> RotationalSymmetry -> Bool
$c/= :: RotationalSymmetry -> RotationalSymmetry -> Bool
/= :: RotationalSymmetry -> RotationalSymmetry -> Bool
Eq)

data SymmetryAnnotatedGrid a = SymmetryAnnotatedGrid
  { forall a. SymmetryAnnotatedGrid a -> RotationalSymmetry
symmetry :: RotationalSymmetry
  , forall a. SymmetryAnnotatedGrid a -> a
grid :: a
  }
  deriving (Int -> SymmetryAnnotatedGrid a -> ShowS
[SymmetryAnnotatedGrid a] -> ShowS
SymmetryAnnotatedGrid a -> String
(Int -> SymmetryAnnotatedGrid a -> ShowS)
-> (SymmetryAnnotatedGrid a -> String)
-> ([SymmetryAnnotatedGrid a] -> ShowS)
-> Show (SymmetryAnnotatedGrid a)
forall a. Show a => Int -> SymmetryAnnotatedGrid a -> ShowS
forall a. Show a => [SymmetryAnnotatedGrid a] -> ShowS
forall a. Show a => SymmetryAnnotatedGrid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SymmetryAnnotatedGrid a -> ShowS
showsPrec :: Int -> SymmetryAnnotatedGrid a -> ShowS
$cshow :: forall a. Show a => SymmetryAnnotatedGrid a -> String
show :: SymmetryAnnotatedGrid a -> String
$cshowList :: forall a. Show a => [SymmetryAnnotatedGrid a] -> ShowS
showList :: [SymmetryAnnotatedGrid a] -> ShowS
Show, (forall a b.
 (a -> b) -> SymmetryAnnotatedGrid a -> SymmetryAnnotatedGrid b)
-> (forall a b.
    a -> SymmetryAnnotatedGrid b -> SymmetryAnnotatedGrid a)
-> Functor SymmetryAnnotatedGrid
forall a b. a -> SymmetryAnnotatedGrid b -> SymmetryAnnotatedGrid a
forall a b.
(a -> b) -> SymmetryAnnotatedGrid a -> SymmetryAnnotatedGrid b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> SymmetryAnnotatedGrid a -> SymmetryAnnotatedGrid b
fmap :: forall a b.
(a -> b) -> SymmetryAnnotatedGrid a -> SymmetryAnnotatedGrid b
$c<$ :: forall a b. a -> SymmetryAnnotatedGrid b -> SymmetryAnnotatedGrid a
<$ :: forall a b. a -> SymmetryAnnotatedGrid b -> SymmetryAnnotatedGrid a
Functor, (forall m. Monoid m => SymmetryAnnotatedGrid m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> SymmetryAnnotatedGrid a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> SymmetryAnnotatedGrid a -> m)
-> (forall a b. (a -> b -> b) -> b -> SymmetryAnnotatedGrid a -> b)
-> (forall a b. (a -> b -> b) -> b -> SymmetryAnnotatedGrid a -> b)
-> (forall b a. (b -> a -> b) -> b -> SymmetryAnnotatedGrid a -> b)
-> (forall b a. (b -> a -> b) -> b -> SymmetryAnnotatedGrid a -> b)
-> (forall a. (a -> a -> a) -> SymmetryAnnotatedGrid a -> a)
-> (forall a. (a -> a -> a) -> SymmetryAnnotatedGrid a -> a)
-> (forall a. SymmetryAnnotatedGrid a -> [a])
-> (forall a. SymmetryAnnotatedGrid a -> Bool)
-> (forall a. SymmetryAnnotatedGrid a -> Int)
-> (forall a. Eq a => a -> SymmetryAnnotatedGrid a -> Bool)
-> (forall a. Ord a => SymmetryAnnotatedGrid a -> a)
-> (forall a. Ord a => SymmetryAnnotatedGrid a -> a)
-> (forall a. Num a => SymmetryAnnotatedGrid a -> a)
-> (forall a. Num a => SymmetryAnnotatedGrid a -> a)
-> Foldable SymmetryAnnotatedGrid
forall a. Eq a => a -> SymmetryAnnotatedGrid a -> Bool
forall a. Num a => SymmetryAnnotatedGrid a -> a
forall a. Ord a => SymmetryAnnotatedGrid a -> a
forall m. Monoid m => SymmetryAnnotatedGrid m -> m
forall a. SymmetryAnnotatedGrid a -> Bool
forall a. SymmetryAnnotatedGrid a -> Int
forall a. SymmetryAnnotatedGrid a -> [a]
forall a. (a -> a -> a) -> SymmetryAnnotatedGrid a -> a
forall m a. Monoid m => (a -> m) -> SymmetryAnnotatedGrid a -> m
forall b a. (b -> a -> b) -> b -> SymmetryAnnotatedGrid a -> b
forall a b. (a -> b -> b) -> b -> SymmetryAnnotatedGrid a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SymmetryAnnotatedGrid m -> m
fold :: forall m. Monoid m => SymmetryAnnotatedGrid m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SymmetryAnnotatedGrid a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SymmetryAnnotatedGrid a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SymmetryAnnotatedGrid a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SymmetryAnnotatedGrid a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SymmetryAnnotatedGrid a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SymmetryAnnotatedGrid a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SymmetryAnnotatedGrid a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SymmetryAnnotatedGrid a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SymmetryAnnotatedGrid a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SymmetryAnnotatedGrid a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SymmetryAnnotatedGrid a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SymmetryAnnotatedGrid a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SymmetryAnnotatedGrid a -> a
foldr1 :: forall a. (a -> a -> a) -> SymmetryAnnotatedGrid a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SymmetryAnnotatedGrid a -> a
foldl1 :: forall a. (a -> a -> a) -> SymmetryAnnotatedGrid a -> a
$ctoList :: forall a. SymmetryAnnotatedGrid a -> [a]
toList :: forall a. SymmetryAnnotatedGrid a -> [a]
$cnull :: forall a. SymmetryAnnotatedGrid a -> Bool
null :: forall a. SymmetryAnnotatedGrid a -> Bool
$clength :: forall a. SymmetryAnnotatedGrid a -> Int
length :: forall a. SymmetryAnnotatedGrid a -> Int
$celem :: forall a. Eq a => a -> SymmetryAnnotatedGrid a -> Bool
elem :: forall a. Eq a => a -> SymmetryAnnotatedGrid a -> Bool
$cmaximum :: forall a. Ord a => SymmetryAnnotatedGrid a -> a
maximum :: forall a. Ord a => SymmetryAnnotatedGrid a -> a
$cminimum :: forall a. Ord a => SymmetryAnnotatedGrid a -> a
minimum :: forall a. Ord a => SymmetryAnnotatedGrid a -> a
$csum :: forall a. Num a => SymmetryAnnotatedGrid a -> a
sum :: forall a. Num a => SymmetryAnnotatedGrid a -> a
$cproduct :: forall a. Num a => SymmetryAnnotatedGrid a -> a
product :: forall a. Num a => SymmetryAnnotatedGrid a -> a
Foldable, Functor SymmetryAnnotatedGrid
Foldable SymmetryAnnotatedGrid
(Functor SymmetryAnnotatedGrid, Foldable SymmetryAnnotatedGrid) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b)
 -> SymmetryAnnotatedGrid a -> f (SymmetryAnnotatedGrid b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SymmetryAnnotatedGrid (f a) -> f (SymmetryAnnotatedGrid a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> SymmetryAnnotatedGrid a -> m (SymmetryAnnotatedGrid b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SymmetryAnnotatedGrid (m a) -> m (SymmetryAnnotatedGrid a))
-> Traversable SymmetryAnnotatedGrid
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SymmetryAnnotatedGrid (m a) -> m (SymmetryAnnotatedGrid a)
forall (f :: * -> *) a.
Applicative f =>
SymmetryAnnotatedGrid (f a) -> f (SymmetryAnnotatedGrid a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> SymmetryAnnotatedGrid a -> m (SymmetryAnnotatedGrid b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> SymmetryAnnotatedGrid a -> f (SymmetryAnnotatedGrid b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> SymmetryAnnotatedGrid a -> f (SymmetryAnnotatedGrid b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> SymmetryAnnotatedGrid a -> f (SymmetryAnnotatedGrid b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SymmetryAnnotatedGrid (f a) -> f (SymmetryAnnotatedGrid a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SymmetryAnnotatedGrid (f a) -> f (SymmetryAnnotatedGrid a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> SymmetryAnnotatedGrid a -> m (SymmetryAnnotatedGrid b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> SymmetryAnnotatedGrid a -> m (SymmetryAnnotatedGrid b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SymmetryAnnotatedGrid (m a) -> m (SymmetryAnnotatedGrid a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SymmetryAnnotatedGrid (m a) -> m (SymmetryAnnotatedGrid a)
Traversable)

data OrientedStructure = OrientedStructure
  { OrientedStructure -> StructureName
oName :: StructureName
  , OrientedStructure -> AbsoluteDir
oDir :: AbsoluteDir
  }
  deriving (Int -> OrientedStructure -> ShowS
[OrientedStructure] -> ShowS
OrientedStructure -> String
(Int -> OrientedStructure -> ShowS)
-> (OrientedStructure -> String)
-> ([OrientedStructure] -> ShowS)
-> Show OrientedStructure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrientedStructure -> ShowS
showsPrec :: Int -> OrientedStructure -> ShowS
$cshow :: OrientedStructure -> String
show :: OrientedStructure -> String
$cshowList :: [OrientedStructure] -> ShowS
showList :: [OrientedStructure] -> ShowS
Show, OrientedStructure -> OrientedStructure -> Bool
(OrientedStructure -> OrientedStructure -> Bool)
-> (OrientedStructure -> OrientedStructure -> Bool)
-> Eq OrientedStructure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrientedStructure -> OrientedStructure -> Bool
== :: OrientedStructure -> OrientedStructure -> Bool
$c/= :: OrientedStructure -> OrientedStructure -> Bool
/= :: OrientedStructure -> OrientedStructure -> Bool
Eq, Eq OrientedStructure
Eq OrientedStructure =>
(OrientedStructure -> OrientedStructure -> Ordering)
-> (OrientedStructure -> OrientedStructure -> Bool)
-> (OrientedStructure -> OrientedStructure -> Bool)
-> (OrientedStructure -> OrientedStructure -> Bool)
-> (OrientedStructure -> OrientedStructure -> Bool)
-> (OrientedStructure -> OrientedStructure -> OrientedStructure)
-> (OrientedStructure -> OrientedStructure -> OrientedStructure)
-> Ord OrientedStructure
OrientedStructure -> OrientedStructure -> Bool
OrientedStructure -> OrientedStructure -> Ordering
OrientedStructure -> OrientedStructure -> OrientedStructure
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 :: OrientedStructure -> OrientedStructure -> Ordering
compare :: OrientedStructure -> OrientedStructure -> Ordering
$c< :: OrientedStructure -> OrientedStructure -> Bool
< :: OrientedStructure -> OrientedStructure -> Bool
$c<= :: OrientedStructure -> OrientedStructure -> Bool
<= :: OrientedStructure -> OrientedStructure -> Bool
$c> :: OrientedStructure -> OrientedStructure -> Bool
> :: OrientedStructure -> OrientedStructure -> Bool
$c>= :: OrientedStructure -> OrientedStructure -> Bool
>= :: OrientedStructure -> OrientedStructure -> Bool
$cmax :: OrientedStructure -> OrientedStructure -> OrientedStructure
max :: OrientedStructure -> OrientedStructure -> OrientedStructure
$cmin :: OrientedStructure -> OrientedStructure -> OrientedStructure
min :: OrientedStructure -> OrientedStructure -> OrientedStructure
Ord, (forall x. OrientedStructure -> Rep OrientedStructure x)
-> (forall x. Rep OrientedStructure x -> OrientedStructure)
-> Generic OrientedStructure
forall x. Rep OrientedStructure x -> OrientedStructure
forall x. OrientedStructure -> Rep OrientedStructure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OrientedStructure -> Rep OrientedStructure x
from :: forall x. OrientedStructure -> Rep OrientedStructure x
$cto :: forall x. Rep OrientedStructure x -> OrientedStructure
to :: forall x. Rep OrientedStructure x -> OrientedStructure
Generic, [OrientedStructure] -> Value
[OrientedStructure] -> Encoding
OrientedStructure -> Bool
OrientedStructure -> Value
OrientedStructure -> Encoding
(OrientedStructure -> Value)
-> (OrientedStructure -> Encoding)
-> ([OrientedStructure] -> Value)
-> ([OrientedStructure] -> Encoding)
-> (OrientedStructure -> Bool)
-> ToJSON OrientedStructure
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: OrientedStructure -> Value
toJSON :: OrientedStructure -> Value
$ctoEncoding :: OrientedStructure -> Encoding
toEncoding :: OrientedStructure -> Encoding
$ctoJSONList :: [OrientedStructure] -> Value
toJSONList :: [OrientedStructure] -> Value
$ctoEncodingList :: [OrientedStructure] -> Encoding
toEncodingList :: [OrientedStructure] -> Encoding
$comitField :: OrientedStructure -> Bool
omitField :: OrientedStructure -> Bool
ToJSON)

-- | For use in registering recognizable pre-placed structures.
--
-- Compare to
-- 'Swarm.Game.Scenario.Topography.Structure.Recognition.Type.PositionedStructure'.
data LocatedStructure = LocatedStructure
  { LocatedStructure -> OrientedStructure
placedStruct :: OrientedStructure
  , LocatedStructure -> Location
cornerLoc :: Location
  }
  deriving (Int -> LocatedStructure -> ShowS
[LocatedStructure] -> ShowS
LocatedStructure -> String
(Int -> LocatedStructure -> ShowS)
-> (LocatedStructure -> String)
-> ([LocatedStructure] -> ShowS)
-> Show LocatedStructure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocatedStructure -> ShowS
showsPrec :: Int -> LocatedStructure -> ShowS
$cshow :: LocatedStructure -> String
show :: LocatedStructure -> String
$cshowList :: [LocatedStructure] -> ShowS
showList :: [LocatedStructure] -> ShowS
Show)

instance HasLocation LocatedStructure where
  modifyLoc :: (Location -> Location) -> LocatedStructure -> LocatedStructure
modifyLoc Location -> Location
f (LocatedStructure OrientedStructure
x Location
originalLoc) =
    OrientedStructure -> Location -> LocatedStructure
LocatedStructure OrientedStructure
x (Location -> LocatedStructure) -> Location -> LocatedStructure
forall a b. (a -> b) -> a -> b
$ Location -> Location
f Location
originalLoc