update ecstasy

shell.nix

@@ -61,7 +61,23 @@ let
       hydraPlatforms = pkgs.stdenv.lib.platforms.none;
     }) { };
 
-  f = { mkDerivation, astar, base, containers, ecstasy, linear
+  ecstasyNeko = with haskellPackages; callPackage ({
+    mkDerivation, base, containers, kan-extensions, mtl, stdenv
+    , transformers
+    }:
+    mkDerivation {
+      pname = "ecstasy";
+      version = "0.2.1.0";
+      sha256 = "915942d3b8c3d61b98e5b2e825387d48cf3c2d17acdb2d377cb516c26c0fcbc3";
+      libraryHaskellDepends = [
+        base containers kan-extensions mtl transformers
+      ];
+      homepage = "http://github.com/isovector/ecstasy/";
+      description = "A GHC.Generics based entity component system.";
+      license = stdenv.lib.licenses.bsd3;
+    }) {};
+
+  f = { mkDerivation, astar, base, containers, linear
       , matrix, OpenGL, random, sdl2, stdenv, stm, text, unordered-containers
       , vector
       }:
@@ -73,7 +89,7 @@ let
         isExecutable = true;
         enableExecutableProfiling = true;
         executableHaskellDepends = [
-          affectionNeko astar base containers ecstasy linear matrix nanovgNeko
+          affectionNeko astar base containers ecstasyNeko linear matrix nanovgNeko
           OpenGL random sdl2 stm text unordered-containers vector
         ];
         license = stdenv.lib.licenses.gpl3;

src/Init.hs

@@ -43,7 +43,7 @@ load = do
   subs <- Subsystems
     <$> (Window <$> newTVarIO [])
     <*> (Mouse <$> newTVarIO [])
-  (ws, _) <- yieldSystemT (0, defWorld) (return ())
+  (ws, _) <- yieldSystemT (0, defStorage) (return ())
   mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
   mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
   mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0

src/NPC.hs

@@ -111,17 +111,17 @@ updateNPCs
   -> Double
   -> SystemT Entity m ()
 updateNPCs imgmat rp dt =
-  emap $ do
+  emap allEnts $ do
     with npcState
     with vel
     with pos
-    npcState' <- E.get npcState
+    npcState' <- query npcState
     case npcState' of
       NPCStanding ttl future -> do
         let nttl = ttl - dt
         if nttl > 0
         then
-          return $ defEntity'
+          return $ unchanged
             { npcState = Set $ NPCStanding nttl future
             , vel      = Set $ V2 0 0
             }
@@ -129,32 +129,32 @@ updateNPCs imgmat rp dt =
           mpath <- liftIO $ tryTakeMVar future
           case mpath of
             Just path ->
-              return $ defEntity'
+              return $ unchanged
                 { npcState = Set $ NPCWalking path
                 }
             Nothing ->
-              return $ defEntity'
+              return $ unchanged
                 { npcState = Set $ NPCStanding 1 future
                 }
       NPCWalking path -> do
-        pos' <- E.get pos
+        pos' <- query pos
         if not (null path)
         then do
           let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
           if distance pos' itarget < 0.1
           then
-            return $ defEntity'
+            return $ unchanged
               { npcState = Set $ NPCWalking (tail path)
               }
           else
-            return $ defEntity'
+            return $ unchanged
               { vel = Set $ (* 2) <$> signorm (itarget - pos')
               }
         else do
           ttl <- liftIO $ randomRIO (5, 30)
           future <- liftIO $ newEmptyMVar
           _ <- liftIO $ forkIO $ getPath (fmap floor pos') future rp imgmat
-          return $ defEntity'
+          return $ unchanged
             { npcState = Set $ NPCStanding ttl future
             }
 

src/Test.hs

@@ -58,8 +58,8 @@ loadMap = do
   let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
   liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length nnex)
   npcposs <- placeNPCs inter mat rps gr (length nnex)
-  (nws, _) <- yieldSystemT (worldState ud) $ do
+  (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
-    void $ newEntity $ defEntity
+    void $ createEntity $ newEntity
       { pos = Just (V2 20.5 20.5)
       , vel = Just (V2 0 0)
       , player = Just ()
@@ -69,7 +69,7 @@ loadMap = do
       fact <- liftIO $ randomRIO (0.5, 1.5)
       future <- liftIO $ newEmptyMVar
       _ <- liftIO $ forkIO $ getPath (fmap floor npcpos) future nnex inter
-      newEntity $ defEntity
+      createEntity $ newEntity
         { pos      = Just (V2 (nr + 0.5) (nc + 0.5))
         , vel      = Just (V2 0 0)
         , velFact = Just fact
@@ -97,10 +97,10 @@ mouseToPlayer mv2 = do
   (V2 rx ry) <- liftIO $ relativizeMouseCoords mv2
   let dr = (ry / sin (atan (1/2)) / 2) + rx
       dc = rx - (ry / sin (atan (1/2)) / 2)
-  (nws, _) <- yieldSystemT (worldState ud) $ do
+  (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
-    emap $ do
+    emap allEnts $ do
       with player
-      pure $ defEntity'
+      pure $ unchanged
         { vel = Set $ 4 * V2 dr dc
         }
   putAffection ud
@@ -113,10 +113,10 @@ movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) =
   mouseToPlayer m
 movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do
   ud <- getAffection
-  (nws, _) <- yieldSystemT (worldState ud) $ do
+  (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
-    emap $ do
+    emap allEnts $ do
       with player
-      pure $ defEntity'
+      pure $ unchanged
         { vel = Set $ V2 0 0
         }
   putAffection ud
@@ -128,17 +128,17 @@ drawMap :: Affection UserData ()
 drawMap = do
   ud <- getAffection
   dt <- getDelta
-  (_, (playerPos, npcposs)) <- yieldSystemT (worldState ud) $ do
+  (_, (playerPos, npcposs)) <- liftIO $ yieldSystemT (worldState ud) $ do
-    pc <- efor $ \_ -> do
+    pc <- efor allEnts $ do
       with player
       with pos
-      pos' <- E.get pos
+      pos' <- query pos
       pure pos'
   -- (_, npcposs) <- yieldSystemT (worldState ud) $ do
-    npcs <- efor $ \_ -> do
+    npcs <- efor allEnts $ do
       with npcState
       with pos
-      pos' <- E.get pos
+      pos' <- query pos
       pure pos'
     return (pc, npcs)
   let V2 pr pc = head playerPos
@@ -183,27 +183,27 @@ drawMap = do
 updateMap :: Double -> Affection UserData ()
 updateMap dt = do
   ud <- getAffection
-  (nws, _) <- yieldSystemT (worldState ud) $ do
+  (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
-    emap $ do
+    emap allEnts $ do
       without player
       with vel
       with velFact
       with pos
-      pos'@(V2 pr pc) <- E.get pos
+      pos'@(V2 pr pc) <- query pos
-      vel' <- E.get vel
+      vel' <- query vel
-      fact' <- E.get velFact
+      fact' <- query velFact
       let npos@(V2 nr nc) = pos' + fmap (* (dt * fact')) vel'
           dpos = npos - pos'
-          ent = defEntity'
+          ent = unchanged
             { pos = Set $ npos
             }
       return ent
-    emap $ do
+    emap allEnts $ do
       with player
       with vel
       with pos
-      pos'@(V2 pr pc) <- E.get pos
+      pos'@(V2 pr pc) <- query pos
-      vel' <- E.get vel
+      vel' <- query vel
       let npos@(V2 nr nc) = pos' + fmap (* dt) vel'
           dpos@(V2 dpr dpc) = npos - pos'
           len = sqrt (dpos `dot` dpos)
@@ -230,7 +230,7 @@ updateMap dt = do
           --         in  (fromIntegral (floor (lrow !! i)), fromIntegral (floor (lcol !! i)))
           --         )
           --         [ 0 .. floor len]
-          ent = defEntity'
+          ent = unchanged
             { pos = Set $ pos' + dpos * Prelude.foldl
               (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a
                 in A.log A.Verbose (show ret) ret)

src/Types/UserData.hs

@@ -26,7 +26,7 @@ data UserData = UserData
   , assetFonts  :: M.Map FontId T.Text
   , nano        :: Context
   , uuid        :: [UUID]
-  , worldState  :: SystemState Entity
+  , worldState  :: SystemState Entity IO
   , stateData   :: StateData
   }
 

tracer-game.cabal

@@ -42,7 +42,7 @@ executable tracer-game
                      , stm
                      , text
                      , containers
-                     , ecstasy
+                     , ecstasy >= 0.2.1.0
                      , linear
                      , matrix
                      , random