nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

update ecstasy

Browse source
This commit is contained in:
nek0 2018-05-17 13:06:13 +02:00
parent b59b566905
commit 53d2ce4cf6
6 changed files with 54 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
shell.nix
View file

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

2
src/Init.hs
View file

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

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

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

2
src/Types/UserData.hs
View file

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

2
tracer-game.cabal
View file

@ -42,7 +42,7 @@ executable tracer-game
, stm
, text
, containers
, ecstasy
, ecstasy >= 0.2.1.0
, linear
, matrix
, random