apecs 0.2.4.7 → 0.3.0.0

raw patch · 15 files changed

+399/−1105 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +34/−52
• apecs.cabal +2/−4
• bench/Main.hs +3/−21
• src/Apecs.hs +9/−11
• src/Apecs/Concurrent.hs +20/−67
• src/Apecs/Core.hs +180/−0
• src/Apecs/Logs.hs +0/−209
• src/Apecs/Slice.hs +0/−109
• src/Apecs/Stores.hs +29/−225
• src/Apecs/System.hs +64/−161
• src/Apecs/THTuples.hs +17/−48
• src/Apecs/Types.hs +0/−148
• src/Apecs/Util.hs +16/−33
• test/Main.hs +8/−3
• tutorials/RTS.md +17/−14

@@ -1,77 +1,59 @@ # apecs-##### [hackage](https://hackage.haskell.org/package/apecs) | [documentation](https://hackage.haskell.org/package/apecs/docs/Apecs.html) | [tutorials](https://github.com/jonascarpay/apecs/blob/master/tutorials/)--apecs is an Entity Component System inspired by [specs](https://github.com/slide-rs/specs) and [Entitas](https://github.com/sschmid/Entitas-CSharp).-It exposes a DSL that translates to fast storage operations, resulting in expressivity without sacrificing performance or safety.+[![Build Status](https://travis-ci.org/jonascarpay/apecs.svg?branch=master)](https://travis-ci.org/jonascarpay/apecs)+[![Hackage](https://img.shields.io/hackage/v/apecs.svg)](https://hackage.haskell.org/package/apecs)+[![apecs on Stackage LTS 9](http://stackage.org/package/apecs/badge/lts-9)](http://stackage.org/lts-9/package/apecs)+[![apecs on Stackage LTS 10](http://stackage.org/package/apecs/badge/lts-10)](http://stackage.org/lts-10/package/apecs) -There is an example below, and a tutorial can be found [here](https://github.com/jonascarpay/apecs/blob/master/tutorials/RTS.md).-For a physics engine written on top of apecs, check out [phycs](https://github.com/jonascarpay/phycs).-For a general introduction to ECS, see [this talk](https://www.youtube.com/watch?v=lNTaC-JWmdI&feature=youtu.be&t=218) or [here](https://en.wikipedia.org/wiki/Entity–component–system).+apecs is an _Entity Component System_ inspired by [specs](https://github.com/slide-rs/specs) and [Entitas](https://github.com/sschmid/Entitas-CSharp).+It provides a collection of mutable component stores, and an expressive DSL for operating on those stores, both easily extended. -### Performance-Performance is good.-Running [ecs-bench](https://github.com/lschmierer/ecs_bench) shows that apecs is competitive with the fastest Rust ECS frameworks.+#### Links+- [documentation](https://hackage.haskell.org/package/apecs/docs/Apecs.html)+- [introductory tutorial](https://github.com/jonascarpay/apecs/blob/master/tutorials/RTS.md)+- [performance guide](https://github.com/jonascarpay/apecs/blob/master/tutorials/GoingFast.md)+- [apecs-physics](https://github.com/jonascarpay/apecs-physics) -|               | pos_vel build | pos_vel step | parallel build | parallel step |-| ------------- | ------------- | ------------ | -------------- | ------------- |-| apecs         | 239           | 34           | 777            | 371           |-| calx          | 261           | 21           | 442            | 72            |-| constellation | 306           | 10           | 567            | 256           |-| froggy        | 594           | 13           | 1565           | 97            |-| specs         | 753           | 38           | 1016           | 205           |+#### Performance+[ecs-bench](https://github.com/lschmierer/ecs_bench) shows that apecs is competitive with the fastest Rust ECS frameworks.  ![Benchmarks](/bench/chart.png) -There is a performance guide [here](https://github.com/jonascarpay/apecs/blob/master/tutorials/GoingFast.md).--### Example+#### Example ```haskell+{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeFamilies, MultiParamTypeClasses, TemplateHaskell #-}+ import Apecs-import Apecs.Stores (Cache)-import Apecs.Concurrent (prmap)+import Apecs.Stores+import Apecs.Core import Linear  newtype Position = Position (V2 Double) deriving Show--- Turn Position into a component by specifiying the type of its Storage+-- To declare a component, we need to specify how to store it instance Component Position where-  -- The simplest store is a Map-  type Storage Position = Map Position+  type Storage Position = Map Position -- The simplest store is a Map -newtype Velocity = Velocity (V2 Double)+newtype Velocity = Velocity (V2 Double) deriving Show instance Component Velocity where-  -- We can add a Cache for faster access-  type Storage Velocity = Cache 100 (Map Velocity)+  type Storage Velocity = Cache 100 (Map Velocity) -- Caching adds fast reads/writes -data Player = Player -- A single constructor component for tagging the player-instance Component Player where-  -- Unique contains at most one component. See the Stores module.-  type Storage Player = Unique Player+data Flying = Flying+instance Component Flying where+  type Storage Flying = Map Flying --- Generate a world type and instances-makeWorld "World" [''Position, ''Velocity, ''Player]+makeWorld "World" [''Position, ''Velocity, ''Flying] -- Generate World and instances  game :: System World () game = do-  -- Create new entities-  ety <- newEntity (Position 0)-  -- Components can be composed using tuples   newEntity (Position 0, Velocity 1)-  newEntity (Position 1, Velocity 1, Player)--  -- set (over)writes components-  set ety (Velocity 2)--  let stepVelocity (Position p, Velocity v) = Position (v+p)--  -- Side effects-  liftIO$ putStrLn "Stepping velocities"-  -- rmap maps a pure function over all entities in its domain-  rmap stepVelocity-  -- prmap n does the same, but in parallel-  prmap 2 stepVelocity+  newEntity (Position 2, Velocity 1)+  newEntity (Position 1, Velocity 2, Flying) -  -- Print all positions-  cmapM_ $ \(Position p) -> liftIO (print p)+  -- Add velocity to position+  cmap $ \(Position p, Velocity v) -> Position (v+p)+  -- Apply gravity to non-flying entities+  cmap $ \(Velocity v, _ :: Not Flying) -> Velocity (v - (V2 0 1))+  -- Print a list of entities and their positions+  cmapM_ $ \(Position p, Entity e) -> liftIO . print $ (e, p)  main :: IO () main = initWorld >>= runSystem game

@@ -1,5 +1,5 @@ name:                apecs-version:             0.2.4.7+version:             0.3.0.0 homepage:            https://github.com/jonascarpay/apecs#readme license:             BSD3 license-file:        LICENSE@@ -21,12 +21,10 @@     src   exposed-modules:     Apecs,-    Apecs.Types,+    Apecs.Core,     Apecs.Stores,-    Apecs.Logs,     Apecs.System,     Apecs.Concurrent,-    Apecs.Slice,     Apecs.TH,     Apecs.Util   other-modules:

@@ -10,7 +10,6 @@  import Apecs import Apecs.Stores-import Apecs.Concurrent  -- pos_vel newtype ECSPos = ECSPos (V2 Float) deriving (Eq, Show)@@ -21,34 +20,17 @@  makeWorld "PosVel" [''ECSPos, ''ECSVel] +posVelInit :: System PosVel () posVelInit = do replicateM_ 1000 (newEntity (ECSPos 0, ECSVel 1))                 replicateM_ 9000 (newEntity (ECSPos 0)) -posVelStep = rmap $ \(ECSVel v, ECSPos p) -> ECSPos (p+v)---- parallel-newtype W1 = W1 Float-newtype W2 = W2 Float-newtype R  = R Float-instance Component W1 where type Storage W1 = Cache 10000 (Map W1)-instance Component W2 where type Storage W2 = Cache 10000 (Map W2)-instance Component R  where type Storage R  = Cache 10000 (Map R)--makeWorld "Parallel" [''W1, ''W2, ''R]--parallelInit, parallelStep :: System Parallel ()-parallelInit = replicateM_ 10000 $ newEntity (W1 0, W2 0, R 0)-parallelStep = do rmap $ \(R x) -> W1 x-                  rmap $ \(R x) -> W2 x+posVelStep :: System PosVel ()+posVelStep = cmap $ \(ECSVel v, ECSPos p) -> ECSPos (p+v)  main :: IO () main = C.defaultMainWith (C.defaultConfig {timeLimit = 10})   [ bgroup "pos_vel"     [ bench "init" $ whnfIO (initPosVel >>= runSystem posVelInit)     , bench "step" $ whnfIO (initPosVel >>= runSystem (posVelInit >> posVelStep))-    ]-  , bgroup "parallel"-    [ bench "init" $ whnfIO (initParallel >>= runSystem parallelInit)-    , bench "step" $ whnfIO (initParallel >>= runSystem (parallelInit >> parallelStep))     ]   ]

