{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
module Apecs.System where
import Control.Monad.Reader
import Data.Proxy
import qualified Data.Vector.Unboxed as U
import Apecs.Core
import Apecs.Components ()
{-# INLINE runSystem #-}
runSystem :: SystemT w m a -> w -> m a
runSystem sys = runReaderT (unSystem sys)
{-# INLINE runWith #-}
runWith :: w -> SystemT w m a -> m a
runWith = flip runSystem
{-# INLINE get #-}
get :: forall w m c. Get w m c => Entity -> SystemT w m c
get (Entity ety) = do
s :: Storage c <- getStore
lift$ explGet s ety
{-# INLINE set #-}
set, ($=) :: forall w m c. Set w m c => Entity -> c -> SystemT w m ()
set (Entity ety) x = do
s :: Storage c <- getStore
lift$ explSet s ety x
($=) = set
infixr 2 $=
{-# INLINE exists #-}
exists :: forall w m c. Get w m c => Entity -> Proxy c -> SystemT w m Bool
exists (Entity ety) _ = do
s :: Storage c <- getStore
lift$ explExists s ety
{-# INLINE destroy #-}
destroy :: forall w m c. Destroy w m c => Entity -> Proxy c -> SystemT w m ()
destroy (Entity ety) ~_ = do
s :: Storage c <- getStore
lift$ explDestroy s ety
{-# INLINE modify #-}
modify, ($~) :: forall w m c. (Get w m c, Set w m c) => Entity -> (c -> c) -> SystemT w m ()
modify (Entity ety) f = do
s :: Storage c <- getStore
lift$ do
x <- explGet s ety
explSet s ety (f x)
($~) = 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 f = do
sx :: Storage cx <- getStore
sy :: Storage cy <- getStore
lift$ do
sl <- explMembers sx
U.forM_ sl $ \ e -> do
r <- explGet sx e
explSet sy e (f 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 cond f = do
sp :: Storage cp <- getStore
sx :: Storage cx <- getStore
sy :: Storage cy <- getStore
lift$ do
sl <- explMembers (sx,sp)
U.forM_ sl $ \ e -> do
p <- explGet sp e
when (cond p) $ do
x <- explGet sx e
explSet sy e (f 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 sys = do
sx :: Storage cx <- getStore
sy :: Storage cy <- getStore
sl <- lift$ explMembers sx
U.forM_ sl $ \ e -> do
x <- lift$ explGet sx e
y <- sys x
lift$ explSet sy e y
{-# INLINE cmapM_ #-}
cmapM_ :: forall w m c a. (Get w m c, Members w m c)
=> (c -> SystemT w m a) -> SystemT w m ()
cmapM_ sys = do
s :: Storage c <- getStore
sl <- lift$ explMembers s
U.forM_ sl $ \ ety -> do
x <- lift$ explGet s ety
sys 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 f a0 = do
s :: Storage c <- getStore
sl <- lift$ explMembers s
lift$ U.foldM' (\a e -> f a <$> explGet s e) a0 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 sys a0 = do
s :: Storage c <- getStore
sl <- lift$ explMembers s
U.foldM' (\a e -> lift (explGet s e) >>= sys a) a0 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_ sys a0 = do
s :: Storage c <- getStore
sl <- lift$ explMembers s
U.foldM'_ (\a e -> lift (explGet s e) >>= sys a) a0 sl