now works with ecstasy. ready to merge.

This commit is contained in:
nek0 2018-02-24 15:33:46 +01:00
parent 92dff10c64
commit 153b5a4e3d
4 changed files with 17 additions and 18 deletions

View file

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

View file

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

View file

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

View file

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