module Apecs.Types where
import Control.Monad.Reader
import Data.Traversable (for)
import qualified Data.Vector.Unboxed as U
newtype Entity c = Entity Int deriving (Eq, Ord, Show)
newtype Slice c = Slice {unSlice :: U.Vector Int} deriving (Show, Monoid)
newtype System w a = System {unSystem :: ReaderT w IO a} deriving (Functor, Monad, Applicative, MonadIO)
class (Stores (Storage c) ~ c, Store (Storage c)) => Component c where
type Storage c = s | s -> c
class Component c => Has w c where
getStore :: System w (Storage c)
newtype Safe c = Safe {getSafe :: SafeRW (Storage c)}
class Store s where
type Stores s
type SafeRW s
explGet :: s -> Int -> IO (SafeRW s)
explSet :: s -> Int -> Stores s -> IO ()
explDestroy :: s -> Int -> IO ()
explExists :: s -> Int -> IO Bool
explMembers :: s -> IO (U.Vector Int)
explGetUnsafe :: s -> Int -> IO (Stores s)
explSetMaybe :: s -> Int -> SafeRW s -> IO ()
type InitArgs s
initStoreWith :: InitArgs s -> IO s
explReset :: s -> IO ()
explReset s = do
sl <- explMembers s
U.mapM_ (explDestroy s) sl
explImapM_ :: MonadIO m => s -> (Int -> m a) -> m ()
explImapM_ s ma = liftIO (explMembers s) >>= mapM_ ma . U.toList
explImapM :: MonadIO m => s -> (Int -> m a) -> m [a]
explImapM s ma = liftIO (explMembers s) >>= mapM ma . U.toList
explModify :: s -> Int -> (Stores s -> Stores s) -> IO ()
explModify s ety f = do etyExists <- explExists s ety
when etyExists $ explGetUnsafe s ety >>= explSet s ety . f
explCmap :: s -> (Stores s -> Stores s) -> IO ()
explCmap s f = explMembers s >>= U.mapM_ (\ety -> explModify s ety f)
explCmapM_ :: MonadIO m => s -> (Stores s -> m a) -> m ()
explCmapM_ s sys = do
sl <- liftIO$ explMembers s
U.forM_ sl $ \ety -> do x :: Stores s <- liftIO$ explGetUnsafe s ety
sys x
explCimapM_ :: MonadIO m => s -> ((Int, Stores s) -> m a) -> m ()
explCimapM_ s sys = do
sl <- liftIO$ explMembers s
U.forM_ sl $ \ety -> do x :: Stores s <- liftIO$ explGetUnsafe s ety
sys (ety,x)
explCmapM :: MonadIO m => s -> (Stores s -> m a) -> m [a]
explCmapM s sys = do
sl <- liftIO$ explMembers s
for (U.toList sl) $ \ety -> do
x :: Stores s <- liftIO$ explGetUnsafe s ety
sys x
explCimapM :: MonadIO m => s -> ((Int, Stores s) -> m a) -> m [a]
explCimapM s sys = do
sl <- liftIO$ explMembers s
for (U.toList sl) $ \ety -> do
x :: Stores s <- liftIO$ explGetUnsafe s ety
sys (ety,x)
class (SafeRW s ~ Stores s, Store s) => GlobalStore s where
class Cast a b where
cast :: a -> b
instance Cast (Entity a) (Entity b) where
cast (Entity ety) = Entity ety
instance Cast (Slice a) (Slice b) where
cast (Slice vec) = Slice vec
instance (Component a, Component b) => Component (a,b) where
type Storage (a, b) = (Storage a, Storage b)
instance (Has w a, Has w b) => Has w (a,b) where
getStore = (,) <$> getStore <*> getStore
instance (Store a, Store b) => Store (a,b) where
type InitArgs (a, b) = (InitArgs a, InitArgs b)
type Stores (a, b) = (Stores a, Stores b)
initStoreWith (aa, ab) = (,) <$> initStoreWith aa <*> initStoreWith ab
explMembers (sa,sb) = explMembers sa >>= U.filterM (explExists sb)
explReset (sa,sb) = explReset sa >> explReset sb
explDestroy (sa,sb) ety = explDestroy sa ety >> explDestroy sb ety
explExists (sa,sb) ety = (&&) <$> explExists sa ety <*> explExists sb ety
type SafeRW (a, b) = (SafeRW a, SafeRW b)
explGetUnsafe (sa,sb) ety = (,) <$> explGetUnsafe sa ety <*> explGetUnsafe sb ety
explGet (sa,sb) ety = (,) <$> explGet sa ety <*> explGet sb ety
explSet (sa,sb) ety (wa,wb) = explSet sa ety wa >> explSet sb ety wb
explSetMaybe (sa,sb) ety (wa,wb) = explSetMaybe sa ety wa >> explSetMaybe sb ety wb
instance (GlobalStore a, GlobalStore b) => GlobalStore (a,b) where
instance (Component a, Component b, Component c) => Component (a,b,c) where
type Storage (a, b, c) = (Storage a, Storage b, Storage c)
instance (Has w a, Has w b, Has w c) => Has w (a,b,c) where
getStore = (,,) <$> getStore <*> getStore <*> getStore
instance (Store a, Store b, Store c) => Store (a,b,c) where
type InitArgs (a, b, c) = (InitArgs a, InitArgs b, InitArgs c)
type Stores (a, b, c) = (Stores a, Stores b, Stores c)
initStoreWith (aa, ab, ac) = (,,) <$> initStoreWith aa <*> initStoreWith ab <*> initStoreWith ac
explMembers (sa,sb,sc) = explMembers sa >>= U.filterM (explExists sb) >>= U.filterM (explExists sc)
explReset (sa,sb,sc) = explReset sa >> explReset sb >> explReset sc
explDestroy (sa,sb,sc) ety = explDestroy sa ety >> explDestroy sb ety >> explDestroy sc ety
explExists (sa,sb,sc) ety = and <$> sequence [explExists sa ety, explExists sb ety, explExists sc ety]
type SafeRW (a, b, c) = (SafeRW a, SafeRW b, SafeRW c)
explGetUnsafe (sa,sb,sc) ety = (,,) <$> explGetUnsafe sa ety <*> explGetUnsafe sb ety <*> explGetUnsafe sc ety
explGet (sa,sb,sc) ety = (,,) <$> explGet sa ety <*> explGet sb ety <*> explGet sc ety
explSet (sa,sb,sc) ety (wa,wb,wc) = explSet sa ety wa >> explSet sb ety wb >> explSet sc ety wc
explSetMaybe (sa,sb,sc) ety (wa,wb,wc) = explSetMaybe sa ety wa >> explSetMaybe sb ety wb >> explSetMaybe sc ety wc
instance (GlobalStore a, GlobalStore b, GlobalStore c) => GlobalStore (a,b,c) where