packages feed

apecs 0.1.1.0 → 0.2.0.0

raw patch · 11 files changed

+558/−511 lines, 11 filesdep ~sdl2

Dependency ranges changed: sdl2

Files

README.md view
@@ -20,7 +20,7 @@ import Apecs import Apecs.Stores import Apecs.Util-import Linear.V2+import Linear  -- Component data definitions newtype Velocity = Velocity (V2 Double) deriving (Eq, Show)@@ -58,7 +58,7 @@ game :: System' () game = do   -- Create new entities-  newEntity (Position 0)+  ety <- newEntity (Position 0)   -- Components can be composed using tuples   newEntity (Position 0, Velocity 1)   -- Tagging one as an enemy is a matter of adding the constructor@@ -68,6 +68,9 @@   liftIO$ putStrLn "Stepping velocities"   -- rmap maps a pure function over all entities in its domain   rmap $ \(Position p, Velocity v) -> Position (v+p)++  -- Set can be used to (over)write components+  set ety (Position 2, Enemy)    -- Print the positions of all enemies   cmapM_ $ \(Enemy, Position p) -> liftIO (print p)
apecs.cabal view
@@ -1,5 +1,5 @@ name:                apecs-version:             0.1.1.0+version:             0.2.0.0 homepage:            https://github.com/jonascarpay/apecs#readme license:             BSD3 license-file:        LICENSE@@ -17,10 +17,11 @@     src   exposed-modules:     Apecs,+    Apecs.Types,     Apecs.Stores,+    Apecs.System,+    Apecs.Slice,     Apecs.Util-  other-modules:-    Apecs.Core   default-language:     Haskell2010   build-depends:@@ -43,7 +44,6 @@   default-language:     Haskell2010   ghc-options:-    -Wall     -fno-warn-unused-top-binds  executable rts@@ -52,11 +52,14 @@   main-is:     RTS.hs   build-depends:-    base, apecs, sdl2, random, linear+    base,+    apecs,+    sdl2 >= 2.3.0,+    random,+    linear   default-language:     Haskell2010   ghc-options:-    -Wall     -Odph     -fno-warn-unused-top-binds
example/RTS.hs view
@@ -84,6 +84,7 @@     liftIO$ SDL.rendererDrawColor renderer $= if e then V4 255 255 255 255 else V4 255 0 0 255     SDL.drawPoint renderer (P (round <$> p)) +  liftIO$ SDL.rendererDrawColor renderer $= V4 255 255 255 255   r <- readGlobal   case r of     Dragging a b -> SDL.drawRect renderer (Just $ SDL.Rectangle (P (round <$> a)) (round <$> b-a))
src/Apecs.hs view
@@ -1,30 +1,41 @@ {-# LANGUAGE FlexibleContexts #-}  module Apecs (-  -- Core-    System(..), runSystem, runWith,-    Component(..), Entity, Slice, Has(..), Safe(..), cast,+  -- * Types+    System(..),+    Component(..), Entity(..), Slice, Has(..), Safe(..), cast, -    -- Initializable+  -- * Initializable     initStoreWith, -    -- HasMembers+  -- * HasMembers wrapper functions     destroy, exists, owners, resetStore, -    -- Store-    get, set, setMaybe, modify,+  -- * Store wrapper functions+    get, set, setOrDelete, modify,     cmap, cmapM, cmapM_, cimapM, cimapM_,-    sliceSize,+    rmap', rmap, wmap, wmap', cmap', -    -- GlobalRW++  -- * GlobalRW wrapper functions     readGlobal, writeGlobal, modifyGlobal, -    -- Query+  -- * Query     slice, All(..), +  -- * Other+    runSystem, runWith,++  -- All slice functions+  module SL,+   -- Reader   asks, ask, liftIO, lift, ) where -import Apecs.Core as A import Control.Monad.Reader (asks, ask, liftIO, lift)++import Apecs.Types+import Apecs.System+import Apecs.Slice as SL+
− src/Apecs/Core.hs 
@@ -1,377 +0,0 @@-{-# LANGUAGE Strict #-}-{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}-{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}-{-# LANGUAGE ConstraintKinds, KindSignatures #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Apecs.Core where--import Control.Monad.Reader-import Data.Traversable (for)-import qualified Data.Vector.Unboxed as U---- | A component is defined by the type of its storage---   The storage in turn supplies runtime types for the component.-class Initializable (Storage c) => Component c where-  type Storage c = s | s -> c--type ID    = Int-type IDVec = U.Vector ID-newtype System w a = System {unSystem :: ReaderT w IO a} deriving (Functor, Monad, Applicative, MonadIO)-newtype Slice  c = Slice  {unSlice  :: U.Vector ID} deriving (Show, Monoid)-newtype Entity c = Entity {unEntity :: ID} deriving (Eq, Num)--{-# 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---- Storage type class hierarchy--- | Common for every storage. Represents a container that can be initialized-class Initializable s where-  type InitArgs s-  initStoreWith :: InitArgs s -> IO s---- | A store that is indexed by entities-class HasMembers s where-  explDestroy :: s -> Int -> IO ()-  explExists  :: s -> Int -> IO Bool-  explMembers :: s -> IO (U.Vector Int)--  {-# INLINE explReset #-}-  explReset :: s -> IO ()-  explReset s = do-    sl <- explMembers s-    U.mapM_ (explDestroy s) sl--  explImapM_ :: MonadIO m => s -> (Int -> m a) -> m ()-  {-# INLINE explImapM_ #-}-  explImapM_ s ma = liftIO (explMembers s) >>= Prelude.mapM_ ma . U.toList--  explImapM :: MonadIO m => s -> (Int -> m a) -> m [a]-  {-# INLINE explImapM #-}-  explImapM s ma = liftIO (explMembers s) >>= Prelude.mapM ma . U.toList--{-# INLINE imapM_ #-}--- | Monadically iterate a system over all entities that have that component.---   Note that writing to the store while iterating over it is undefined behaviour.-imapM_ :: forall w c. (Has w c, HasMembers (Storage c))-       => (Entity c -> System w ()) -> System w ()-imapM_ sys = do s :: Storage c <- getStore-                explImapM_ s (sys . Entity)--{-# INLINE imapM #-}--- | Monadically iterate a system over all entities that have that component.---   Note that writing to the store while iterating over it is undefined behaviour.-imapM :: forall w c a. (Has w c, HasMembers (Storage c))-      => (Entity c -> System w a) -> System w [a]-imapM sys = do s :: Storage c <- getStore-               explImapM s (sys . Entity)---- | Destroys the component @c@ for the given entity-{-# INLINE destroy #-}-destroy :: forall w c. (Has w c, HasMembers (Storage c)) => Entity c -> System w ()-destroy (Entity n) = do s :: Storage c <- getStore-                        liftIO$ explDestroy s n---- | Returns whether the given entity has component @c@---   For composite components, this indicates whether the component---   has all its constituents-{-# INLINE exists #-}-exists :: forall w c. (Has w c, HasMembers (Storage c)) => Entity c -> System w Bool-exists (Entity n) = do s :: Storage c <- getStore-                       liftIO$ explExists s n---- | A slice containing all entities with component @c@-{-# INLINE owners #-}-owners :: forall w c. (Has w c, HasMembers (Storage c)) => System w (Slice c)-owners = do s :: Storage c <- getStore-            liftIO$ Slice <$> explMembers s--resetStore :: forall w c p. (Has w c, HasMembers (Storage c)) => p c -> System w ()-resetStore _ = do s :: Storage c <- getStore-                  liftIO$ explReset s---- | Class of storages that associates components with entities.-class HasMembers s => Store s where-  type SafeRW s -- ^ Return type for safe reads/writes to the store-  type Stores s -- ^ The type of components stored by this Store-  -- | Unsafe index to the store. Undefined if the component does not exist-  explGetUnsafe :: s -> Int -> IO (Stores s)-  -- | Retrieves a component from the store-  explGet       :: s -> Int -> IO (SafeRW s)-  -- | Writes a component-  explSet       :: s -> Int -> Stores s -> IO ()-  -- | Either writes or deletes a component-  explSetMaybe  :: s -> Int -> SafeRW s -> IO ()--  -- | Modifies an element in the store.-  {-# INLINE explModify #-}-  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--  -- | Maps over all elements of this store.-  --   The default implementation can be replaced by an optimized one-  explCmap :: s -> (Stores s -> Stores s) -> IO ()-  {-# INLINE explCmap #-}-  explCmap s f = do-    sl <- explMembers s-    U.forM_ sl $ \ety -> do-      x :: Stores s <- explGetUnsafe s ety-      explSet s ety (f x)--  explCmapM_ :: MonadIO m => s -> (Stores s -> m a) -> m ()-  {-# INLINE explCmapM_ #-}-  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 ()-  {-# INLINE explCimapM_ #-}-  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]-  {-# INLINE explCmapM #-}-  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]-  {-# INLINE explCimapM #-}-  explCimapM s sys = do-    sl <- liftIO$ explMembers s-    for (U.toList sl) $ \ety -> do-      x :: Stores s <- liftIO$ explGetUnsafe s ety-      sys (ety,x)---- | A constraint that indicates that the runtime representation of @c@ is @c@-type Runtime c = Stores (Storage c)-type IsRuntime c = (Store (Storage c), Runtime c ~ c)-newtype Safe c = Safe {getSafe :: (SafeRW (Storage c))}---- Setting/Getting-{-# INLINE get #-}-get :: forall w c. (Store (Storage c), Has w c) => Entity c -> System w (Safe c)-get (Entity ety) = do s :: Storage c <- getStore-                      liftIO$ Safe <$> explGet s ety--{-# INLINE set #-}-set :: forall w c e. (Store (Storage c), Stores (Storage c) ~ c, Has w c) => Entity e -> c -> System w ()-set (Entity ety) x = do-  s :: Storage c <- getStore-  liftIO$ explSet s ety x--{-# INLINE modify #-}-modify :: forall w c. (IsRuntime c, Has w c) => Entity c -> (c -> c) -> System w ()-modify (Entity ety) f = do-  s :: Storage c <- getStore-  liftIO$ explModify s ety f--setMaybe :: forall w c. (IsRuntime c, Has w c) => Entity c -> Safe c -> System w ()-setMaybe (Entity ety) (Safe c) = do-  s :: Storage c <- getStore-  liftIO$ explSetMaybe s ety c--{-# INLINE cmap #-}-cmap :: forall world c. (IsRuntime c, Has world c) => (c -> c) -> System world ()-cmap f = do s :: Storage c <- getStore-            liftIO$ explCmap s f--{-# INLINE cmapM_ #-}-cmapM_ :: forall w c. (Has w c, IsRuntime c)-       => (c -> System w ()) -> System w ()-cmapM_ sys = do s :: Storage c <- getStore-                explCmapM_ s sys--{-# INLINE cimapM_ #-}-cimapM_ :: forall w c. (Has w c, IsRuntime c)-        => ((Entity c, c) -> System w ()) -> System w ()-cimapM_ sys = do s :: Storage c <- getStore-                 explCimapM_ s (\(e,c) -> sys (Entity e,c))--{-# INLINE cmapM #-}-cmapM :: forall w c a. (Has w c, IsRuntime c)-      => (c -> System w a) -> System w [a]-cmapM sys = do s :: Storage c <- getStore-               explCmapM s sys--{-# INLINE cimapM #-}-cimapM :: forall w c a. (Has w c, IsRuntime c)-       => ((Entity c, c) -> System w a) -> System w [a]-cimapM sys = do s :: Storage c <- getStore-                explCimapM s (\(e,c) -> sys (Entity e,c))---- | Class of storages for global values-class GlobalRW s c where-  {-# MINIMAL explGlobalRead, explGlobalWrite #-}-  explGlobalRead :: s -> IO c-  explGlobalWrite :: s -> c -> IO ()--  {-# INLINE explGlobalModify #-}-  explGlobalModify :: s -> (c -> c) -> IO ()-  explGlobalModify s f = do r <- explGlobalRead s-                            explGlobalWrite s (f r)--{-# INLINE readGlobal #-}-readGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => System w c-readGlobal = do s :: Storage c <- getStore-                liftIO$ explGlobalRead s--{-# INLINE writeGlobal #-}-writeGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => c -> System w ()-writeGlobal c = do s :: Storage c <- getStore-                   liftIO$ explGlobalWrite s c--{-# INLINE modifyGlobal #-}-modifyGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => (c -> c) -> System w ()-modifyGlobal f = do s :: Storage c <- getStore-                    liftIO$ explGlobalModify s f---- Query-class Query q s where-  explSlice :: s -> q -> IO (U.Vector Int)--{-# INLINE slice #-}-slice :: forall w c q. (Query q (Storage c), Has w c) => q -> System w (Slice c)-slice q = do-  s :: Storage c <- getStore-  liftIO$ Slice <$> explSlice s q--data All = All-instance HasMembers s => Query All s where-  {-# INLINE explSlice #-}-  explSlice s _ = explMembers s--class Cast a b where cast :: a -> b-instance Cast (Entity a) (Entity b) where-  {-# INLINE cast #-}-  cast (Entity ety) = Entity ety-instance Cast (Slice a) (Slice b) where-  {-# INLINE cast #-}-  cast (Slice vec) = Slice vec--class Component c => Has w c where-  getStore :: System w (Storage c)--instance Show (Entity c) where-  show (Entity e) = "Entity " ++ show e--{-# INLINE sliceFoldM_ #-}-sliceFoldM_ :: (a -> Entity c -> System w a) -> a -> Slice b -> System w ()-sliceFoldM_ f seed (Slice sl) = U.foldM'_ ((.Entity) . f) seed sl---- | Gets the size of a slice (O(n))-{-# INLINE sliceSize #-}-sliceSize :: Slice a -> Int-sliceSize (Slice vec) = U.length vec---- | Tests whether a slice is empty (O(1))-{-# INLINE sliceNull #-}-sliceNull :: Slice a -> Bool-sliceNull (Slice vec) = U.null vec---- | Construct a slice from a list of IDs-{-# INLINE sliceFromList #-}-sliceFromList :: [ID] -> Slice a-sliceFromList = Slice . U.fromList---- | Monadically filter a slice-{-# INLINE sliceFilterM #-}-sliceFilterM :: (Entity c -> System w Bool) -> Slice c -> System w (Slice c)-sliceFilterM fm (Slice vec) = Slice <$> U.filterM (fm . Entity) vec--{-# INLINE sliceConcat #-}-sliceConcat :: Slice a -> Slice b -> Slice c-sliceConcat (Slice a) (Slice b) = Slice (a U.++ b)----- Tuple instances--- (,)-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-  {-# INLINE getStore #-}-  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-  {-# INLINE explMembers #-}-  {-# INLINE explReset #-}-  {-# INLINE explDestroy #-}-  {-# INLINE explExists #-}--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-  {-# INLINE explGetUnsafe #-}-  {-# INLINE explGet #-}-  {-# INLINE explSet #-}-  {-# INLINE explSetMaybe #-}--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-  {-# INLINE explGlobalRead #-}-  {-# INLINE explGlobalWrite #-}---- (,,)-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-  {-# INLINE getStore #-}-  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]-  {-# INLINE explMembers #-}-  {-# INLINE explReset #-}-  {-# INLINE explDestroy #-}-  {-# INLINE explExists #-}--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-  {-# INLINE explGetUnsafe #-}-  {-# INLINE explGet #-}-  {-# INLINE explSet #-}-  {-# INLINE explSetMaybe #-}--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-  {-# INLINE explGlobalRead #-}-  {-# INLINE explGlobalWrite #-}
+ src/Apecs/Slice.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}++module Apecs.Slice where++import qualified Data.Vector.Unboxed as U+import Data.Traversable (for)+import Control.Monad.IO.Class++import Apecs.Types++{-# INLINE sliceFoldM_ #-}+sliceFoldM_ :: (a -> Entity c -> System w a) -> a -> Slice b -> System w ()+sliceFoldM_ f seed (Slice sl) = U.foldM'_ ((.Entity) . f) seed sl++-- | Gets the size of a slice (O(n))+{-# INLINE sliceSize #-}+sliceSize :: Slice a -> Int+sliceSize (Slice vec) = U.length vec++-- | Tests whether a slice is empty (O(1))+{-# INLINE sliceNull #-}+sliceNull :: Slice a -> Bool+sliceNull (Slice vec) = U.null vec++-- | Construct a slice from a list of IDs+{-# INLINE sliceFromList #-}+sliceFromList :: [Int] -> Slice a+sliceFromList = Slice . U.fromList++-- | Monadically filter a slice+{-# INLINE sliceFilterM #-}+sliceFilterM :: (Entity c -> System w Bool) -> Slice c -> System w (Slice c)+sliceFilterM fm (Slice vec) = Slice <$> U.filterM (fm . Entity) vec++{-# INLINE sliceConcat #-}+sliceConcat :: Slice a -> Slice b -> Slice c+sliceConcat (Slice a) (Slice b) = Slice (a U.++ b)+-- Slice traversal+{-# INLINE sliceForM_ #-}+sliceForM_ :: Monad m => Slice c -> (Entity c -> m b) -> m ()+sliceForM_ (Slice vec) ma = U.forM_ vec (ma . Entity)++{-# INLINE sliceForM #-}+sliceForM :: Monad m => Slice c -> (Entity c -> m a) -> m [a]+sliceForM (Slice vec) ma = traverse (ma . Entity) (U.toList vec)++{-# INLINE sliceForMC #-}+sliceForMC :: forall w c a. (Store (Storage c), Has w c) => Slice c -> ((Entity c,Safe c) -> System w a) -> System w [a]+sliceForMC (Slice vec) sys = do+  s :: Storage c <- getStore+  for (U.toList vec) $ \e -> do+    r <- liftIO$ explGet s e+    sys (Entity e, Safe r)++{-# INLINE sliceForMC_ #-}+sliceForMC_ :: forall w c a. (Store (Storage c), Has w c) => Slice c -> ((Entity c,Safe c) -> System w a) -> System w ()+sliceForMC_ (Slice vec) sys = do+  s :: Storage c <- getStore+  U.forM_ vec $ \e -> do+    r <- liftIO$ explGet s e+    sys (Entity e, Safe r)++{-# INLINE sliceMapM_ #-}+sliceMapM_ :: Monad m => (Entity c -> m a) -> Slice c -> m ()+sliceMapM_ ma (Slice vec) = U.mapM_ (ma . Entity) vec++{-# INLINE sliceMapM #-}+sliceMapM :: Monad m => (Entity c -> m a) -> Slice c -> m [a]+sliceMapM ma (Slice vec) = traverse (ma . Entity) (U.toList vec)++{-# INLINE sliceMapMC #-}+sliceMapMC :: forall w c a. (Store (Storage c), Has w c) => ((Entity c,Safe c) -> System w a) -> Slice c -> System w [a]+sliceMapMC sys (Slice vec) = do+  s :: Storage c <- getStore+  for (U.toList vec) $ \e -> do+    r <- liftIO$ explGet s e+    sys (Entity e, Safe r)++{-# INLINE sliceMapMC_ #-}+sliceMapMC_ :: forall w c a. (Store (Storage c), Has w c) => ((Entity c, Safe c) -> System w a) -> Slice c -> System w ()+sliceMapMC_ sys vec = sliceForMC_ vec sys+
src/Apecs/Stores.hs view
@@ -9,7 +9,7 @@  module Apecs.Stores   ( Map, Set, Flag(..), Cache,-    Global, readGlobal, writeGlobal,+    Global,     IndexTable, ToIndex(..), ByIndex(..), ByComponent(..),   ) where @@ -25,7 +25,7 @@ import GHC.TypeLits import Data.Proxy -import Apecs.Core+import Apecs.Types  newtype Map c = Map (IORef (M.IntMap c)) instance Initializable (Map c) where@@ -319,7 +319,7 @@     let indexNew = toIndex x     mc <- explGet s ety     case mc of-      Nothing -> do VM.modify tab (S.insert ety) indexNew+      Nothing -> VM.modify tab (S.insert ety) indexNew       Just c  -> do let indexOld = toIndex c                     unless (indexOld == indexNew) $ do                       VM.modify tab (S.delete ety) indexOld
+ src/Apecs/System.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE Strict #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ConstraintKinds #-}++module Apecs.System where++import Control.Monad.Reader+import qualified Data.Vector.Unboxed as U++import Apecs.Types++-- | Run a system with a game world+{-# INLINE runSystem #-}+runSystem :: System w a -> w -> IO a+runSystem sys = runReaderT (unSystem sys)++-- | Run a system with a game world+{-# INLINE runWith #-}+runWith :: w -> System w a -> IO a+runWith = flip runSystem++-- | A slice containing all entities with component @c@+{-# INLINE owners #-}+owners :: forall w c. (Has w c, HasMembers (Storage c)) => System w (Slice c)+owners = do s :: Storage c <- getStore+            liftIO$ Slice <$> explMembers s++-- | Returns whether the given entity has component @c@+--   For composite components, this indicates whether the component+--   has all its constituents+{-# INLINE exists #-}+exists :: forall w c. (Has w c, HasMembers (Storage c)) => Entity c -> System w Bool+exists (Entity n) = do s :: Storage c <- getStore+                       liftIO$ explExists s n++-- | Destroys the component @c@ for the given entity+{-# INLINE destroy #-}+destroy :: forall w c. (Has w c, HasMembers (Storage c)) => Entity c -> System w ()+destroy (Entity n) = do s :: Storage c <- getStore+                        liftIO$ explDestroy s n++-- | Removes all components. Equivalent to manually iterating and deleting, but usually optimized.+resetStore :: forall w c p. (Has w c, HasMembers (Storage c)) => p c -> System w ()+resetStore _ = do s :: Storage c <- getStore+                  liftIO$ explReset s++-- Setting/Getting+-- | Gets the component for a given entity.+--   This is a safe access, because the entity might not have the requested components.+{-# INLINE get #-}+get :: forall w c. (Store (Storage c), Has w c) => Entity c -> System w (Safe c)+get (Entity ety) = do s :: Storage c <- getStore+                      liftIO$ Safe <$> explGet s ety++-- | Writes a component to a given entity. Will overwrite existing components.+{-# INLINE set #-}+set :: forall w c e. (Store (Storage c), Stores (Storage c) ~ c, Has w c) => Entity e -> c -> System w ()+set (Entity ety) x = do+  s :: Storage c <- getStore+  liftIO$ explSet s ety x++-- | Same as @set@, but uses Safe to possibly delete a component+setOrDelete :: forall w c. (IsRuntime c, Has w c) => Entity c -> Safe c -> System w ()+setOrDelete (Entity ety) (Safe c) = do+  s :: Storage c <- getStore+  liftIO$ explSetMaybe s ety c++-- | Applies a function if possible. Equivalent to reading, mapping, and writing, but stores can provide optimized implementations.+{-# INLINE modify #-}+modify :: forall w c. (IsRuntime c, Has w c) => Entity c -> (c -> c) -> System w ()+modify (Entity ety) f = do+  s :: Storage c <- getStore+  liftIO$ explModify s ety f++{-# INLINE imapM_ #-}+-- | Monadically iterate a system over all entities that have that component.+--   Note that writing to the store while iterating over it is undefined behaviour.+imapM_ :: forall w c. (Has w c, HasMembers (Storage c))+       => (Entity c -> System w ()) -> System w ()+imapM_ sys = do s :: Storage c <- getStore+                explImapM_ s (sys . Entity)++{-# INLINE imapM #-}+-- | Monadically iterate a system over all entities that have that component.+--   Note that writing to the store while iterating over it is undefined behaviour.+imapM :: forall w c a. (Has w c, HasMembers (Storage c))+      => (Entity c -> System w a) -> System w [a]+imapM sys = do s :: Storage c <- getStore+               explImapM s (sys . Entity)++{-# INLINE cmap #-}+cmap :: forall world c. (IsRuntime c, Has world c) => (c -> c) -> System world ()+cmap f = do s :: Storage c <- getStore+            liftIO$ explCmap s f++{-# INLINE cmapM_ #-}+cmapM_ :: forall w c. (Has w c, IsRuntime c)+       => (c -> System w ()) -> System w ()+cmapM_ sys = do s :: Storage c <- getStore+                explCmapM_ s sys++{-# INLINE cimapM_ #-}+cimapM_ :: forall w c. (Has w c, IsRuntime c)+        => ((Entity c, c) -> System w ()) -> System w ()+cimapM_ sys = do s :: Storage c <- getStore+                 explCimapM_ s (\(e,c) -> sys (Entity e,c))++{-# INLINE cmapM #-}+cmapM :: forall w c a. (Has w c, IsRuntime c)+      => (c -> System w a) -> System w [a]+cmapM sys = do s :: Storage c <- getStore+               explCmapM s sys++{-# INLINE cimapM #-}+cimapM :: forall w c a. (Has w c, IsRuntime c)+       => ((Entity c, c) -> System w a) -> System w [a]+cimapM sys = do s :: Storage c <- getStore+                explCimapM s (\(e,c) -> sys (Entity e,c))++cmap' :: forall world c. (Has world c, IsRuntime c)+      => (c -> Safe c) -> System world ()+cmap' f = do s :: Storage c <- getStore+             liftIO$ do sl <- explMembers s+                        U.forM_ sl $ \e -> do+                          r <- explGetUnsafe s e+                          explSetMaybe s e (getSafe . f $ r)++-- | Maps a function over all entities with a @r@, and writes their @w@+{-# INLINE rmap #-}+rmap :: forall world r w. (Has world w, Has world r, IsRuntime w, IsRuntime r)+      => (r -> w) -> System world ()+rmap f = do sr :: Storage r <- getStore+            sc :: Storage w <- getStore+            liftIO$ do sl <- explMembers sr+                       U.forM_ sl $ \ e -> do+                          r <- explGetUnsafe sr e+                          explSet sc e (f r)++-- | Maps a function over all entities with a @r@, and writes or deletes their @w@+{-# INLINE rmap' #-}+rmap' :: forall world r w. (Has world w, Has world r, Store (Storage w), IsRuntime r)+      => (r -> Safe w) -> System world ()+rmap' f = do sr :: Storage r <- getStore+             sw :: Storage w <- getStore+             liftIO$ do sl <- explMembers sr+                        U.forM_ sl $ \ e -> do+                           r <- explGetUnsafe sr e+                           explSetMaybe sw e (getSafe $ f r)++-- | For all entities with a @w@, this map reads their @r@ and writes their @w@+{-# INLINE wmap #-}+wmap :: forall world r w. (Has world w, Has world r, IsRuntime w, IsRuntime r)+     => (Safe r -> w) -> System world ()+wmap f = do sr :: Storage r <- getStore+            sw :: Storage w <- getStore+            liftIO$ do sl <- explMembers sr+                       U.forM_ sl $ \ e -> do+                         r <- explGet sr e+                         explSet sw e (f . Safe $ r)++-- | For all entities with a @w@, this map reads their @r@ and writes or deletes their @w@+{-# INLINE wmap' #-}+wmap' :: forall world r w. (Has world w, Has world r, Store (Storage w), IsRuntime r)+      => (Safe r -> Safe w) -> System world ()+wmap' f = do sr :: Storage r <- getStore+             sw :: Storage w <- getStore+             liftIO$ do sl <- explMembers sr+                        U.forM_ sl $ \ e -> do+                          r <- explGet sr e+                          explSetMaybe sw e (getSafe . f . Safe $ r)+++{-# INLINE slice #-}+slice :: forall w c q. (Query q (Storage c), Has w c) => q -> System w (Slice c)+slice q = do+  s :: Storage c <- getStore+  liftIO$ Slice <$> explSlice s q++{-# INLINE readGlobal #-}+readGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => System w c+readGlobal = do s :: Storage c <- getStore+                liftIO$ explGlobalRead s++{-# INLINE writeGlobal #-}+writeGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => c -> System w ()+writeGlobal c = do s :: Storage c <- getStore+                   liftIO$ explGlobalWrite s c++{-# INLINE modifyGlobal #-}+modifyGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => (c -> c) -> System w ()+modifyGlobal f = do s :: Storage c <- getStore+                    liftIO$ explGlobalModify s f+
+ src/Apecs/Types.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}+{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Apecs.Types where++import Control.Monad.Reader+import Data.Traversable (for)+import qualified Data.Vector.Unboxed as U++-- | An Entity is really just an Int. The type variable is used to keep track of reads and writes, but can be freely cast.+newtype Entity c = Entity {unEntity :: Int} deriving (Eq, Ord, Show)++-- | A slice is a list of entities, represented by a Data.Unbox.Vector of Ints.+newtype Slice c = Slice {unSlice :: U.Vector Int} deriving (Show, Monoid)++-- | A system is a newtype around `ReaderT w IO a`, where `w` is the game world variable.+newtype System w a = System {unSystem :: ReaderT w IO a} deriving (Functor, Monad, Applicative, MonadIO)++-- | A component is defined by the type of its storage+--   The storage in turn supplies runtime types for the component.+--   For the component to be valid, its Storage must be in instance of Initializable.+class Initializable (Storage c) => Component c where+  type Storage c = s | s -> c++-- | A world `Has` a component if it can produce its Storage+class Component c => Has w c where+  getStore :: System w (Storage c)+++-- Storage types+-- | Common for every storage. Represents a container that can be initialized.+class Initializable s where+  type InitArgs s+  initStoreWith :: InitArgs s -> IO s++-- | A store that is indexed by entities.+class HasMembers s where+  -- | Destroys the component for the given index.+  explDestroy :: s -> Int -> IO ()+  -- | Returns whether there is a component for the given index+  explExists  :: s -> Int -> IO Bool+  -- | Returns an unboxed vector of member indices+  explMembers :: s -> IO (U.Vector Int)++  -- | Removes all components. Default implementation iterates over members and calls explDestroy.+  {-# INLINE explReset #-}+  explReset :: s -> IO ()+  explReset s = do+    sl <- explMembers s+    U.mapM_ (explDestroy s) sl++  -- | Monadically iterates over member indices+  explImapM_ :: MonadIO m => s -> (Int -> m a) -> m ()+  {-# INLINE explImapM_ #-}+  explImapM_ s ma = liftIO (explMembers s) >>= mapM_ ma . U.toList++  -- | Monadically iterates over member indices+  explImapM :: MonadIO m => s -> (Int -> m a) -> m [a]+  {-# INLINE explImapM #-}+  explImapM s ma = liftIO (explMembers s) >>= mapM ma . U.toList++-- | Represents a safe access to @c@. A safe access is either a read that might fail, or a write that might delete.+newtype Safe c = Safe {getSafe :: SafeRW (Storage c)}++-- | Class of storages that associates components with entities.+class HasMembers s => Store s where+  type SafeRW s -- ^ Return type for safe reads/writes to the store+  type Stores s -- ^ The type of components stored by this Store+  -- | Unsafe index to the store. Undefined if the component does not exist+  explGetUnsafe :: s -> Int -> IO (Stores s)+  -- | Retrieves a component from the store+  explGet       :: s -> Int -> IO (SafeRW s)+  -- | Writes a component+  explSet       :: s -> Int -> Stores s -> IO ()+  -- | Either writes or deletes a component+  explSetMaybe  :: s -> Int -> SafeRW s -> IO ()++  -- | Modifies an element in the store.+  {-# INLINE explModify #-}+  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++  -- | Maps over all elements of this store.+  --   The default implementation can be replaced by an optimized one+  explCmap :: s -> (Stores s -> Stores s) -> IO ()+  {-# INLINE explCmap #-}+  explCmap s f = explMembers s >>= U.mapM_ (\ety -> explModify s ety f)++  explCmapM_ :: MonadIO m => s -> (Stores s -> m a) -> m ()+  {-# INLINE explCmapM_ #-}+  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 ()+  {-# INLINE explCimapM_ #-}+  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]+  {-# INLINE explCmapM #-}+  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]+  {-# INLINE explCimapM #-}+  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 Runtime c = Stores (Storage c)+-- | A constraint that indicates that the runtime representation of @c@ is @c@+type IsRuntime c = (Store (Storage c), Runtime c ~ c)+-- | Class of storages for global values+class GlobalRW s c where+  {-# MINIMAL explGlobalRead, explGlobalWrite #-}+  explGlobalRead :: s -> IO c+  explGlobalWrite :: s -> c -> IO ()++  {-# INLINE explGlobalModify #-}+  explGlobalModify :: s -> (c -> c) -> IO ()+  explGlobalModify s f = do r <- explGlobalRead s+                            explGlobalWrite s (f r)++-- Query+class Query q s where+  explSlice :: s -> q -> IO (U.Vector Int)++data All = All+instance HasMembers s => Query All s where+  {-# INLINE explSlice #-}+  explSlice s _ = explMembers s++class Cast a b where cast :: a -> b+instance Cast (Entity a) (Entity b) where+  {-# INLINE cast #-}+  cast (Entity ety) = Entity ety+instance Cast (Slice a) (Slice b) where+  {-# INLINE cast #-}+  cast (Slice vec) = Slice vec++-- Tuple Instances+-- (,)+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+  {-# INLINE getStore #-}+  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+  {-# INLINE explMembers #-}+  {-# INLINE explReset #-}+  {-# INLINE explDestroy #-}+  {-# INLINE explExists #-}++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+  {-# INLINE explGetUnsafe #-}+  {-# INLINE explGet #-}+  {-# INLINE explSet #-}+  {-# INLINE explSetMaybe #-}++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+  {-# INLINE explGlobalRead #-}+  {-# INLINE explGlobalWrite #-}++-- (,,)+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+  {-# INLINE getStore #-}+  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]+  {-# INLINE explMembers #-}+  {-# INLINE explReset #-}+  {-# INLINE explDestroy #-}+  {-# INLINE explExists #-}++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+  {-# INLINE explGetUnsafe #-}+  {-# INLINE explGet #-}+  {-# INLINE explSet #-}+  {-# INLINE explSetMaybe #-}++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+  {-# INLINE explGlobalRead #-}+  {-# INLINE explGlobalWrite #-}
src/Apecs/Util.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE Strict, ScopedTypeVariables, TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Apecs.Util (   -- * Utility@@ -11,13 +12,6 @@   -- * Spatial hashing   quantize, flatten, region, inbounds, -  -- * Optimized maps-  rmap', rmap, wmap, wmap', cmap',--  -- * Slice interation-  sliceForM, sliceForM_, sliceForMC, sliceForMC_,-  sliceMapM, sliceMapM_, sliceMapMC, sliceMapMC_,-   -- * Timing   timeSystem, timeSystem_, @@ -26,18 +20,17 @@ import System.Mem (performMajorGC) import Control.Monad.Reader (liftIO) import Control.Applicative (liftA2)-import qualified Data.Vector.Unboxed as U-import Data.Traversable (for) import System.CPUTime -import Apecs.Core+import Apecs.Types import Apecs.Stores+import Apecs.System  -- | Initializes a store with (), useful since most stores have () as their initialization argument initStore :: (Initializable s, InitArgs s ~ ()) => IO s initStore = initStoreWith () -newtype EntityCounter = EntityCounter Int+newtype EntityCounter = EntityCounter Int deriving (Num, Eq, Show) instance Component EntityCounter where   type Storage EntityCounter = Global EntityCounter @@ -63,104 +56,6 @@ newtype ConcatQueries q = ConcatQueries [q] instance Query q s => Query (ConcatQueries q) s where   explSlice s (ConcatQueries qs) = mconcat <$> traverse (explSlice s) qs--cmap' :: forall world c. (Has world c, IsRuntime c)-      => (c -> Safe c) -> System world ()-cmap' f = do s :: Storage c <- getStore-             liftIO$ do sl <- explMembers s-                        U.forM_ sl $ \e -> do-                          r <- explGetUnsafe s e-                          explSetMaybe s e (getSafe . f $ r)---- | Maps a function over all entities with a @r@, and writes their @w@-{-# INLINE rmap #-}-rmap :: forall world r w. (Has world w, Has world r, IsRuntime w, IsRuntime r)-      => (r -> w) -> System world ()-rmap f = do sr :: Storage r <- getStore-            sc :: Storage w <- getStore-            liftIO$ do sl <- explMembers sr-                       U.forM_ sl $ \ e -> do-                          r <- explGetUnsafe sr e-                          explSet sc e (f r)---- | Maps a function over all entities with a @r@, and writes or deletes their @w@-{-# INLINE rmap' #-}-rmap' :: forall world r w. (Has world w, Has world r, Store (Storage w), IsRuntime r)-      => (r -> Safe w) -> System world ()-rmap' f = do sr :: Storage r <- getStore-             sw :: Storage w <- getStore-             liftIO$ do sl <- explMembers sr-                        U.forM_ sl $ \ e -> do-                           r <- explGetUnsafe sr e-                           explSetMaybe sw e (getSafe $ f r)---- | For all entities with a @w@, this map reads their @r@ and writes their @w@-{-# INLINE wmap #-}-wmap :: forall world r w. (Has world w, Has world r, IsRuntime w, IsRuntime r)-     => (Safe r -> w) -> System world ()-wmap f = do sr :: Storage r <- getStore-            sw :: Storage w <- getStore-            liftIO$ do sl <- explMembers sr-                       U.forM_ sl $ \ e -> do-                         r <- explGet sr e-                         explSet sw e (f . Safe $ r)---- | For all entities with a @w@, this map reads their @r@ and writes or deletes their @w@-{-# INLINE wmap' #-}-wmap' :: forall world r w. (Has world w, Has world r, Store (Storage w), IsRuntime r)-      => (Safe r -> Safe w) -> System world ()-wmap' f = do sr :: Storage r <- getStore-             sw :: Storage w <- getStore-             liftIO$ do sl <- explMembers sr-                        U.forM_ sl $ \ e -> do-                          r <- explGet sr e-                          explSetMaybe sw e (getSafe . f . Safe $ r)----- Slice traversal-{-# INLINE sliceForM_ #-}-sliceForM_ :: Monad m => Slice c -> (Entity c -> m b) -> m ()-sliceForM_ (Slice vec) ma = U.forM_ vec (ma . Entity)--{-# INLINE sliceForM #-}-sliceForM :: Monad m => Slice c -> (Entity c -> m a) -> m [a]-sliceForM (Slice vec) ma = traverse (ma . Entity) (U.toList vec)--{-# INLINE sliceForMC #-}-sliceForMC :: forall w c a. (Store (Storage c), Has w c) => Slice c -> ((Entity c,Safe c) -> System w a) -> System w [a]-sliceForMC (Slice vec) sys = do-  s :: Storage c <- getStore-  for (U.toList vec) $ \e -> do-    r <- liftIO$ explGet s e-    sys (Entity e, Safe r)--{-# INLINE sliceForMC_ #-}-sliceForMC_ :: forall w c a. (Store (Storage c), Has w c) => Slice c -> ((Entity c,Safe c) -> System w a) -> System w ()-sliceForMC_ (Slice vec) sys = do-  s :: Storage c <- getStore-  U.forM_ vec $ \e -> do-    r <- liftIO$ explGet s e-    sys (Entity e, Safe r)--{-# INLINE sliceMapM_ #-}-sliceMapM_ :: Monad m => (Entity c -> m a) -> Slice c -> m ()-sliceMapM_ ma (Slice vec) = U.mapM_ (ma . Entity) vec--{-# INLINE sliceMapM #-}-sliceMapM :: Monad m => (Entity c -> m a) -> Slice c -> m [a]-sliceMapM ma (Slice vec) = traverse (ma . Entity) (U.toList vec)--{-# INLINE sliceMapMC #-}-sliceMapMC :: forall w c a. (Store (Storage c), Has w c) => ((Entity c,Safe c) -> System w a) -> Slice c -> System w [a]-sliceMapMC sys (Slice vec) = do-  s :: Storage c <- getStore-  for (U.toList vec) $ \e -> do-    r <- liftIO$ explGet s e-    sys (Entity e, Safe r)--{-# INLINE sliceMapMC_ #-}-sliceMapMC_ :: forall w c a. (Store (Storage c), Has w c) => ((Entity c, Safe c) -> System w a) -> Slice c -> System w ()-sliceMapMC_ sys vec = sliceForMC_ vec sys  -- | The following functions are for spatial hashing. --   The idea is that your spatial hash is defined by two vectors;
tutorials/RTS.md view
@@ -92,10 +92,10 @@ When actually executing the game, we produce a world in the IO monad: ```haskell initWorld = do-  positions  <- initStore+  positions  <- initStore -- initStore = initStoreWith (), used to initialize most stores   targets    <- initStore   selected   <- initStore-  mouseState <- initStoreWith Rest+  mouseState <- initStoreWith Rest -- A global needs to be initialized with a value   counter    <- initCounter   return $ World positions targets selected counter ```@@ -289,4 +289,4 @@ We'll be taking a look at   - How to cache your components for O(1) reads and writes   - How to use an IndexTable to add queries to your component storages-  - How to use those indextables to get a free spatial hash of our positions+  - How to use those IndexTables to get a free spatial hash of our positions