now works with ecstasy. ready to merge.

src/Init.hs

@@ -39,7 +39,7 @@ load = do
   subs <- Subsystems
     <$> (Window <$> newTVarIO [])
     <*> (Mouse <$> newTVarIO [])
-  w <- runSystemT defWorld getWorld
+  (ws, w) <- yieldSystemT (0, defWorld) (getWorld)
   let fc = FloorConfig (20, 45) [(5, 5), (30,80)] (40, 90)
   floor <- buildHallFloorIO fc
   traceIO $ show floor
@@ -50,5 +50,6 @@ load = do
     , nano        = nvg
     , uuid        = []
     , world       = w
+    , worldState  = ws
     , stateData   = None
     }

src/StateMachine.hs

@@ -11,7 +11,7 @@ import Test
 instance StateMachine State UserData where
   smLoad Menu = loadMap
 
-  smUpdate Menu = const $ return ()
+  smUpdate Menu = updateMap
 
   smDraw Menu = drawMap
 

src/Test.hs

@@ -30,7 +30,7 @@ loadMap = do
   let fc = FloorConfig (20, 20) [(5,5), (45, 95)] (50,100)
       (Subsystems _ m) = subsystems ud
   matrix <- liftIO $ buildHallFloorIO fc
-  nworld <- runSystemT (world ud) $ do
+  (nws, nworld) <- yieldSystemT (worldState ud) $ do
     void $ newEntity $ defEntity
       { pos = Just (V2 20 20)
       , vel = Just (V2 0 0)
@@ -40,10 +40,10 @@ loadMap = do
   uu <- partSubscribe m movePlayer
   putAffection ud
     { world = nworld
+    , worldState = nws
     , stateData = MenuData
       { mapMat = matrix
       , initCoords = (0, 500)
-      , playerCoords = (20, 20)
       }
     , uuid = [uu]
     }
@@ -63,10 +63,9 @@ mouseToPlayer :: V2 Int32 -> Affection UserData ()
 mouseToPlayer mv2 = do
   ud <- getAffection
   rela@(V2 rx ry) <- liftIO $ relativizeMouseCoords mv2
-  let dr = (- ry) + (- rx)
+  let dr = ry + rx
-      dc = (- rx) - (- ry) / 2
+      dc = rx - ry / 2
-      (pr, pc) = playerCoords $ stateData ud
+  (nws, nworld) <- yieldSystemT (worldState ud) $ do
-  nworld <- runSystemT (world ud) $ do
     emap $ do
       with player
       pure $ defEntity'
@@ -75,18 +74,16 @@ mouseToPlayer mv2 = do
     getWorld
   putAffection ud
     { world = nworld
-    , stateData = (stateData ud)
+    , worldState = nws
-      { playerCoords = (pr - dr, pc - dc)
-      }
     }
 
 movePlayer :: MouseMessage -> Affection UserData ()
 movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] m _) = mouseToPlayer m
 movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) =
   mouseToPlayer m
-movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = do
+movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ m) = do
   ud <- getAffection
-  nw <- runSystemT (world ud) $ do
+  (nws, nw) <- yieldSystemT (worldState ud) $ do
     emap $ do
       with player
       pure $ defEntity'
@@ -95,6 +92,7 @@ movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = do
     getWorld
   putAffection ud
     { world = nw
+    , worldState = nws
     }
 movePlayer _ = return ()
 
@@ -108,7 +106,7 @@ drawMap = do
 updateMap :: Double -> Affection UserData ()
 updateMap _ = do
   ud <- getAffection
-  nw <- runSystemT (world ud) $ do
+  (nws, nw) <- yieldSystemT (worldState ud) $ do
     emap $ do
       with player
       pos' <- E.get pos
@@ -119,20 +117,20 @@ updateMap _ = do
     getWorld
   putAffection ud
     { world = nw
+    , worldState = nws
     }
 
 drawTile :: Int -> Int -> TileState -> Affection UserData ()
 drawTile row col tile = do
   ud <- getAffection
-  playerPos <- runSystemT (world ud) $ do
+  (_, playerPos) <- yieldSystemT (worldState ud) $ do
         efor $ \_ -> do
           with player
           pos' <- E.get pos
           pure pos'
-  let -- V2 pr pc = head playerPos
+  let V2 pr pc = head playerPos
       ctx = nano ud
       (xinit, yinit) = initCoords $ stateData ud
-      (pr, pc) = playerCoords $ stateData ud
       tileWidth = 20 :: Double
       tileHeight = 10 :: Double
   liftIO $ do

src/Types/UserData.hs

@@ -22,6 +22,7 @@ data UserData = UserData
   , nano        :: Context
   , uuid        :: [UUID]
   , world       :: Entity 'WorldOf
+  , worldState  :: SystemState Entity
   , stateData   :: StateData
   }
 
@@ -34,7 +35,6 @@ data StateData
   | MenuData
     { mapMat :: Matrix TileState
     , initCoords :: (Int, Int)
-    , playerCoords :: (Double, Double)
     }
 
 data ImgId