From 53d2ce4cf62afd88d305a17e38ea23cce32a4f4b Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 17 May 2018 13:06:13 +0200 Subject: [PATCH] update ecstasy --- shell.nix | 20 ++++++++++++++++-- src/Init.hs | 2 +- src/NPC.hs | 18 ++++++++-------- src/Test.hs | 48 +++++++++++++++++++++---------------------- src/Types/UserData.hs | 2 +- tracer-game.cabal | 2 +- 6 files changed, 54 insertions(+), 38 deletions(-) diff --git a/shell.nix b/shell.nix index 354cfe7..4dfee62 100644 --- a/shell.nix +++ b/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; diff --git a/src/Init.hs b/src/Init.hs index 68b3928..8536939 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -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 diff --git a/src/NPC.hs b/src/NPC.hs index b603bbd..cfab60f 100644 --- a/src/NPC.hs +++ b/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 } diff --git a/src/Test.hs b/src/Test.hs index a2d888d..b09278c 100644 --- a/src/Test.hs +++ b/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) diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index d279f40..5e1c231 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -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 } diff --git a/tracer-game.cabal b/tracer-game.cabal index 2e497fc..9db6e58 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -42,7 +42,7 @@ executable tracer-game , stm , text , containers - , ecstasy + , ecstasy >= 0.2.1.0 , linear , matrix , random