{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Aztecs.Transform
  ( -- * Transform
    Transform (..),

    -- ** 2D
    Transform2D,
    transform2d,

    -- * Size
    Size (..),

    -- ** 2D
    Size2D,
    size2D,

    -- * Systems
    update,
    update2d,
    propagate,
    propagate2d,
  )
where

import Aztecs.ECS
import qualified Aztecs.ECS.Access as A
import qualified Aztecs.ECS.Query as Q
import qualified Aztecs.ECS.System as S
import Aztecs.Hierarchy (Hierarchy, hierarchies, mapWithAccum, toList)
import Control.Arrow (Arrow (..), (>>>))
import Control.DeepSeq
import GHC.Generics (Generic)
import Linear (V2 (..))

-- | Transform component.
data Transform v r = Transform
  { forall v r. Transform v r -> v
transformTranslation :: !v,
    forall v r. Transform v r -> r
transformRotation :: !r,
    forall v r. Transform v r -> v
transformScale :: !v
  }
  deriving (Transform v r -> Transform v r -> Bool
(Transform v r -> Transform v r -> Bool)
-> (Transform v r -> Transform v r -> Bool) -> Eq (Transform v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v r. (Eq r, Eq v) => Transform v r -> Transform v r -> Bool
$c== :: forall v r. (Eq r, Eq v) => Transform v r -> Transform v r -> Bool
== :: Transform v r -> Transform v r -> Bool
$c/= :: forall v r. (Eq r, Eq v) => Transform v r -> Transform v r -> Bool
/= :: Transform v r -> Transform v r -> Bool
Eq, Int -> Transform v r -> ShowS
[Transform v r] -> ShowS
Transform v r -> String
(Int -> Transform v r -> ShowS)
-> (Transform v r -> String)
-> ([Transform v r] -> ShowS)
-> Show (Transform v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v r. (Show r, Show v) => Int -> Transform v r -> ShowS
forall v r. (Show r, Show v) => [Transform v r] -> ShowS
forall v r. (Show r, Show v) => Transform v r -> String
$cshowsPrec :: forall v r. (Show r, Show v) => Int -> Transform v r -> ShowS
showsPrec :: Int -> Transform v r -> ShowS
$cshow :: forall v r. (Show r, Show v) => Transform v r -> String
show :: Transform v r -> String
$cshowList :: forall v r. (Show r, Show v) => [Transform v r] -> ShowS
showList :: [Transform v r] -> ShowS
Show, (forall x. Transform v r -> Rep (Transform v r) x)
-> (forall x. Rep (Transform v r) x -> Transform v r)
-> Generic (Transform v r)
forall x. Rep (Transform v r) x -> Transform v r
forall x. Transform v r -> Rep (Transform v r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v r x. Rep (Transform v r) x -> Transform v r
forall v r x. Transform v r -> Rep (Transform v r) x
$cfrom :: forall v r x. Transform v r -> Rep (Transform v r) x
from :: forall x. Transform v r -> Rep (Transform v r) x
$cto :: forall v r x. Rep (Transform v r) x -> Transform v r
to :: forall x. Rep (Transform v r) x -> Transform v r
Generic, Transform v r -> ()
(Transform v r -> ()) -> NFData (Transform v r)
forall a. (a -> ()) -> NFData a
forall v r. (NFData v, NFData r) => Transform v r -> ()
$crnf :: forall v r. (NFData v, NFData r) => Transform v r -> ()
rnf :: Transform v r -> ()
NFData)

instance (Num v, Num r) => Semigroup (Transform v r) where
  Transform v
t1 r
r1 v
s1 <> :: Transform v r -> Transform v r -> Transform v r
<> Transform v
t2 r
r2 v
s2 = v -> r -> v -> Transform v r
forall v r. v -> r -> v -> Transform v r
Transform (v
t1 v -> v -> v
forall a. Num a => a -> a -> a
+ v
t2) (r
r1 r -> r -> r
forall a. Num a => a -> a -> a
+ r
r2) (v
s1 v -> v -> v
forall a. Num a => a -> a -> a
+ v
s2)

instance (Num v, Num r) => Monoid (Transform v r) where
  mempty :: Transform v r
mempty = v -> r -> v -> Transform v r
forall v r. v -> r -> v -> Transform v r
Transform v
0 r
0 v
0

-- | 2D transform component.
type Transform2D = Transform (V2 Int) Int

-- | Empty transform.
transform2d :: Transform2D
transform2d :: Transform2D
transform2d = V2 Int -> Int -> V2 Int -> Transform2D
forall v r. v -> r -> v -> Transform v r
Transform (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
0 Int
0) Int
0 (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
1 Int
1)

instance Component (Transform (V2 Int) Int)

-- | Size component.
newtype Size v = Size {forall v. Size v -> v
unSize :: v}
  deriving ((forall x. Size v -> Rep (Size v) x)
-> (forall x. Rep (Size v) x -> Size v) -> Generic (Size v)
forall x. Rep (Size v) x -> Size v
forall x. Size v -> Rep (Size v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (Size v) x -> Size v
forall v x. Size v -> Rep (Size v) x
$cfrom :: forall v x. Size v -> Rep (Size v) x
from :: forall x. Size v -> Rep (Size v) x
$cto :: forall v x. Rep (Size v) x -> Size v
to :: forall x. Rep (Size v) x -> Size v
Generic, Size v -> ()
(Size v -> ()) -> NFData (Size v)
forall v. NFData v => Size v -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall v. NFData v => Size v -> ()
rnf :: Size v -> ()
NFData)

type Size2D = Size (V2 Int)

size2D :: Size (V2 Integer)
size2D :: Size (V2 Integer)
size2D = V2 Integer -> Size (V2 Integer)
forall v. v -> Size v
Size (Integer -> Integer -> V2 Integer
forall a. a -> a -> V2 a
V2 Integer
0 Integer
0)

instance Component (Size (V2 Int))

propagateHierarchy :: (Component a, Monoid a) => Hierarchy a -> Hierarchy a
propagateHierarchy :: forall a. (Component a, Monoid a) => Hierarchy a -> Hierarchy a
propagateHierarchy = (EntityID -> a -> a -> (a, a)) -> a -> Hierarchy a -> Hierarchy a
forall a b c.
(EntityID -> a -> b -> (c, b)) -> b -> Hierarchy a -> Hierarchy c
mapWithAccum (\EntityID
_ a
t a
acc -> let t' :: a
t' = a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
acc in (a
t', a
t')) a
forall a. Monoid a => a
mempty

-- | Propagate and update all hierarchies of transform components.
update ::
  forall q arr b m a.
  ( ArrowQueryReader q,
    ArrowDynamicQueryReader q,
    ArrowReaderSystem q arr,
    ArrowQueueSystem b m arr,
    Component a,
    Monoid a
  ) =>
  arr () ()
update :: forall (q :: * -> * -> *) (arr :: * -> * -> *) b (m :: * -> *) a.
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr, ArrowQueueSystem b m arr, Component a,
 Monoid a) =>
arr () ()
update = forall (q :: * -> * -> *) (arr :: * -> * -> *) a.
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr, Component a, Monoid a) =>
arr () [Hierarchy a]
propagate @_ @_ @a arr () [Hierarchy a] -> arr [Hierarchy a] () -> arr () ()
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Hierarchy a] -> m ()) -> arr [Hierarchy a] ()
forall i. (i -> m ()) -> arr i ()
forall b (m :: * -> *) (arr :: * -> * -> *) i.
ArrowQueueSystem b m arr =>
(i -> m ()) -> arr i ()
S.queue ((Hierarchy a -> m ()) -> [Hierarchy a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Hierarchy a -> m ()) -> [Hierarchy a] -> m ())
-> (Hierarchy a -> m ()) -> [Hierarchy a] -> m ()
forall a b. (a -> b) -> a -> b
$ ((EntityID, a) -> m ()) -> [(EntityID, a)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((EntityID -> a -> m ()) -> (EntityID, a) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry EntityID -> a -> m ()
forall a. Component a => EntityID -> a -> m ()
forall b (m :: * -> *) a.
(MonadAccess b m, Component a) =>
EntityID -> a -> m ()
A.insert) ([(EntityID, a)] -> m ())
-> (Hierarchy a -> [(EntityID, a)]) -> Hierarchy a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hierarchy a -> [(EntityID, a)]
forall a. Hierarchy a -> [(EntityID, a)]
toList)

-- | Propagate and update all hierarchies of transform components.
update2d :: (ArrowQueryReader q, ArrowDynamicQueryReader q, ArrowReaderSystem q arr, ArrowQueueSystem b m arr) => arr () ()
update2d :: forall (q :: * -> * -> *) (arr :: * -> * -> *) b (m :: * -> *).
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr, ArrowQueueSystem b m arr) =>
arr () ()
update2d = forall (q :: * -> * -> *) (arr :: * -> * -> *) a.
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr, Component a, Monoid a) =>
arr () [Hierarchy a]
propagate @_ @_ @Transform2D arr () [Hierarchy Transform2D]
-> arr [Hierarchy Transform2D] () -> arr () ()
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Hierarchy Transform2D] -> m ()) -> arr [Hierarchy Transform2D] ()
forall i. (i -> m ()) -> arr i ()
forall b (m :: * -> *) (arr :: * -> * -> *) i.
ArrowQueueSystem b m arr =>
(i -> m ()) -> arr i ()
S.queue ((Hierarchy Transform2D -> m ()) -> [Hierarchy Transform2D] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Hierarchy Transform2D -> m ())
 -> [Hierarchy Transform2D] -> m ())
