{-# 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
{-# INLINE runSystem #-}
runSystem :: System w a -> w -> IO a
runSystem sys = runReaderT (unSystem sys)
{-# INLINE runWith #-}
runWith :: w -> System w a -> IO a
runWith = flip runSystem
{-# INLINE get #-}
get :: forall w c. Get w c => Entity -> System w c
get (Entity ety) = do
s :: Storage c <- getStore
liftIO$ explGet s ety
{-# INLINE set #-}
set :: forall w c. Set w c => Entity -> c -> System w ()
set (Entity ety) x = do
s :: Storage c <- getStore
liftIO$ explSet s ety x
{-# INLINE exists #-}
exists :: forall w c. Get w c => Entity -> Proxy c -> System w Bool
exists (Entity ety) _ = do
s :: Storage c <- getStore
liftIO$ explExists s ety
{-# INLINE cmap #-}
cmap :: forall w cx cy. (Get w cx, Members w cx, Set w cy)
=> (cx -> cy) -> System w ()
cmap f = do
sx :: Storage cx <- getStore
sy :: Storage cy <- getStore
liftIO$ do
sl <- explMembers sx
U.forM_ sl $ \ e -> do
r <- explGet sx e
explSet sy e (f r)
{-# INLINE cmapM #-}
cmapM :: forall w cx cy. (Get w cx, Set w cy, Members w cx)
=> (cx -> System w cy) -> System w ()
cmapM sys = do
sx :: Storage cx <- getStore
sy :: Storage cy <- getStore
sl <- liftIO$ explMembers sx
U.forM_ sl $ \ e -> do
x <- liftIO$ explGet sx e
y <- sys x
liftIO$ explSet sy e y
{-# INLINE cmapM_ #-}
cmapM_ :: forall w c a. (Get w c, Members w c)
=> (c -> System w a) -> System w ()
cmapM_ sys = do
s :: Storage c <- getStore
sl <- liftIO$ explMembers s
U.forM_ sl $ \ ety -> do
x <- liftIO$ explGet s ety
sys x
{-# INLINE cfold #-}
cfold :: forall w c a. (Members w c, Get w c)
=> (a -> c -> a) -> a -> System w a
cfold f a0 = do
s :: Storage c <- getStore
sl <- liftIO$ explMembers s
liftIO$ U.foldM' (\a e -> f a <$> explGet s e) a0 sl
{-# INLINE cfoldM #-}
cfoldM :: forall w c a. (Members w c, Get w c)
=> (a -> c -> System w a) -> a -> System w a
cfoldM sys a0 = do
s :: Storage c <- getStore
sl <- liftIO$ explMembers s
U.foldM' (\a e -> liftIO (explGet s e) >>= sys a) a0 sl
{-# INLINE cfoldM_ #-}
cfoldM_ :: forall w c a. (Members w c, Get w c)
=> (a -> c -> System w a) -> a -> System w ()
cfoldM_ sys a0 = do
s :: Storage c <- getStore
sl <- liftIO$ explMembers s
U.foldM'_ (\a e -> liftIO (explGet s e) >>= sys a) a0 sl
{-# INLINE getAll #-}
getAll :: forall w c. (Get w c, Members w c)
=> System w [c]
getAll = do
s :: Storage c <- getStore
sl <- liftIO$ explMembers s
forM (U.toList sl) $ liftIO . explGet s
{-# INLINE destroy #-}
destroy :: forall w c. Destroy w c => Entity -> Proxy c -> System w ()
destroy (Entity ety) _ = do
s :: Storage c <- getStore
liftIO$ explDestroy s ety
{-# INLINE modify #-}
modify :: forall w c. (Get w c, Set w c) => Entity -> (c -> c) -> System w ()
modify (Entity ety) f = do
s :: Storage c <- getStore
liftIO$ do
x <- explGet s ety
explSet s ety (f x)
{-# INLINE count #-}
count :: forall w c. Members w c => c -> System w Int
count ~_ = do
s :: Storage c <- getStore
sl <- liftIO$ explMembers s
return $ U.length sl