@@ -5,22 +5,20 @@ module Apecs (   -- * Types     System(..),-    Component(..), Entity(..), Slice, Has(..), Safe(..), cast,-    Map, Set, Unique, Global, Flag(..),+    Component(..), Entity(..), Has(..),+    Not(..), +    Map, Unique, Global,+   -- * Store wrapper functions     initStore,-    destroy, exists, owners, resetStore,-    get, getUnsafe, set, set', modify,-    cmap, cmapM, cmapM_, cimapM, cimapM_,-    rmap', rmap, wmap, wmap', cmap',--  -- ** GlobalRW wrapper functions-    getGlobal, setGlobal, modifyGlobal,+    get, set,+    cmap, cmapM, cmapM_,+    modify, destroy, exists,    -- * Other     runSystem, runWith,-    runGC, EntityCounter, newEntity,+    runGC, EntityCounter, newEntity, global, proxy,     makeWorld,    -- * Re-exports@@ -32,6 +30,6 @@ import           Apecs.Stores import           Apecs.System import           Apecs.TH-import           Apecs.Types+import           Apecs.Core import           Apecs.Util 

@@ -5,7 +5,7 @@  module Apecs.Concurrent (   concurrently,-  pcmap, prmap, pwmap, pcmap', prmap', pwmap',+  pmap, ) where  import qualified Control.Concurrent.Async as A@@ -13,7 +13,7 @@ import qualified Data.Vector.Unboxed      as U  import           Apecs.System-import           Apecs.Types+import           Apecs.Core  -- | Executes a list of systems concurrently, and blocks until all have finished. --   Provides zero protection against race conditions and other hazards, so use with caution.@@ -21,72 +21,25 @@ concurrently ss = do w <- System ask                      liftIO . A.mapConcurrently_ (runWith w) $ ss -{-# INLINE parallelize #-}-parallelize :: U.Unbox a => Int -> (a -> IO b) -> U.Vector a -> IO ()-parallelize grainSize sys vec-  | U.length vec <= grainSize = U.mapM_ sys vec-  | otherwise = A.mapConcurrently_ (U.mapM_ sys) vecSplits-    where-      vecSplits = go vec-      go vec-        | U.null vec = []-        | otherwise = let (h,t) = U.splitAt grainSize vec in h : go t---- | Executes a map in parallel by requesting a slice of all components,---   and spawning threads iterating over @grainSize@ components each.-{-# INLINE pcmap #-}-pcmap :: forall world c. Has world c => Int -> (c -> c) -> System world ()-pcmap grainSize f = do-  s :: Storage c <- getStore-  liftIO$ do-    sl <- explMembers s-    parallelize grainSize (\e -> explModify s e f) sl---- | @rmap@ version of @pcmap@-{-# INLINE prmap #-}-prmap :: forall world r w. (Has world w, Has world r)-      => Int -> (r -> w) -> System world ()-prmap grainSize f =-  do sr :: Storage r <- getStore-     sw :: Storage w <- getStore+-- | Parallel version of @cmap@. +{-# INLINE pmap #-}+pmap :: forall w x y. (Has w y, Has w x)+     => Int -- ^ Entities per thread+     -> (x -> y) -> System w ()+pmap grainSize f =+  do sr :: Storage x <- getStore+     sw :: Storage y <- getStore      liftIO$ do        sl <- explMembers sr-       parallelize grainSize (\e -> explGetUnsafe sr e >>= explSet sw e . f) sl---- | @cmap'@ version of @pcmap@-{-# INLINE pcmap' #-}-pcmap' :: forall world c. Has world c => Int -> (c -> Safe c) -> System world ()-pcmap' grainSize f = do-  s :: Storage c <- getStore-  liftIO$ do sl <- explMembers s-             parallelize grainSize (\e -> explGetUnsafe s e >>= explSetMaybe s e . getSafe . f) sl---- | @rmap'@ version of @pcmap@-{-# INLINE prmap' #-}-prmap' :: forall world r w. (Has world w, Has world r, Store (Storage r), Store (Storage w))-      => Int -> (r -> Safe w) -> System world ()-prmap' grainSize f = do-  sr :: Storage r <- getStore-  sw :: Storage w <- getStore-  liftIO$ do sl <- explMembers sr-             parallelize grainSize (\e -> explGetUnsafe sr e >>= explSetMaybe sw e . getSafe . f) sl+       parallelize grainSize (\e -> explGet sr e >>= explSet sw e . f) sl --- | @wmap@ version of @pcmap@-{-# INLINE pwmap #-}-pwmap :: forall world r w. (Has world w, Has world r, Store (Storage r), Store (Storage w))-     => Int -> (Safe r -> w) -> System world ()-pwmap grainSize f = do-  sr :: Storage r <- getStore-  sw :: Storage w <- getStore-  liftIO$ do sl <- explMembers sr-             parallelize grainSize (\e -> explGet sr e >>= explSet sw e . f . Safe) sl+  where+    parallelize grainSize sys vec+      | U.length vec <= grainSize = U.mapM_ sys vec+      | otherwise = A.mapConcurrently_ (U.mapM_ sys) vecSplits+        where+          vecSplits = go vec+          go vec+            | U.null vec = []+            | otherwise = let (h,t) = U.splitAt grainSize vec in h : go t --- | @wmap'@ version of @pcmap@-{-# INLINE pwmap' #-}-pwmap' :: forall world r w. (Has world w, Has world r, Store (Storage r), Store (Storage w))-       => Int -> (Safe r -> Safe w) -> System world ()-pwmap' grainSize f =-  do sr :: Storage r <- getStore-     sw :: Storage w <- getStore-     liftIO$ do sl <- explMembers sr-                parallelize grainSize (\e -> explGet sr e >>= explSetMaybe sw e . getSafe . f . Safe) sl

@@ -0,0 +1,180 @@+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeFamilies               #-}++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++-- | An Entity is really just an Int in a newtype.+newtype Entity = Entity Int deriving (Eq, Ord, Show)++-- | 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 an instance of Store.+class (Elem (Storage c) ~ c, Store (Storage c)) => Component c where+  type Storage c++-- | A world `Has` a component if it can produce its Storage+class Component c => Has w c where+  getStore :: System w (Storage c)++-- | Holds components indexed by entities+--+--   Laws:+--+--      * For all entities in @exmplMembers s@, @explExists s ety@ must be true.+--+--      * If for some entity @explExists s ety@, @explGet s ety@ should safely return a non-bottom value.+class Store s where+  -- | The type of components stored by this Store+  type Elem s++  -- Initialize the store with its initialization arguments.+  initStore :: IO s++  -- | Writes a component+  explSet :: s -> Int -> Elem s -> IO ()+  -- | Reads a component from the store. What happens if the component does not exist is left undefined.+  explGet :: s -> Int -> IO (Elem s)+  -- | Destroys the component for a given index.+  explDestroy :: s -> Int -> IO ()+  -- | Returns an unboxed vector of member indices+  explMembers :: s -> IO (U.Vector Int)++  -- | Returns whether there is a component for the given index+  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++-- Tuple Instances+T.makeInstances [2..8]++-- | Psuedocomponent indicating the absence of @a@.+data Not a = Not++-- | Pseudostore used to produce values of type @Not a@+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++-- | Pseudostore used to produce values of type @Maybe a@+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++-- | Pseudostore used to produce values of type @Either p q@+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 ()++-- | Pseudostore used to produce components of type @Entity@+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 ()

@@ -1,209 +0,0 @@-{-# LANGUAGE ConstraintKinds       #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE Strict                #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE UndecidableInstances  #-}---- | Experimental module for logging a store--module Apecs.Logs-  ( -- * Types and classes-    Log(..), PureLog(..), FromPure(..), Logger, getLog, readIORef,-    LVec1, LVec2, LVec3,--    -- * EnumTable-    EnumTable, byIndex, byEnum,-  ) where--import           Control.Monad.Reader-import qualified Data.IntSet          as S-import           Data.IORef-import qualified Data.Vector.Mutable  as VM--import qualified Apecs.Slice          as Sl-import           Apecs.Stores-import           Apecs.Types---- | A PureLog is a piece of state @l c@ that is updated when components @c@ are written or destroyed.---   Note that @l :: * -> *@-class PureLog l c where-  pureEmpty :: l c-  pureOnSet :: Entity a -> Maybe c -> c -> l c -> l c-  pureOnDestroy :: Entity a -> c -> l c -> l c---- | A Log is a PureLog with mutable state.-class Log l c where-  logEmpty     :: IO (l c)-  logOnSet     :: l c -> Entity a -> Maybe c -> c -> IO ()-  logOnDestroy :: l c -> Entity a -> c -> IO ()-  logReset     :: l c -> IO ()--class HasLog s l where-  explGetLog :: s -> l (Stores s)--instance HasLog (Logger l s) l where-  {-# INLINE explGetLog #-}-  explGetLog (Logger l _) = l---- | Produces the log indicated by the return type.-{-# INLINE getLog #-}-getLog :: forall w c l. (Store (Storage c), Has w c, HasLog (Storage c) l, Log l c) => System w (l c)-getLog = do s :: Storage c <- getStore-            return (explGetLog s)----- | FromPure turns a PureLog into a Log-newtype FromPure l c = FromPure (IORef (l c))-instance PureLog l c => Log (FromPure l) c where-  {-# INLINE logEmpty #-}-  logEmpty = FromPure <$> newIORef pureEmpty-  {-# INLINE logOnSet #-}-  logOnSet (FromPure lref) e old new = modifyIORef' lref (pureOnSet e old new)-  {-# INLINE logOnDestroy #-}-  logOnDestroy (FromPure lref) e c = modifyIORef' lref (pureOnDestroy e c)-  {-# INLINE logReset #-}-  logReset (FromPure lref) = writeIORef lref pureEmpty---- | A @Logger l@ of some store updates its @Log l@ with the writes and deletes to store @s@-data Logger l s = Logger (l (Stores s)) s--instance (Log l (Stores s), Cachable s) => Store (Logger l s) where-  type Stores (Logger l s) = Stores s-  initStore = Logger <$> logEmpty <*> initStore--  {-# INLINE explDestroy #-}-  explDestroy (Logger l s) ety = do-    mc <- explGet s ety-    case mc of-      Just c -> logOnDestroy l (Entity ety) c >> explDestroy s ety-      _      -> return ()--  {-# INLINE explExists #-}-  explExists (Logger _ s) ety = explExists s ety-  {-# INLINE explMembers #-}-  explMembers (Logger _ s) = explMembers s-  {-# INLINE explReset #-}-  explReset (Logger l s) = logReset l >> explReset s-  {-# INLINE explImapM_ #-}-  explImapM_ (Logger _ s) = explImapM_ s-  {-# INLINE explImapM #-}-  explImapM (Logger _ s) = explImapM s--  type SafeRW (Logger l s) = SafeRW s--  {-# INLINE explGetUnsafe #-}-  explGetUnsafe (Logger _ s) ety = explGetUnsafe s ety-  {-# INLINE explGet #-}-  explGet (Logger _ s) ety = explGet s ety-  {-# INLINE explSet #-}-  explSet (Logger l s) ety x = do-    mc <- explGet s ety-    logOnSet l (Entity ety) mc x-    explSet s ety x--  {-# INLINE explSetMaybe #-}-  explSetMaybe s ety (Nothing) = explDestroy s ety-  explSetMaybe s ety (Just x)  = explSet s ety x--  {-# INLINE explModify #-}-  explModify (Logger l s) ety f = do-    mc <- explGet s ety-    case mc of-      Just c  -> explSet (Logger l s) ety (f c)-      Nothing -> return ()--  {-# INLINE explCmapM_ #-}-  explCmapM_  (Logger _ s) = explCmapM_  s-  {-# INLINE explCmapM #-}-  explCmapM   (Logger _ s) = explCmapM   s-  {-# INLINE explCimapM_ #-}-  explCimapM_ (Logger _ s) = explCimapM_ s-  {-# INLINE explCimapM #-}-  explCimapM  (Logger _ s) = explCimapM  s---- | Composite Log consisting of 1 Log-newtype LVec1 l c = LVec1 (l c)-instance Log l c => Log (LVec1 l) c where-  {-# INLINE logEmpty #-}-  logEmpty = LVec1 <$> logEmpty-  {-# INLINE logOnSet #-}-  logOnSet     (LVec1 l) e old new = logOnSet l e old new-  {-# INLINE logOnDestroy #-}-  logOnDestroy (LVec1 l) e c       = logOnDestroy l e c-  {-# INLINE logReset #-}-  logReset     (LVec1 l)           = logReset l---- | Composite Log consisting of 2 Logs-data LVec2 l1 l2 c = LVec2 (l1 c) (l2 c)-instance (Log l1 c, Log l2 c) => Log (LVec2 l1 l2) c where-  {-# INLINE logEmpty #-}-  logEmpty = LVec2 <$> logEmpty <*> logEmpty-  {-# INLINE logOnSet #-}-  logOnSet     (LVec2 l1 l2) e old new = logOnSet l1 e old new >> logOnSet l2 e old new-  {-# INLINE logOnDestroy #-}-  logOnDestroy (LVec2 l1 l2) e c       = logOnDestroy l1 e c >> logOnDestroy l2 e c-  {-# INLINE logReset #-}-  logReset     (LVec2 l1 l2)           = logReset l1 >> logReset l2---- | Composite Log consisting of 3 Logs-data LVec3 l1 l2 l3 c = LVec3 (l1 c) (l2 c) (l3 c)-instance (Log l1 c, Log l2 c, Log l3 c) => Log (LVec3 l1 l2 l3) c where-  {-# INLINE logEmpty #-}-  logEmpty = LVec3 <$> logEmpty <*> logEmpty <*> logEmpty-  {-# INLINE logOnSet #-}-  logOnSet (LVec3 l1 l2 l3) e old new = do-    logOnSet l1 e old new-    logOnSet l2 e old new-    logOnSet l3 e old new-  {-# INLINE logOnDestroy #-}-  logOnDestroy (LVec3 l1 l2 l3) e c = do-    logOnDestroy l1 e c-    logOnDestroy l2 e c-    logOnDestroy l3 e c-  {-# INLINE logReset #-}-  logReset (LVec3 l1 l2 l3) = do-    logReset l1-    logReset l2-    logReset l3---- | Hashtable that maintains buckets of entities whose @fromEnum c@ produces the same value-newtype EnumTable c = EnumTable (VM.IOVector S.IntSet)-instance (Bounded c, Enum c) => Log EnumTable c where-  {-# INLINE logEmpty #-}-  logEmpty = do-    let lo = fromEnum (minBound :: c)-        hi = fromEnum (maxBound :: c)--    if lo == 0-       then EnumTable <$> VM.replicate (hi+1) mempty-       else error "Attempted to initialize EnumTable for a component with a non-zero minBound"--  {-# INLINE logOnSet #-}-  logOnSet (EnumTable vec) (Entity e) old new = do-    case old of-      Nothing -> return ()-      Just c  -> VM.modify vec (S.delete e) (fromEnum c)-    VM.modify vec (S.insert e) (fromEnum new)--  {-# INLINE logOnDestroy #-}-  logOnDestroy (EnumTable vec) (Entity e) c = VM.modify vec (S.delete e) (fromEnum c)--  {-# INLINE logReset #-}-  logReset (EnumTable vec) = forM_ [0..VM.length vec - 1] (\e -> VM.write vec e mempty)---- | Query the @EnumTable@ by an index (the result of @fromEnum@).---   Will return an empty slice if @index < 0@ of @index >= fromEnum (maxBound)@.-{-# INLINE byIndex #-}-byIndex :: EnumTable c -> Int -> System w (Slice c)-byIndex (EnumTable vec) c-  | c < 0                  = return mempty-  | c >= VM.length vec - 1 = return mempty-  | otherwise = liftIO$ Sl.fromList . S.toList <$> VM.read vec c---- | Query the @EnumTable@ by an example enum.---   Will not perform bound checks, so crashes if `fromEnum c < 0 && fromEnum c > fromEnum maxBound `.-byEnum :: Enum c => EnumTable c -> c -> System w (Slice c)-byEnum (EnumTable vec) c = liftIO$ Sl.fromList . S.toList <$> VM.read vec (fromEnum c)

@@ -1,109 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}---- | This module is designed to be imported with qualified-module Apecs.Slice where--import           Control.Monad.Reader (liftIO)-import           Data.Traversable     (for)-import qualified Data.Vector.Unboxed  as U--import           Apecs.Types---- | Slice version of foldM_-{-# INLINE foldM_ #-}-foldM_ :: (a -> Entity c -> System w a) -> a -> Slice b -> System w ()-foldM_ f seed (Slice sl) = U.foldM'_ ((.Entity) . f) seed sl---- | Gets the size of a slice (O(n))-{-# INLINE size #-}-size :: Slice a -> Int-size (Slice vec) = U.length vec---- | Checks whether an entity is in a slice-{-# INLINE elem #-}-elem :: Entity c -> Slice c -> Bool-elem = elem'---- | More polymorphic version of 'elem'-{-# INLINE elem' #-}-elem' :: Entity a -> Slice b -> Bool-elem' (Entity e) (Slice sl) = U.elem e sl---- | Tests whether a slice is empty (O(1))-{-# INLINE null #-}-null :: Slice a -> Bool-null (Slice vec) = U.null vec---- | Construct a slice from a list of IDs-{-# INLINE fromList #-}-fromList :: [Int] -> Slice a-fromList = Slice . U.fromList---- | Monadically filter a slice-{-# INLINE filterM #-}-filterM :: (Entity c -> System w Bool) -> Slice c -> System w (Slice c)-filterM fm (Slice vec) = Slice <$> U.filterM (fm . Entity) vec---- | Concatenates two slices. Equivalent to mappend-{-# INLINE concat #-}-concat :: Slice a -> Slice b -> Slice c-concat (Slice a) (Slice b) = Slice (a U.++ b)---- Slice traversal--- | Slice version of forM_-{-# INLINE forM_ #-}-forM_ :: Monad m => Slice c -> (Entity c -> m b) -> m ()-forM_ (Slice vec) ma = U.forM_ vec (ma . Entity)---- | Slice version of forM-{-# INLINE forM #-}-forM :: Monad m => Slice c -> (Entity c -> m a) -> m [a]-forM (Slice vec) ma = traverse (ma . Entity) (U.toList vec)---- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE forMC #-}-forMC :: forall w c a. Has w c => Slice c -> ((Entity c,Safe c) -> System w a) -> System w [a]-forMC (Slice vec) sys = do-  s :: Storage c <- getStore-  for (U.toList vec) $ \e -> do-    r <- liftIO$ explGet s e-    sys (Entity e, Safe r)---- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE forMC_ #-}-forMC_ :: forall w c a. Has w c => Slice c -> ((Entity c,Safe c) -> System w a) -> System w ()-forMC_ (Slice vec) sys = do-  s :: Storage c <- getStore-  U.forM_ vec $ \e -> do-    r <- liftIO$ explGet s e-    sys (Entity e, Safe r)---- | Slice version of mapM_-{-# INLINE mapM_ #-}-mapM_ :: Monad m => (Entity c -> m a) -> Slice c -> m ()-mapM_ ma (Slice vec) = U.mapM_ (ma . Entity) vec---- | Slice version of mapM-{-# INLINE mapM #-}-mapM :: Monad m => (Entity c -> m a) -> Slice c -> m [a]-mapM ma (Slice vec) = traverse (ma . Entity) (U.toList vec)---- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE mapMC #-}-mapMC :: forall w c a. Has w c => ((Entity c,Safe c) -> System w a) -> Slice c -> System w [a]-mapMC sys (Slice vec) = do-  s :: Storage c <- getStore-  for (U.toList vec) $ \e -> do-    r <- liftIO$ explGet s e-    sys (Entity e, Safe r)---- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE mapMC_ #-}-mapMC_ :: forall w c a. Has w c => ((Entity c, Safe c) -> System w a) -> Slice c -> System w ()-mapMC_ sys vec = forMC_ vec sys--toList :: Slice a -> [Entity a]-toList (Slice sl) = Entity <$> U.toList sl

@@ -9,15 +9,13 @@ {-# LANGUAGE TypeFamilies          #-}  module Apecs.Stores-  ( Map, Set, Flag(..), Cache, Unique,+  ( Map, Cache, Unique,     Global,     Cachable,-    defaultSetMaybe,   ) where  import           Control.Monad.Reader import qualified Data.IntMap.Strict          as M-import qualified Data.IntSet                 as S import           Data.IORef import           Data.Maybe                  (fromJust) import           Data.Proxy@@ -26,204 +24,72 @@ import qualified Data.Vector.Unboxed.Mutable as UM import           GHC.TypeLits -import           Apecs.Types---- | Default version of @explSetMaybe@, for your convenience.---   Can be used when 'SafeRW s ~ Maybe (Stores s)'.-{-# INLINE defaultSetMaybe #-}-defaultSetMaybe :: (Store s, SafeRW s ~ Maybe (Stores s)) => s -> Int -> Maybe (Stores s) -> IO ()-defaultSetMaybe s e Nothing  = explDestroy s e-defaultSetMaybe s e (Just c) = explSet s e c+import           Apecs.Core  -- | A map from Data.Intmap.Strict. O(log(n)) for most operations. --   Yields safe runtime representations of type @Maybe c@. newtype Map c = Map (IORef (M.IntMap c)) instance Store (Map c) where-  type Stores (Map c) = c+  type Elem (Map c) = c   initStore = Map <$> newIORef mempty-  explDestroy (Map ref) ety = modifyIORef' ref (M.delete ety)-  explMembers (Map ref)     = U.fromList . M.keys <$> readIORef ref-  explExists  (Map ref) ety = M.member ety <$> readIORef ref-  explReset   (Map ref)     = writeIORef ref mempty-  {-# INLINE explDestroy #-}-  {-# INLINE explMembers #-}-  {-# INLINE explExists #-}-  {-# INLINE explReset #-}-  type SafeRW (Map c) = Maybe c-  explGetUnsafe (Map ref) ety = fromJust . M.lookup ety <$> readIORef ref-  explGet       (Map ref) ety = M.lookup ety <$> readIORef ref-  explSet       (Map ref) ety x = modifyIORef' ref $ M.insert ety x-  explSetMaybe = defaultSetMaybe-  explModify    (Map ref) ety f = modifyIORef' ref $ M.adjust f ety-  explCmap      (Map ref) f = modifyIORef' ref $ M.map f-  explCmapM_    (Map ref) ma = liftIO (readIORef ref) >>= mapM_ ma-  explCmapM     (Map ref) ma = liftIO (readIORef ref) >>= mapM  ma . M.elems-  explCimapM_   (Map ref) ma = liftIO (readIORef ref) >>= mapM_ ma . M.assocs-  explCimapM    (Map ref) ma = liftIO (readIORef ref) >>= mapM  ma . M.assocs-  {-# INLINE explGetUnsafe #-}+  explGet     (Map ref) ety   = fromJust . M.lookup ety <$> readIORef ref+  explSet     (Map ref) ety x = modifyIORef' ref $ M.insert ety x+  explExists  (Map ref) ety   = M.member ety <$> readIORef ref+  explDestroy (Map ref) ety   = modifyIORef' ref (M.delete ety)+  explMembers (Map ref)       = U.fromList . M.keys <$> readIORef ref   {-# INLINE explGet #-}   {-# INLINE explSet #-}-  {-# INLINE explSetMaybe #-}-  {-# INLINE explCmap #-}-  {-# INLINE explModify #-}-  {-# INLINE explCmapM_ #-}-  {-# INLINE explCmapM #-}-  {-# INLINE explCimapM_ #-}-  {-# INLINE explCimapM #-}---- | Class for flags, used by @Set@ to yield runtime representations.-class Flag c where-  flag :: c---- | A store that keeps membership, but holds no values.---   Produces @flag@ runtime values.-newtype Set c = Set (IORef S.IntSet)-instance Flag c => Store (Set c) where-  type Stores (Set c) = c-  type SafeRW (Set c) = Bool-  initStore = Set <$> newIORef mempty-  explDestroy (Set ref) ety = modifyIORef' ref (S.delete ety)-  explMembers (Set ref) = U.fromList . S.toList <$> readIORef ref-  explReset (Set ref) = writeIORef ref mempty-  explExists (Set ref) ety = S.member ety <$> readIORef ref-  explImapM_  (Set ref) ma = liftIO (readIORef ref) >>= mapM_ ma . S.toList-  explImapM   (Set ref) ma = liftIO (readIORef ref) >>= mapM  ma . S.toList   {-# INLINE explDestroy #-}   {-# INLINE explMembers #-}   {-# INLINE explExists #-}-  {-# INLINE explReset #-}-  {-# INLINE explImapM_ #-}-  {-# INLINE explImapM #-} -  explGetUnsafe _ _ = return flag-  explGet (Set ref) ety = S.member ety <$> readIORef ref-  explSet (Set ref) ety _ = modifyIORef' ref $ S.insert ety-  explSetMaybe s ety False = explDestroy s ety-  explSetMaybe s ety True  = explSet s ety flag-  explCmap _ _ = return ()-  explModify _ _ _ = return ()-  explCmapM   s m = explImapM  s (m . const flag)-  explCmapM_  s m = explImapM_ s (m . const flag)-  explCimapM  s m = explImapM  s (m . flip  (,) flag)-  explCimapM_ s m = explImapM_ s (m . flip  (,) flag)-  {-# INLINE explGetUnsafe #-}-  {-# INLINE explGet #-}-  {-# INLINE explSet #-}-  {-# INLINE explSetMaybe #-}-  {-# INLINE explCmap #-}-  {-# INLINE explModify #-}- -- | A Unique contains at most one component. --   Writing to it overwrites both the previous component and its owner. data Unique c = Unique (IORef Int) (IORef c) instance Store (Unique c) where-  type Stores (Unique c) = c-  type SafeRW (Unique c) = Maybe c-  initStore = Unique <$> newIORef (-1) <*> newIORef undefined+  type Elem (Unique c) = c+  initStore = Unique <$> newIORef (-1) <*> newIORef (error "Uninitialized Unique value")+  explGet     (Unique _ cref) _ = readIORef cref+  explSet     (Unique eref cref) ety x = writeIORef eref ety >> writeIORef cref x   explDestroy (Unique eref _) ety = do e <- readIORef eref; when (e==ety) (writeIORef eref (-1))-   explMembers (Unique eref _) = f <$> readIORef eref     where f (-1) = mempty           f x    = U.singleton x-  explReset   (Unique eref _) = writeIORef eref (-1)   explExists  (Unique eref _) ety = (==ety) <$> readIORef eref-  explImapM_  (Unique eref _) ma = do e <- liftIO (readIORef eref); when (e /= -1) (void$ ma e)-  explImapM   (Unique eref _) ma = do-    e <- liftIO (readIORef eref)-    if e /= -1 then return [] else pure <$> ma e   {-# INLINE explDestroy #-}   {-# INLINE explMembers #-}   {-# INLINE explExists #-}-  {-# INLINE explReset #-}-  {-# INLINE explImapM_ #-}-  {-# INLINE explImapM #-}--  explGetUnsafe (Unique _ cref) _ = readIORef cref-  explGet       (Unique eref cref) ety = do-    e <- readIORef eref-    if e == ety && e /= -1 then Just <$> readIORef cref else return Nothing--  explSet       (Unique eref cref) ety x = writeIORef eref ety >> writeIORef cref x-  explSetMaybe = defaultSetMaybe-  explCmap      (Unique eref cref) f = readIORef eref >>= \e -> unless (e == -1) $ modifyIORef' cref f-  explModify    (Unique eref cref) ety f = do-    e <- readIORef eref-    when (e==ety && e /= -1) (modifyIORef' cref f)--  explCmapM (Unique eref cref) ma = do-    e <- liftIO$ readIORef eref-    if e /= -1 then liftIO (readIORef cref) >>= fmap pure . ma-               else return []--  explCmapM_ (Unique eref cref) ma = do-    e <- liftIO$ readIORef eref-    when (e /= -1) . void $ liftIO (readIORef cref) >>= ma--  explCimapM (Unique eref cref) ma = do-    e <- liftIO$ readIORef eref-    if e /= -1 then liftIO (readIORef cref) >>= fmap pure . ma . (,) e-               else return []--  explCimapM_ (Unique eref cref) ma = do-    e <- liftIO$ readIORef eref-    when (e /= -1) . void $ liftIO (readIORef cref) >>= ma . (,) e--  {-# INLINE explGetUnsafe #-}-  {-# INLINE explGet #-}   {-# INLINE explSet #-}-  {-# INLINE explSetMaybe #-}-  {-# INLINE explCmap #-}-  {-# INLINE explModify #-}---- | Constant value. Not very practical, but fun to write.---   Contains `mempty`-newtype Const c = Const c-instance Monoid c => Store (Const c) where-  type Stores (Const c) = c-  initStore = return$ Const mempty-  explDestroy _ _ = return ()-  explExists  _ _  = return False-  explMembers _ = return mempty-  explReset _ = return ()-  type SafeRW (Const c) = c-  explGetUnsafe (Const c) _ = return c-  explGet       (Const c) _ = return c-  explSet       _ _ _ = return ()-  explSetMaybe  _ _ _ = return ()-  explModify    _ _ _ = return ()-  explCmap       _ _ = return ()-instance Monoid c => GlobalStore (Const c) where+  {-# INLINE explGet #-} --- | Global value.+-- | A Global contains exactly one component. --   Initialized with 'mempty' newtype Global c = Global (IORef c)-instance Monoid c => GlobalStore (Global c) where instance Monoid c => Store (Global c) where-  type Stores   (Global c) = c+  type Elem   (Global c) = c   initStore = Global <$> newIORef mempty--  type SafeRW (Global c) = c-  explDestroy _ _ = return ()-  explExists _ _ = return False-  explGetUnsafe (Global ref) _ = readIORef ref-  explGet (Global ref) _ = readIORef ref+  explGet (Global ref) _   = readIORef ref   explSet (Global ref) _ c = writeIORef ref c-  explSetMaybe = explSet-  explMembers = return mempty-+  explExists  _ _ = return True+  explDestroy s _ = explSet s 0 mempty+  explMembers _ = return $ U.singleton (-1)+  {-# INLINE explDestroy #-}+  {-# INLINE explMembers #-}+  {-# INLINE explExists #-}+  {-# INLINE explSet #-}+  {-# INLINE explGet #-}  -- | A cache around another store.---   The wrapped store must produce safe representations using Maybe.---   Note that iterating over a cache is linear in its size, so large, sparsely populated caches might actually decrease performance.+--   Note that iterating over a cache is linear in cache size, so sparsely populated caches might actually decrease performance. data Cache (n :: Nat) s =-  Cache Int (UM.IOVector Int) (VM.IOVector (Stores s)) s+  Cache Int (UM.IOVector Int) (VM.IOVector (Elem s)) s -class (Store s, SafeRW s ~ Maybe (Stores s)) => Cachable s+class Store s => Cachable s instance Cachable (Map s) instance (KnownNat n, Cachable s) => Cachable (Cache n s)  instance (KnownNat n, Cachable s) => Store (Cache n s) where-  type Stores (Cache n s) = Stores s+  type Elem (Cache n s) = Elem s   initStore = do     let n = fromIntegral$ natVal (Proxy @n)     tags <- UM.replicate n (-1)@@ -249,38 +115,12 @@     stored <- explMembers s     return $! cached U.++ stored -  {-# INLINE explReset #-}-  explReset (Cache n tags _ s) = do-    forM_ [0..n-1] $ \e -> UM.write tags e (-1)-    explReset s--  {-# INLINE explImapM_ #-}-  explImapM_ (Cache _ tags _ s) ma = do-    liftIO (U.freeze tags) >>= U.mapM_ ma . U.filter (/= (-1))-    explImapM_ s ma--  {-# INLINE explImapM #-}-  explImapM (Cache _ tags _ s) ma = do-    as1 <- liftIO (U.freeze tags) >>= mapM ma . U.toList . U.filter (/= (-1))-    as2 <- explImapM s ma-    return (as1 ++ as2)--  type SafeRW (Cache n s) = SafeRW s--  {-# INLINE explGetUnsafe #-}-  explGetUnsafe (Cache n tags cache s) ety = do-    let index = ety `rem` n-    tag <- UM.unsafeRead tags index-    if tag == ety-       then VM.unsafeRead cache index-       else explGetUnsafe s ety-   {-# INLINE explGet #-}   explGet (Cache n tags cache s) ety = do     let index = ety `rem` n     tag <- UM.unsafeRead tags index     if tag == ety-       then Just <$> VM.unsafeRead cache index+       then VM.unsafeRead cache index        else explGet s ety    {-# INLINE explSet #-}@@ -292,39 +132,3 @@       explSet s tag cached     UM.unsafeWrite tags  index ety     VM.unsafeWrite cache index x--  {-# INLINE explSetMaybe #-}-  explSetMaybe = defaultSetMaybe--  {-# INLINE explCmap #-}-  explCmap (Cache n tags cache s) f = do-    forM_ [0..n-1] $ \e -> do-      tag <- UM.read tags e-      unless (tag == (-1)) (VM.modify cache f e)-    explCmap s f--  {-# INLINE explModify #-}-  explModify (Cache n tags cache s) ety f = do-    let index = ety `rem` n-    tag <- UM.read tags index-    if tag == ety-       then VM.modify cache f ety-       else explModify s ety f--  {-# INLINE explCmapM_ #-}-  explCmapM_ (Cache n tags cache s) ma = do-    forM_ [0..n-1] $ \e -> do-      tag <- liftIO$ UM.read tags e-      unless (tag == (-1)) $ do-        r <- liftIO$ VM.read cache e-        void$ ma r-    explCmapM_ s ma--  {-# INLINE explCimapM_ #-}-  explCimapM_ (Cache n tags cache s) ma = do-    forM_ [0..n-1] $ \e -> do-      tag <- liftIO$ UM.read tags e-      unless (tag == (-1)) $ do-        r <- liftIO$ VM.read cache e-        void$ ma (e, r)-    explCimapM_ s ma

@@ -9,7 +9,7 @@ import           Control.Monad.Reader import qualified Data.Vector.Unboxed  as U -import           Apecs.Types+import           Apecs.Core  -- | Run a system with a game world {-# INLINE runSystem #-}@@ -21,182 +21,85 @@ runWith :: w -> System w a -> IO a runWith = flip runSystem --- | A slice containing all entities with component @c@-{-# INLINE owners #-}-owners :: forall c w. Has w 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 => 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 => 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.-{-# INLINE resetStore #-}-resetStore :: forall w c p. Has w 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. Has w c => Entity c -> System w (Safe c)-get (Entity ety) = do s :: Storage c <- getStore-                      liftIO$ Safe <$> explGet s ety---- | Same as @get@, but does not return a safe value and therefore errors if the target component is not present.-{-# INLINE getUnsafe #-}-getUnsafe :: forall w c. Has w c => Entity c -> System w c-getUnsafe (Entity ety) = do s :: Storage c <- getStore-                            liftIO$ explGetUnsafe s ety+get :: forall w c. Has w c => Entity -> System w c+get (Entity ety) = do+  s :: Storage c <- getStore+  liftIO$ explGet s ety  -- | Writes a component to a given entity. Will overwrite existing components. --   The type was originally 'Entity c -> c -> System w ()', but is relaxed to 'Entity e' --   so you don't always have to write 'set . cast' {-# INLINE set #-}-set :: forall w c e. Has w c => Entity e -> c -> System w ()+set :: forall w c. Has w c => Entity -> 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-{-# INLINE set' #-}-set' :: forall w c. Has w c => Entity c -> Safe c -> System w ()-set' (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. Has w c => Entity c -> (c -> c) -> System w ()-modify (Entity ety) f = do+-- | Returns whether the given entity has component @c@+--   Note that @c@ is a phantom argument, used only to convey the type of the entity to be queried.+{-# INLINE exists #-}+exists :: forall w c. Has w c => Entity -> c -> System w Bool+exists (Entity ety) ~_ = 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 => (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-      => (Entity c -> System w a) -> System w [a]-imapM sys = do s :: Storage c <- getStore-               explImapM s (sys . Entity)+  liftIO$ explExists s ety --- | Maps a pure function over all components+-- | Maps a function over all entities with a @cx@, and writes their @cy@ {-# INLINE cmap #-}-cmap :: forall world c. Has world c => (c -> c) -> System world ()-cmap f = do s :: Storage c <- getStore-            liftIO$ explCmap s f---- | 'mapM_' version of 'cmap'-{-# INLINE cmapM_ #-}-cmapM_ :: forall w c. Has w c => (c -> System w ()) -> System w ()-cmapM_ sys = do s :: Storage c <- getStore-                explCmapM_ s sys---- | indexed 'cmapM_', also gives the current entity.-{-# INLINE cimapM_ #-}-cimapM_ :: forall w c. Has w c => ((Entity c, c) -> System w ()) -> System w ()-cimapM_ sys = do s :: Storage c <- getStore-                 explCimapM_ s (\(e,c) -> sys (Entity e,c))+cmap :: forall world cx cy. (Has world cx, Has world cy)+     => (cx -> cy) -> System world ()+cmap f = do+  sx :: Storage cx <- getStore+  sy :: Storage cy <- getStore+  liftIO$ do+    sl <- liftIO$ explMembers sx+    U.forM_ sl $ \ e -> do+      r <- explGet sx e+      explSet sy e (f r) --- | mapM version of cmap. Can be used to get a list of entities---   As the type signature implies, and unlike 'cmap', the return value is not written to the component store.+-- | Monadically iterates over all entites with a cx {-# INLINE cmapM #-}-cmapM :: forall w c a. Has w c => (c -> System w a) -> System w [a]-cmapM sys = do s :: Storage c <- getStore-               explCmapM s sys---- | indexed 'cmapM', also gives the current entity.-{-# INLINE cimapM #-}-cimapM :: forall w c a. Has w 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))---- | Maps a function that might delete its components-{-# INLINE cmap' #-}-cmap' :: forall world c. Has world 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)-      => (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)-      => (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)-     => (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)-      => (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)+cmapM :: forall world c a. Has world c+      => (c -> System world a) -> System world [a]+cmapM sys = do+  s :: Storage c <- getStore+  sl <- liftIO$ explMembers s+  forM (U.toList sl) $ \ ety -> do+    x <- liftIO$ explGet s ety+    sys x --- | Reads a global value-{-# INLINE getGlobal #-}-getGlobal :: forall w c. (Has w c, GlobalStore (Storage c)) => System w c-getGlobal = do s :: Storage c <- getStore-               liftIO$ explGet s 0+-- | Monadically iterates over all entites with a cx+{-# INLINE cmapM_ #-}+cmapM_ :: forall world c a. Has world c+       => (c -> System world a) -> System world ()+cmapM_ sys = do+  s :: Storage c <- getStore+  sl <- liftIO$ explMembers s+  U.forM_ sl $ \ ety -> do+    x <- liftIO$ explGet s ety+    sys x --- | Writes a global value-{-# INLINE setGlobal #-}-setGlobal :: forall w c. (Has w c, GlobalStore (Storage c)) => c -> System w ()-setGlobal c = do s :: Storage c <- getStore-                 liftIO$ explSet s 0 c+-- | Destroys component @c@ for the given entity.+-- Note that @c@ is a phantom argument, used only to convey the type of the entity to be destroyed.+{-# INLINE destroy #-}+destroy :: forall w c. Has w c => Entity -> c -> System w ()+destroy (Entity ety) ~_ = do+  s :: Storage c <- getStore+  liftIO$ explDestroy s ety --- | Modifies a global value-{-# INLINE modifyGlobal #-}-modifyGlobal :: forall w c. (Has w c, GlobalStore (Storage c)) => (c -> c) -> System w ()-modifyGlobal f = getGlobal >>= setGlobal . f+-- | Applies a function, if possible.+{-# INLINE modify #-}+modify :: forall w c. Has 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) +-- | Counts the number of entities with a @c@+{-# INLINE count #-}+count :: forall w c. Has w c => c -> System w Int+count ~_ = do+  s :: Storage c <- getStore+  sl <- liftIO$ explMembers s+  return $ U.length sl

@@ -18,25 +18,18 @@   getStore = (,) <$> getStore <*> getStore  instance (Store a, Store b) => Store (a,b) where-  type Stores (a, b) = (Stores a, Stores b)+  type Elem (a, b) = (Elem a, Elem b)   type SafeRW (a, b) = (SafeRW a, SafeRW b)   initStore = (,) <$> initStore <*> initStore -  explGet       (sa,sb) ety = (,) <$> explGet sa ety <*> explGet sb ety   explSet       (sa,sb) ety (wa,wb) = explSet sa ety wa >> explSet sb ety wb-  explReset     (sa,sb) = explReset sa >> explReset sb   explDestroy   (sa,sb) ety = explDestroy sa ety >> explDestroy sb ety   explExists    (sa,sb) ety = explExists sa ety >>= \case False -> return False                                                           True  -> explExists sb ety   explMembers   (sa,sb) = explMembers sa >>= U.filterM (explExists sb)-  explGetUnsafe (sa,sb) ety = (,) <$> explGetUnsafe sa ety <*> explGetUnsafe sb ety-  explSetMaybe  (sa,sb) ety (wa,wb) = explSetMaybe sa ety wa >> explSetMaybe sb ety wb-  {-# INLINE explGetUnsafe #-}   {-# INLINE explGet #-}   {-# INLINE explSet #-}-  {-# INLINE explSetMaybe #-}   {-# INLINE explMembers #-}-  {-# INLINE explReset #-}   {-# INLINE explDestroy #-}   {-# INLINE explExists #-} --}@@ -78,12 +71,10 @@       sequenceAll = foldl1 (\a x -> AppE (AppE (VarE$ mkName ">>") a) x)        strN  = mkName "Store"-      strsN = mkName "Stores"-      safeN = mkName "SafeRW"+      strsN = mkName "Elem"        strT  var = ConT strN  `AppT` var       strsT var = ConT strsN `AppT` var-      safeT var = ConT safeN `AppT` var        sNs = [ mkName $ "s_" ++ show i | i <- [0..n-1]]       sPat = ConP tupleName (VarP <$> sNs)@@ -95,33 +86,24 @@       wPat = ConP tupleName (VarP <$> wNs)       wEs = VarE <$> wNs -      explGetN       = mkName "explGet"-      explSetN       = mkName "explSet"-      explResetN     = mkName "explReset"-      explDestroyN   = mkName "explDestroy"-      explExistsN    = mkName "explExists"-      explMembersN   = mkName "explMembers"-      explGetUnsafeN = mkName "explGetUnsafe"-      explSetMaybeN  = mkName "explSetMaybe"-      initStoreN     = mkName "initStore"+      explSetN     = mkName "explSet"+      explDestroyN = mkName "explDestroy"+      explExistsN  = mkName "explExists"+      explMembersN = mkName "explMembers"+      explGetN     = mkName "explGet"+      initStoreN   = mkName "initStore" -      explGetE       = VarE explGetN-      explSetE       = VarE explSetN-      explResetE     = VarE explResetN-      explDestroyE   = VarE explDestroyN-      explExistsE    = VarE explExistsN-      explMembersE   = VarE explMembersN-      explGetUnsafeE = VarE explGetUnsafeN-      explSetMaybeE  = VarE explSetMaybeN+      explSetE     = VarE explSetN+      explDestroyE = VarE explDestroyN+      explExistsE  = VarE explExistsN+      explMembersE = VarE explMembersN+      explGetE     = VarE explGetN -      explGetF sE = AppE explGetE sE `AppE` etyE       explSetF sE wE = AppE explSetE sE `AppE` etyE `AppE` wE-      explResetF sE = AppE explResetE sE       explDestroyF sE = AppE explDestroyE sE `AppE` etyE       explExistsF sE = AppE explExistsE sE       explMembersF sE = AppE explMembersE sE-      explGetUnsafeF sE = AppE explGetUnsafeE sE `AppE` etyE-      explSetMaybeF sE wE = AppE explSetMaybeE sE `AppE` etyE `AppE` wE+      explGetF sE = AppE explGetE sE `AppE` etyE        explExistsAnd va vb = AppE (AppE (VarE '(>>=)) va)                                  (LamCaseE [ Match (ConP 'False []) (NormalB$ AppE (VarE 'return) (ConE 'False)) []@@ -132,20 +114,11 @@        strI = InstanceD Nothing (strT <$> vars) (strT varTuple)         [ TySynInstD strsN $ TySynEqn [varTuple] (tupleUpT $ fmap strsT vars)-        , TySynInstD safeN $ TySynEqn [varTuple] (tupleUpT $ fmap safeT vars) -        , FunD explGetN [Clause [sPat, etyPat]-            (NormalB$ liftAll tuplE (explGetF <$> sEs)) [] ]-        , PragmaD$ InlineP explGetN Inline FunLike AllPhases-         , FunD explSetN [Clause [sPat, etyPat, wPat]             (NormalB$ sequenceAll (zipWith explSetF sEs wEs)) [] ]         , PragmaD$ InlineP explSetN Inline FunLike AllPhases -        , FunD explResetN [Clause [sPat]-            (NormalB$ sequenceAll (explResetF <$> sEs)) [] ]-        , PragmaD$ InlineP explResetN Inline FunLike AllPhases-         , FunD explDestroyN [Clause [sPat, etyPat]             (NormalB$ sequenceAll (explDestroyF <$> sEs)) [] ]         , PragmaD$ InlineP explDestroyN Inline FunLike AllPhases@@ -158,13 +131,9 @@             (NormalB$ foldl explMembersFold (explMembersF (head sEs)) (explExistsF <$> tail sEs)) [] ]         , PragmaD$ InlineP explMembersN Inline FunLike AllPhases -        , FunD explGetUnsafeN [Clause [sPat, etyPat]-            (NormalB$ liftAll tuplE (explGetUnsafeF <$> sEs)) [] ]-        , PragmaD$ InlineP explGetUnsafeN Inline FunLike AllPhases--        , FunD explSetMaybeN [Clause [sPat, etyPat, wPat]-            (NormalB$ sequenceAll (zipWith explSetMaybeF sEs wEs)) [] ]-        , PragmaD$ InlineP explSetMaybeN Inline FunLike AllPhases+        , FunD explGetN [Clause [sPat, etyPat]+            (NormalB$ liftAll tuplE (explGetF <$> sEs)) [] ]+        , PragmaD$ InlineP explGetN Inline FunLike AllPhases          , FunD initStoreN [Clause []             (NormalB$ liftAll tuplE (VarE initStoreN <$ sEs)) [] ]

@@ -1,148 +0,0 @@-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE TypeFamilies               #-}--module Apecs.Types where--import           Control.Monad.Reader-import           Data.Traversable     (for)-import qualified Data.Vector.Unboxed  as U--import qualified Apecs.THTuples       as T---- | 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 Store.-class (Stores (Storage c) ~ c, Store (Storage c)) => Component c where-  type Storage c---- | A world `Has` a component if it can produce its Storage-class Component c => Has w c where-  getStore :: System w (Storage c)---- | 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)}---- | Holds components indexed by entities-class Store s where-  -- | The type of components stored by this Store-  type Stores s-  -- | Return type for safe reads writes to the store-  type SafeRW s--  -- Initialize the store with its initialization arguments.-  initStore :: IO s--  -- | Retrieves a component from the store-  explGet :: s -> Int -> IO (SafeRW s)-  -- | Writes a component-  explSet :: s -> Int -> Stores s -> IO ()-  -- | 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-  explExists s n = do-    mems <- explMembers s-    return $ U.elem n mems--  -- | Returns an unboxed vector of member indices-  explMembers :: s -> IO (U.Vector Int)--  -- | Unsafe index to the store. What happens if the component does not exist is left undefined.-  explGetUnsafe :: s -> Int -> IO (Stores s)-  -- | Either writes or deletes a component-  explSetMaybe :: s -> Int -> SafeRW s -> IO ()--  -- | Removes all components.-  --   Equivalent to calling @explDestroy@ on each member-  {-# 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--  -- | Modifies an element in the store.-  --   Equivalent to reading a value, and then writing the result of the function application.-  {-# 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.-  --   Equivalent to getting a list of all entities with this component, and then explModifying each of them.-  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)---- | Class of storages for global values-class (SafeRW s ~ Stores s, Store s) => GlobalStore s where---- | Casts for entities and slices-class Cast m where cast :: forall a. m a -> forall b. m b--instance Cast Entity where-  {-# INLINE cast #-}-  cast (Entity ety) = Entity ety-instance Cast Slice where-  {-# INLINE cast #-}-  cast (Slice vec) = Slice vec---- Tuple Instances-T.makeInstances [2..6]--instance (GlobalStore a, GlobalStore b) => GlobalStore (a,b) where-instance (GlobalStore a, GlobalStore b, GlobalStore c) => GlobalStore (a,b,c) where

@@ -9,7 +9,7 @@ module Apecs.Util (   -- * Utility   initStore, runGC,-  proxy,+  global, proxy,    -- * EntityCounter   EntityCounter, nextEntity, newEntity,@@ -21,9 +21,6 @@   -- * Timing   timeSystem, timeSystem_, -  -- * List functions-  listAllE, listAllC, listAllEC,-   ) where  import           Control.Applicative  (liftA2)@@ -34,52 +31,42 @@  import           Apecs.Stores import           Apecs.System-import           Apecs.Types+import           Apecs.Core --- | A proxy entity for TODO-proxy :: Entity c-proxy = Entity (-1)+global :: Entity+global = Entity (-1) +proxy :: forall t. t+proxy = error "proxy entity"+ -- | Secretly just an int in a newtype-newtype EntityCounter = EntityCounter {getCounter :: Sum Int} deriving (Monoid, Num, Eq, Show)+newtype EntityCounter = EntityCounter {getCounter :: Sum Int} deriving (Monoid, Eq, Show)  instance Component EntityCounter where   type Storage EntityCounter = Global EntityCounter  -- | Bumps the EntityCounter and yields its value {-# INLINE nextEntity #-}-nextEntity :: Has w EntityCounter => System w (Entity ())-nextEntity = do n <- getGlobal-                setGlobal (n+1)-                return (Entity . getSum . getCounter $ n)+nextEntity :: Has w EntityCounter => System w Entity+nextEntity = do EntityCounter n <- get global+                set global (EntityCounter $ n+1)+                return (Entity . getSum $ n)  -- | Writes the given components to a new entity, and yields that entity {-# INLINE newEntity #-} newEntity :: (Store (Storage c), Has w c, Has w EntityCounter)-          => c -> System w (Entity c)+          => c -> System w Entity newEntity c = do ety <- nextEntity                  set ety c-                 return (cast ety)+                 return ety  -- | Explicitly invoke the garbage collector runGC :: System w () runGC = liftIO performMajorGC --- | imapM return-listAllE :: Has w c => System w [Entity c]-listAllE = imapM return---- | cmapM return-listAllC :: Has w c => System w [c]-listAllC = cmapM return---- | cimapM return-listAllEC :: Has w c => System w [(Entity c, c)]-listAllEC = cimapM return- -- $hash--- The following functions are for spatial hashing.--- The idea is that your spatial hash is defined by two vectors;+-- The following are helper functions for spatial hashing.+-- Your spatial hash is defined by two vectors; -- --   - The cell size vector contains real components and dictates --     how large each cell in your table is in world space units.@@ -87,10 +74,6 @@ --   - The table size vector contains integral components and dictates how --     many cells your field consists of in each direction. --     It is used by @flatten@ to translate a table-space index vector into a flat integer------ There is currently no dedicated spatial hashing log, but you can use--- an EnumTable by defining an instance Enum Vec with--- > fromEnum = flatten size . quantize cell  -- | Quantize turns a world-space coordinate into a table-space coordinate by dividing --   by the given cell size and rounding towards negative infinity.

@@ -17,12 +17,14 @@ import Data.List (sort)  import Apecs-import Apecs.Types+import Apecs.Core import Apecs.Stores-import Apecs.Logs import Apecs.Util-import qualified Apecs.Slice as Sl +{--++Need to be rewritten for apecs 0.3!+ type Vec = (Double, Double)  -- Preamble@@ -152,5 +154,8 @@   G x <- getGlobal   return $ x == True + return [] main = $quickCheckAll+--}+main = return ()

@@ -1,4 +1,11 @@ ## apecs tutorial++##### Warning!+With the release of apecs 0.3, this tutorial does not (fully) apply anymore.+The main difference is that mapping operations have been consolidated in `cmap`.+The rts executable has been removed and there is a new example game, `shmup`, in the examples project.+I will either update or delete this tutorial soon.+ ### An RTS-like game  In this tutorial we'll take a look at how to write a simple RTS-like game using apecs.@@ -7,25 +14,22 @@ We'll only be drawing single pixels to the screen, so it should be pretty easy to follow what's going on. The final result can be found [here](https://github.com/jonascarpay/apecs/blob/master/examples/RTS.hs). You can run it with `stack build && stack exec rts`.-I will be skipping some details, so make sure to keep it handy if you want to follow along.+I will be skipping some details, so make sure to keep the source code handy if you want to follow along.  #### Entity Component Systems Entity Component Systems are frameworks for game engines. The concept is as follows:  Your game world consists of entities.-An entity is an ID and a collection of components.-Examples of components include position, velocity, health, and 3D model.-All of the entity's state is captured by the components it holds.-The game logic is then defined in systems that operate on the game world.-This is taking the [component pattern](http://gameprogrammingpatterns.com/component.html) to the extreme, where we can arbitrarily add and remove components from entities.-An example of a system is one that looks at all entities with both a position and a velocity, and adds their velocity to their position.+An entity is essentially an ID and a collection of components.+Components are pieces of data like position, velocity, health, or 3D model. -What makes most ECS fast is that we can store components of the same type together.-In fact, by storing each component together with the ID of the entity it belongs to, an entity becomes implicit altogether;-an entity can be said to exist as long as there is at least one component associating itself with that entity's ID.+The game logic is defined in systems that operate on the game world.+The typical example of a system is one that looks at all entities with both a position and a velocity, and adds their velocity to their position. -Once you understand this, the API is relatively straightforward.+As in most ECS, components are stored together in memory, indexed by entity.+This makes entities mostly implicit;+an entity can be said to exist as long as there is at least one component associating itself with that entity's ID.  #### Components In our game, we want to be able to select units and order them around.@@ -34,7 +38,6 @@ First up is position. A `Position` is just a two-dimensional vector of `Double`s. When defining a data type as a component, you have to specify how the component is stored in memory.-At the root of a storage you'll generally find one of three kinds of storage; a `Map`, `Set`, or `Global`. In this case, we can simply store the position in a `Map`. ```haskell newtype Position = Position {getPos :: V2 Double} deriving (Show, Num)@@ -102,10 +105,10 @@ When actually executing the game, we produce a world in the IO monad like this: ```haskell initWorld = do-  positions  <- initStore -- initStore = initStoreWith (), used to initialize most stores+  positions  <- initStore   targets    <- initStore   selected   <- initStore-  mouseState <- initStore -- A global needs to be initialized with a value+  mouseState <- initStore   counter    <- initStore   return $ World positions targets selected counter ```