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 Initializable (Storage c) => Component c where
type Storage c = s | s -> c
class Component c => Has w c where
getStore :: System w (Storage c)
class Initializable s where
type InitArgs s
initStoreWith :: InitArgs s -> IO s
class HasMembers s where
explDestroy :: s -> Int -> IO ()
explExists :: s -> Int -> IO Bool
explMembers :: s -> IO (U.Vector Int)
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
newtype Safe c = Safe {getSafe :: SafeRW (Storage c)}
class HasMembers s => Store s where
type SafeRW s
type Stores s
explGetUnsafe :: s -> Int -> IO (Stores s)
explGet :: s -> Int -> IO (SafeRW s)
explSet :: s -> Int -> Stores s -> IO ()
explSetMaybe :: s -> Int -> SafeRW s -> IO ()
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)
type IsRuntime c = (Store (Storage c), Stores (Storage c) ~ c)
class GlobalRW s c where
explGlobalRead :: s -> IO c
explGlobalWrite :: s -> c -> IO ()
explGlobalModify :: s -> (c -> c) -> IO ()
explGlobalModify s f = do r <- explGlobalRead s
explGlobalWrite s (f r)
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 (Initializable a, Initializable b) => Initializable (a,b) where
type InitArgs (a, b) = (InitArgs a, InitArgs b)
initStoreWith (aa, ab) = (,) <$> initStoreWith aa <*> initStoreWith ab
instance (HasMembers a, HasMembers b) => HasMembers (a,b) where
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
instance (Store a, Store b) => Store (a, b) where
type SafeRW (a, b) = (SafeRW a, SafeRW b)
type Stores (a, b) = (Stores a, Stores 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 (GlobalRW a ca, GlobalRW b cb) => GlobalRW (a,b) (ca,cb) where
explGlobalRead (sa,sb) = (,) <$> explGlobalRead sa <*> explGlobalRead sb
explGlobalWrite (sa,sb) (wa,wb) = explGlobalWrite sa wa >> explGlobalWrite sb wb
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 (Initializable a, Initializable b, Initializable c) => Initializable (a,b,c) where
type InitArgs (a, b, c) = (InitArgs a, InitArgs b, InitArgs c)
initStoreWith (aa, ab, ac) = (,,) <$> initStoreWith aa <*> initStoreWith ab <*> initStoreWith ac
instance (HasMembers a, HasMembers b, HasMembers c) => HasMembers (a,b,c) where
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]
instance (Store a, Store b, Store c) => Store (a, b, c) where
type SafeRW (a, b, c) = (SafeRW a, SafeRW b, SafeRW c)
type Stores (a, b, c) = (Stores a, Stores b, Stores 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 (GlobalRW a ca, GlobalRW b cb, GlobalRW c cc) => GlobalRW (a,b,c) (ca,cb,cc) where
explGlobalRead (sa,sb,sc) = (,,) <$> explGlobalRead sa <*> explGlobalRead sb <*> explGlobalRead sc
explGlobalWrite (sa,sb,sc) (wa,wb,wc) = explGlobalWrite sa wa >> explGlobalWrite sb wb >> explGlobalWrite sc wc