update ecstasy
This commit is contained in:
nek0
parent
b59b566905
commit
53d2ce4cf6
6 changed files with 54 additions and 38 deletions
20
shell.nix
20
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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
18
src/NPC.hs
18
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
|
||||
}
|
||||
|
||||
|
|
|
|||
48
src/Test.hs
48
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
|
||||
void $ newEntity $ defEntity
|
||||
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
|
||||
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
|
||||
emap $ do
|
||||
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ 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
|
||||
emap $ do
|
||||
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ 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
|
||||
pc <- efor $ \_ -> do
|
||||
(_, (playerPos, npcposs)) <- liftIO $ yieldSystemT (worldState ud) $ 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
|
||||
emap $ do
|
||||
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
|
||||
emap allEnts $ do
|
||||
without player
|
||||
with vel
|
||||
with velFact
|
||||
with pos
|
||||
pos'@(V2 pr pc) <- E.get pos
|
||||
vel' <- E.get vel
|
||||
fact' <- E.get velFact
|
||||
pos'@(V2 pr pc) <- query pos
|
||||
vel' <- query vel
|
||||
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
|
||||
vel' <- E.get vel
|
||||
pos'@(V2 pr pc) <- query pos
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ executable tracer-game
|
|||
, stm
|
||||
, text
|
||||
, containers
|
||||
, ecstasy
|
||||
, ecstasy >= 0.2.1.0
|
||||
, linear
|
||||
, matrix
|
||||
, random
|
||||
|
|
|
|||
Loading…
Reference in a new issue