{-# 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 :: forall w (m :: * -> *) a. SystemT w m a -> w -> m a
runSystem SystemT w m a
sys = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 :: forall w (m :: * -> *) a. w -> SystemT w m a -> m a
runWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall w (m :: * -> *) c. Get w m c => Entity -> SystemT w m c
get (Entity Int
ety) = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ 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 :: forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
set (Entity Int
ety) c
x = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage c
s Int
ety c
x
$= :: forall w (m :: * -> *) c.
Set w m c =>
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 :: forall w (m :: * -> *) c.
Get w m c =>
Entity -> Proxy c -> SystemT w m Bool
exists (Entity Int
ety) Proxy c
_ = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ 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 :: forall w (m :: * -> *) c.
Destroy w m c =>
Entity -> Proxy c -> SystemT w m ()
destroy (Entity Int
ety) ~Proxy c
_ = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ 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 :: forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
Entity -> (cx -> cy) -> SystemT w m ()
modify (Entity Int
ety) cx -> cy
f = do
Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ do
Bool
possible <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists Storage cx
sx Int
ety
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
possible forall a b. (a -> b) -> a -> b
$ do
cx
x <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
ety
forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
ety (cx -> cy
f cx
x)
$~ :: forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
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 :: 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
f = do
Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ do
Vector Int
sl <- forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage cx
sx
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
cx
r <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
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 :: 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
cond cx -> cy
f = do
Storage cp
sp :: Storage cp <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ do
Vector Int
sl <- forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Storage cx
sx,Storage cp
sp)
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
cp
p <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cp
sp Int
e
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (cp -> Bool
cond cp
p) forall a b. (a -> b) -> a -> b
$ do
cx
x <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
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 :: 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
sys = do
Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage cx
sx
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
cx
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ 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
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
e 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_ :: forall w (m :: * -> *) c.
(Get w m c, Members w m c) =>
(c -> SystemT w m ()) -> SystemT w m ()
cmapM_ c -> SystemT w m ()
sys = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
ety -> do
c
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ 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 :: 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
f a
a0 = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: 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
sys a
a0 = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m a
U.foldM' (\a
a Int
e -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) 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_ :: 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
sys a
a0 = do
Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m ()
U.foldM'_ (\a
a Int
e -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) 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 collect #-}
collect :: forall components w m a. (Get w m components, Members w m components)
=> (components -> Maybe a)
-> SystemT w m [a]
collect :: forall components w (m :: * -> *) a.
(Get w m components, Members w m components) =>
(components -> Maybe a) -> SystemT w m [a]
collect components -> Maybe a
f = forall w (m :: * -> *) c a.
(Members w m c, Get w m c) =>
(a -> c -> a) -> a -> SystemT w m a
cfold (\[a]
acc -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
acc (forall a. a -> [a] -> [a]
: [a]
acc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. components -> Maybe a
f) []