{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
module Apecs.System where
import Control.Monad
import Control.Monad.Reader
import Data.Proxy
import qualified Data.Vector.Unboxed as U
import Apecs.Components ()
import Apecs.Core
{-# INLINE runSystem #-}
runSystem :: SystemT w m a -> w -> m a
runSystem :: SystemT w m a -> w -> m a
runSystem SystemT w m a
sys = ReaderT w m a -> w -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SystemT w m a -> ReaderT w m a
forall w (m :: * -> *) a. SystemT w m a -> ReaderT w m a
unSystem SystemT w m a
sys)
{-# INLINE runWith #-}
runWith :: w -> SystemT w m a -> m a
runWith :: w -> SystemT w m a -> m a
runWith = (SystemT w m a -> w -> m a) -> w -> SystemT w m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip SystemT w m a -> w -> m a
forall w (m :: * -> *) a. SystemT w m a -> w -> m a
runSystem
{-# INLINE get #-}
get :: forall w m c. Get w m c => Entity -> SystemT w m c
get :: Entity -> SystemT w m c
get (Entity Int
ety) = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
m c -> SystemT w m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m c -> SystemT w m c) -> m c -> SystemT w m c
forall a b. (a -> b) -> a -> b
$ Storage c -> Int -> m (Elem (Storage c))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
ety
{-# INLINE set #-}
set, ($=) :: forall w m c. Set w m c => Entity -> c -> SystemT w m ()
set :: Entity -> c -> SystemT w m ()
set (Entity Int
ety) c
x = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
m () -> SystemT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m () -> SystemT w m ()) -> m () -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ Storage c -> Int -> Elem (Storage c) -> m ()
forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage c
s Int
ety c
Elem (Storage c)
x
$= :: Entity -> c -> SystemT w m ()
($=) = Entity -> c -> SystemT w m ()
forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
set
infixr 2 $=
{-# INLINE exists #-}
exists :: forall w m c. Get w m c => Entity -> Proxy c -> SystemT w m Bool
exists :: Entity -> Proxy c -> SystemT w m Bool
exists (Entity Int
ety) Proxy c
_ = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
m Bool -> SystemT w m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m Bool -> SystemT w m Bool) -> m Bool -> SystemT w m Bool
forall a b. (a -> b) -> a -> b
$ Storage c -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists Storage c
s Int
ety
{-# INLINE destroy #-}
destroy :: forall w m c. Destroy w m c => Entity -> Proxy c -> SystemT w m ()
destroy :: Entity -> Proxy c -> SystemT w m ()
destroy (Entity Int
ety) ~Proxy c
_ = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
m () -> SystemT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m () -> SystemT w m ()) -> m () -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ Storage c -> Int -> m ()
forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy Storage c
s Int
ety
{-# INLINE modify #-}
modify, ($~) :: forall w m cx cy. (Get w m cx, Set w m cy) => Entity -> (cx -> cy) -> SystemT w m ()
modify :: Entity -> (cx -> cy) -> SystemT w m ()
modify (Entity Int
ety) cx -> cy
f = do
sx :: Storage cx <- SystemT w m (Storage cx)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
sy :: Storage cy <- SystemT w m (Storage cy)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
m () -> SystemT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m () -> SystemT w m ()) -> m () -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
possible <- Storage cx -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists Storage cx
sx Int
ety
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
possible (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
cx
x <- Storage cx -> Int -> m (Elem (Storage cx))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
ety
Storage cy -> Int -> Elem (Storage cy) -> m ()
forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
ety (cx -> cy
f cx
x)
$~ :: Entity -> (cx -> cy) -> SystemT w m ()
($~) = Entity -> (cx -> cy) -> SystemT w m ()
forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
Entity -> (cx -> cy) -> SystemT w m ()
modify
infixr 2 $~
{-# INLINE cmap #-}
cmap :: forall w m cx cy. (Get w m cx, Members w m cx, Set w m cy)
=> (cx -> cy) -> SystemT w m ()
cmap :: (cx -> cy) -> SystemT w m ()
cmap cx -> cy
f = do
sx :: Storage cx <- SystemT w m (Storage cx)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
sy :: Storage cy <- SystemT w m (Storage cy)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
m () -> SystemT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m () -> SystemT w m ()) -> m () -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ do
Vector Int
sl <- Storage cx -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage cx
sx
Vector Int -> (Int -> m ()) -> m ()
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
cx
r <- Storage cx -> Int -> m (Elem (Storage cx))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
Storage cy -> Int -> Elem (Storage cy) -> m ()
forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
e (cx -> cy
f cx
r)
{-# INLINE cmapIf #-}
cmapIf :: forall w m cp cx cy.
( Get w m cx
, Get w m cp
, Members w m cx
, Set w m cy )
=> (cp -> Bool)
-> (cx -> cy)
-> SystemT w m ()
cmapIf :: (cp -> Bool) -> (cx -> cy) -> SystemT w m ()
cmapIf cp -> Bool
cond cx -> cy
f = do
sp :: Storage cp <- SystemT w m (Storage cp)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
sx :: Storage cx <- SystemT w m (Storage cx)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
sy :: Storage cy <- SystemT w m (Storage cy)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
m () -> SystemT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m () -> SystemT w m ()) -> m () -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ do
Vector Int
sl <- (Storage cx, Storage cp) -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Storage cx
sx,Storage cp
sp)
Vector Int -> (Int -> m ()) -> m ()
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
cp
p <- Storage cp -> Int -> m (Elem (Storage cp))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cp
sp Int
e
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (cp -> Bool
cond cp
p) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
cx
x <- Storage cx -> Int -> m (Elem (Storage cx))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
Storage cy -> Int -> Elem (Storage cy) -> m ()
forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
e (cx -> cy
f cx
x)
{-# INLINE cmapM #-}
cmapM :: forall w m cx cy. (Get w m cx, Set w m cy, Members w m cx)
=> (cx -> SystemT w m cy) -> SystemT w m ()
cmapM :: (cx -> SystemT w m cy) -> SystemT w m ()
cmapM cx -> SystemT w m cy
sys = do
sx :: Storage cx <- SystemT w m (Storage cx)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
sy :: Storage cy <- SystemT w m (Storage cy)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- m (Vector Int) -> SystemT w m (Vector Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m (Vector Int) -> SystemT w m (Vector Int))
-> m (Vector Int) -> SystemT w m (Vector Int)
forall a b. (a -> b) -> a -> b
$ Storage cx -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage cx
sx
Vector Int -> (Int -> SystemT w m ()) -> SystemT w m ()
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl ((Int -> SystemT w m ()) -> SystemT w m ())
-> (Int -> SystemT w m ()) -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
cx
x <- m cx -> SystemT w m cx
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m cx -> SystemT w m cx) -> m cx -> SystemT w m cx
forall a b. (a -> b) -> a -> b
$ Storage cx -> Int -> m (Elem (Storage cx))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
cy
y <- cx -> SystemT w m cy
sys cx
x
m () -> SystemT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m () -> SystemT w m ()) -> m () -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ Storage cy -> Int -> Elem (Storage cy) -> m ()
forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
e cy
Elem (Storage cy)
y
{-# INLINE cmapM_ #-}
cmapM_ :: forall w m c. (Get w m c, Members w m c)
=> (c -> SystemT w m ()) -> SystemT w m ()
cmapM_ :: (c -> SystemT w m ()) -> SystemT w m ()
cmapM_ c -> SystemT w m ()
sys = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- m (Vector Int) -> SystemT w m (Vector Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m (Vector Int) -> SystemT w m (Vector Int))
-> m (Vector Int) -> SystemT w m (Vector Int)
forall a b. (a -> b) -> a -> b
$ Storage c -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
Vector Int -> (Int -> SystemT w m ()) -> SystemT w m ()
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl ((Int -> SystemT w m ()) -> SystemT w m ())
-> (Int -> SystemT w m ()) -> SystemT w m ()
forall a b. (a -> b) -> a -> b
$ \ Int
ety -> do
c
x <- m c -> SystemT w m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m c -> SystemT w m c) -> m c -> SystemT w m c
forall a b. (a -> b) -> a -> b
$ Storage c -> Int -> m (Elem (Storage c))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
ety
c -> SystemT w m ()
sys c
x
{-# INLINE cfold #-}
cfold :: forall w m c a. (Members w m c, Get w m c)
=> (a -> c -> a) -> a -> SystemT w m a
cfold :: (a -> c -> a) -> a -> SystemT w m a
cfold a -> c -> a
f a
a0 = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- m (Vector Int) -> SystemT w m (Vector Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m (Vector Int) -> SystemT w m (Vector Int))
-> m (Vector Int) -> SystemT w m (Vector Int)
forall a b. (a -> b) -> a -> b
$ Storage c -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
m a -> SystemT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m a -> SystemT w m a) -> m a -> SystemT w m a
forall a b. (a -> b) -> a -> b
$ (a -> Int -> m a) -> a -> Vector Int -> m a
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m a
U.foldM' (\a
a Int
e -> a -> c -> a
f a
a (c -> a) -> m c -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage c -> Int -> m (Elem (Storage c))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) a
a0 Vector Int
sl
{-# INLINE cfoldM #-}
cfoldM :: forall w m c a. (Members w m c, Get w m c)
=> (a -> c -> SystemT w m a) -> a -> SystemT w m a
cfoldM :: (a -> c -> SystemT w m a) -> a -> SystemT w m a
cfoldM a -> c -> SystemT w m a
sys a
a0 = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- m (Vector Int) -> SystemT w m (Vector Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m (Vector Int) -> SystemT w m (Vector Int))
-> m (Vector Int) -> SystemT w m (Vector Int)
forall a b. (a -> b) -> a -> b
$ Storage c -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
(a -> Int -> SystemT w m a) -> a -> Vector Int -> SystemT w m a
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m a
U.foldM' (\a
a Int
e -> m c -> SystemT w m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Storage c -> Int -> m (Elem (Storage c))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) SystemT w m c -> (c -> SystemT w m a) -> SystemT w m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> c -> SystemT w m a
sys a
a) a
a0 Vector Int
sl
{-# INLINE cfoldM_ #-}
cfoldM_ :: forall w m c a. (Members w m c, Get w m c)
=> (a -> c -> SystemT w m a) -> a -> SystemT w m ()
cfoldM_ :: (a -> c -> SystemT w m a) -> a -> SystemT w m ()
cfoldM_ a -> c -> SystemT w m a
sys a
a0 = do
s :: Storage c <- SystemT w m (Storage c)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- m (Vector Int) -> SystemT w m (Vector Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m (Vector Int) -> SystemT w m (Vector Int))
-> m (Vector Int) -> SystemT w m (Vector Int)
forall a b. (a -> b) -> a -> b
$ Storage c -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
(a -> Int -> SystemT w m a) -> a -> Vector Int -> SystemT w m ()
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m ()
U.foldM'_ (\a
a Int
e -> m c -> SystemT w m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Storage c -> Int -> m (Elem (Storage c))
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) SystemT w m c -> (c -> SystemT w m a) -> SystemT w m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> c -> SystemT w m a
sys a
a) a
a0 Vector Int
sl