Merge pull request #1 from nek0/ecstasy

now works with ecstasy. ready to merge.
This commit is contained in:
rys ostrovid 2018-02-24 15:35:01 +01:00 committed by GitHub
commit ba6cc36f9b
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
4 changed files with 17 additions and 18 deletions

View file

@ -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
}

View file

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

View file

@ -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)
dc = (- rx) - (- ry) / 2
(pr, pc) = playerCoords $ stateData ud
nworld <- runSystemT (world ud) $ do
let dr = ry + rx
dc = rx - ry / 2
(nws, nworld) <- yieldSystemT (worldState ud) $ do
emap $ do
with player
pure $ defEntity'
@ -75,18 +74,16 @@ mouseToPlayer mv2 = do
getWorld
putAffection ud
{ world = nworld
, stateData = (stateData ud)
{ playerCoords = (pr - dr, pc - dc)
}
, worldState = nws
}
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

View file

@ -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