module Apecs.Core where
import Control.Monad.Reader
import Data.Functor.Identity
import qualified Data.Vector.Unboxed as U
import qualified Apecs.THTuples as T
newtype Entity = Entity Int deriving (Eq, Ord, Show)
newtype System w a = System {unSystem :: ReaderT w IO a} deriving (Functor, Monad, Applicative, MonadIO)
class (Elem (Storage c) ~ c, Store (Storage c)) => Component c where
type Storage c
class Component c => Has w c where
getStore :: System w (Storage c)
class Store s where
type Elem s
initStore :: IO s
explSet :: s -> Int -> Elem s -> IO ()
explGet :: s -> Int -> IO (Elem s)
explDestroy :: s -> Int -> IO ()
explMembers :: s -> IO (U.Vector Int)
explExists :: s -> Int -> IO Bool
explExists s n = do
mems <- explMembers s
return $ U.elem n mems
instance Component c => Component (Identity c) where
type Storage (Identity c) = Identity (Storage c)
instance Has w c => Has w (Identity c) where
getStore = Identity <$> getStore
instance Store s => Store (Identity s) where
type Elem (Identity s) = Identity (Elem s)
initStore = error "Initializing Pseudostore"
explGet (Identity s) e = Identity <$> explGet s e
explSet (Identity s) e (Identity x) = explSet s e x
explExists (Identity s) = explExists s
explMembers (Identity s) = explMembers s
explDestroy (Identity s) = explDestroy s
T.makeInstances [2..8]
data Not a = Not
newtype NotStore s = NotStore s
instance Component c => Component (Not c) where
type Storage (Not c) = NotStore (Storage c)
instance (Has w c) => Has w (Not c) where
getStore = NotStore <$> getStore
instance Store s => Store (NotStore s) where
type Elem (NotStore s) = Not (Elem s)
initStore = error "Initializing Pseudostore"
explGet _ _ = return Not
explSet (NotStore sa) ety _ = explDestroy sa ety
explExists (NotStore sa) ety = not <$> explExists sa ety
explMembers _ = return mempty
explDestroy sa ety = explSet sa ety Not
newtype MaybeStore s = MaybeStore s
instance Component c => Component (Maybe c) where
type Storage (Maybe c) = MaybeStore (Storage c)
instance (Has w c) => Has w (Maybe c) where
getStore = MaybeStore <$> getStore
instance Store s => Store (MaybeStore s) where
type Elem (MaybeStore s) = Maybe (Elem s)
initStore = error "Initializing Pseudostore"
explGet (MaybeStore sa) ety = do
e <- explExists sa ety
if e then Just <$> explGet sa ety
else return Nothing
explSet (MaybeStore sa) ety Nothing = explDestroy sa ety
explSet (MaybeStore sa) ety (Just x) = explSet sa ety x
explExists _ _ = return True
explMembers _ = return mempty
explDestroy (MaybeStore sa) ety = explDestroy sa ety
data EitherStore sp sq = EitherStore sp sq
instance (Component p, Component q) => Component (Either p q) where
type Storage (Either p q) = EitherStore (Storage p) (Storage q)
instance (Has w p, Has w q) => Has w (Either p q) where
getStore = EitherStore <$> getStore <*> getStore
instance (Store sp, Store sq) => Store (EitherStore sp sq) where
type Elem (EitherStore sp sq) = Either (Elem sp) (Elem sq)
initStore = error "Initializing Pseudostore"
explGet (EitherStore sp sq) ety = do
e <- explExists sp ety
if e then Left <$> explGet sp ety
else Right <$> explGet sq ety
explSet (EitherStore sp _) ety (Left p) = explSet sp ety p
explSet (EitherStore _ sq) ety (Right q) = explSet sq ety q
explExists (EitherStore sp sq) ety = do
e <- explExists sp ety
if e then return True
else explExists sq ety
explMembers _ = return mempty
explDestroy _ _ = return ()
data Filter c = Filter deriving (Eq, Show)
newtype FilterStore s = FilterStore s
instance Component c => Component (Filter c) where
type Storage (Filter c) = FilterStore (Storage c)
instance Has w c => Has w (Filter c) where
getStore = FilterStore <$> getStore
instance Store s => Store (FilterStore s) where
type Elem (FilterStore s) = Filter (Elem s)
initStore = error "Initializing Pseudostore"
explGet _ _ = return Filter
explSet _ _ _ = return ()
explExists (FilterStore s) ety = explExists s ety
explMembers (FilterStore s) = explMembers s
explDestroy _ _ = return ()
data EntityStore = EntityStore
instance Component Entity where
type Storage Entity = EntityStore
instance (Has w Entity) where
getStore = return EntityStore
instance Store EntityStore where
type Elem EntityStore = Entity
initStore = error "Initializing Pseudostore"
explGet _ ety = return $ Entity ety
explSet _ _ _ = liftIO$ putStrLn "Warning: Writing Entity is undefined"
explExists _ _ = return True
explMembers _ = return mempty
explDestroy _ _ = return ()