try ecstasy

src/Test.hs

@@ -6,10 +6,11 @@ import SDL (get, ($=))
 import qualified SDL
 import qualified Graphics.Rendering.OpenGL as GL hiding (get)
 
-import Control.Monad (when)
+import Control.Monad (when, void)
 import Control.Monad.IO.Class (liftIO)
 
 import Data.Matrix (toLists)
+import Data.Ecstasy as E
 
 import NanoVG hiding (V2(..))
 
@@ -29,19 +30,27 @@ 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
+    void $ newEntity $ defEntity
+      { pos = Just (V2 20 20)
+      , vel = Just (V2 0 0)
+      , player = Just True
+      }
+    getWorld
   uu <- partSubscribe m movePlayer
   putAffection ud
-    { stateData = MenuData
+    { world = nworld
+    , stateData = MenuData
       { mapMat = matrix
-      , initCoords = (0, 500)
-      , playerCoords = (20, 20)
+      -- , initCoords = (0, 500)
+      -- , playerCoords = (20, 20)
       }
     , uuid = [uu]
     }
 
 relativizeMouseCoords :: V2 Int32 -> IO (V2 Double)
 relativizeMouseCoords (V2 ix iy) = do
-  (GL.Position vx vy, GL.Size vw vh) <- get GL.viewport
+  (GL.Position vx vy, GL.Size vw vh) <- SDL.get GL.viewport
   let rx = ix - vx
       ry = iy - vy
       hx = fromIntegral vw / 2
@@ -50,19 +59,42 @@ relativizeMouseCoords (V2 ix iy) = do
       dy = fromIntegral ry - hy
   return $ V2 (dx / hx) (dy / hy)
 
-movePlayer :: MouseMessage -> Affection UserData ()
-movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] mv2@(V2 mx my) _) = do
+mouseToPlayer :: V2 Int32 -> Affection UserData ()
+mouseToPlayer mv2 = do
   ud <- getAffection
   rela@(V2 rx ry) <- liftIO $ relativizeMouseCoords mv2
   let dr = (- ry) + (- rx)
       dc = (- rx) - (- ry) / 2
-      (pr, pc) = playerCoords $ stateData ud
-  liftIO $ traceIO $ "delta: " ++ show (V2 rx ry)
-  liftIO $ traceIO $ "movement: " ++ show (V2 dr dc)
+      -- (pr, pc) = playerCoords $ stateData ud
+  nworld <- runSystemT (world ud) $ do
+    emap $ do
+      with player
+      pure $ defEntity'
+        { vel = Set $ V2 dr dc
+        }
+    getWorld
   putAffection ud
-    { stateData = (stateData ud)
-      { playerCoords = (pr - dr, pc - dc)
-      }
+    { world = nworld
+    --   stateData = (stateData ud)
+    --   { 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
+  ud <- getAffection
+  nw <- runSystemT (world ud) $ do
+    emap $ do
+      with player
+      pure $ defEntity'
+        { vel = Set $ V2 0 0
+        }
+    getWorld
+  putAffection ud
+    { world = nw
     }
 movePlayer _ = return ()
 
@@ -73,12 +105,34 @@ drawMap = do
   mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [0..] ls))
     (zip [0..] (toLists matrix))
 
+updateMap :: Double -> Affection UserData ()
+updateMap _ = do
+  ud <- getAffection
+  nw <- runSystemT (world ud) $ do
+    emap $ do
+      with player
+      pos' <- E.get pos
+      vel' <- E.get vel
+      pure $ defEntity'
+        { pos = Set $ pos' + vel'
+        }
+    getWorld
+  putAffection ud
+    { world = nw
+    }
+
 drawTile :: Int -> Int -> TileState -> Affection UserData ()
 drawTile row col tile = do
   ud <- getAffection
-  let ctx = nano ud
-      (xinit, yinit) = initCoords $ stateData ud
-      (pr, pc) = playerCoords $ stateData ud
+  playerPos <- runSystemT (world ud) $ do
+        efor $ \_ -> do
+          with player
+          pos' <- E.get pos
+          pure pos'
+  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

@@ -33,8 +33,8 @@ data StateData
   = None
   | MenuData
     { mapMat :: Matrix TileState
-    , initCoords :: (Int, Int)
-    , playerCoords :: (Double, Double)
+    -- , initCoords :: (Int, Int)
+    -- , playerCoords :: (Double, Double)
     }
 
 data ImgId
@@ -51,10 +51,11 @@ data Direction
   | SE
 
 data Entity f = Entity
-  { pos    :: Component f 'Field (V2 Float)
-  , vel    :: Component f 'Field (V2 Float)
-  , rot    :: Component f 'Field Direction
-  , player :: Component f 'Unique Bool
+  { pos     :: Component f 'Field (V2 Double)
+  , gridPos :: Component f 'Field (V2 Int)
+  , vel     :: Component f 'Field (V2 Double)
+  , rot     :: Component f 'Field Direction
+  , player  :: Component f 'Unique Bool
   }
   deriving (Generic)