-> (Hierarchy Transform2D -> m ())
-> [Hierarchy Transform2D]
-> m ()
forall a b. (a -> b) -> a -> b
$ ((EntityID, Transform2D) -> m ())
-> [(EntityID, Transform2D)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((EntityID -> Transform2D -> m ())
-> (EntityID, Transform2D) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry EntityID -> Transform2D -> m ()
forall a. Component a => EntityID -> a -> m ()
forall b (m :: * -> *) a.
(MonadAccess b m, Component a) =>
EntityID -> a -> m ()
A.insert) ([(EntityID, Transform2D)] -> m ())
-> (Hierarchy Transform2D -> [(EntityID, Transform2D)])
-> Hierarchy Transform2D
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hierarchy Transform2D -> [(EntityID, Transform2D)]
forall a. Hierarchy a -> [(EntityID, a)]
toList)

propagate ::
  (ArrowQueryReader q, ArrowDynamicQueryReader q, ArrowReaderSystem q arr, Component a, Monoid a) =>
  arr () [Hierarchy a]
propagate :: forall (q :: * -> * -> *) (arr :: * -> * -> *) a.
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr, Component a, Monoid a) =>
arr () [Hierarchy a]
propagate = q () a -> arr () [Hierarchy a]
forall (q :: * -> * -> *) (arr :: * -> * -> *) i a.
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr) =>
q i a -> arr i [Hierarchy a]
hierarchies q () a
forall a. Component a => q () a
forall (arr :: * -> * -> *) a.
(ArrowQueryReader arr, Component a) =>
arr () a
Q.fetch arr () [Hierarchy a]
-> arr [Hierarchy a] [Hierarchy a] -> arr () [Hierarchy a]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Hierarchy a] -> [Hierarchy a]) -> arr [Hierarchy a] [Hierarchy a]
forall b c. (b -> c) -> arr b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Hierarchy a -> Hierarchy a) -> [Hierarchy a] -> [Hierarchy a]
forall a b. (a -> b) -> [a] -> [b]
map Hierarchy a -> Hierarchy a
forall a. (Component a, Monoid a) => Hierarchy a -> Hierarchy a
propagateHierarchy)

propagate2d :: (ArrowQueryReader q, ArrowDynamicQueryReader q, ArrowReaderSystem q arr) => arr () [Hierarchy Transform2D]
propagate2d :: forall (q :: * -> * -> *) (arr :: * -> * -> *).
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr) =>
arr () [Hierarchy Transform2D]
propagate2d = arr () [Hierarchy Transform2D]
forall (q :: * -> * -> *) (arr :: * -> * -> *) a.
(ArrowQueryReader q, ArrowDynamicQueryReader q,
 ArrowReaderSystem q arr, Component a, Monoid a) =>
arr () [Hierarchy a]
propagate