From 2b86eaf230938843e4f8a36f9905187030858eeb Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 19 Jul 2018 04:51:07 +0200 Subject: [PATCH] detailed loading output --- src/Floorplan.hs | 48 ++++++++++++---- src/Load.hs | 115 +++++++++++++++++++++++++++++++-------- src/MainGame/WorldMap.hs | 26 ++++----- src/MindMap.hs | 22 ++++---- src/Types/UserData.hs | 2 +- src/Util.hs | 7 ++- tracer-game.cabal | 4 +- 7 files changed, 160 insertions(+), 64 deletions(-) diff --git a/src/Floorplan.hs b/src/Floorplan.hs index ec7ff4f..af3dd10 100644 --- a/src/Floorplan.hs +++ b/src/Floorplan.hs @@ -2,6 +2,7 @@ module Floorplan where import Data.Matrix (Matrix(..)) import qualified Data.Matrix as M +import qualified Data.Text as T import Data.Maybe import Control.Monad (foldM) @@ -13,28 +14,55 @@ import Types.Map buildHallFloorIO :: FloorConfig - -> MVar Float + -> MVar (Float, T.Text) -> Float -> IO (Matrix TileState, [Graph]) buildHallFloorIO fc progress increment = do rand <- newStdGen - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "New RNG" + ))) let empty = emptyFloor fc - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Built empty floor" + ))) let (g1, withElv) = buildElevator fc (placeHalls rand fc empty) - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Placed Elevator" + ))) let (g2, withIW) = buildInnerWalls g1 withElv - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Built inner walls" + ))) let withOW = buildOuterWalls withIW - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "built outer walls" + ))) let closed = closeOffices withOW - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Closed offices" + ))) let doorgraph = buildDoorsGraph closed - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Doorgraph" + ))) doors <- buildDoors closed doorgraph - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Build doors" + ))) let (_, facils) = buildFacilities g2 fc doors - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Build facilities" + ))) return (facils, doorgraph) emptyFloor :: FloorConfig -> Matrix TileState diff --git a/src/Load.hs b/src/Load.hs index 19ec3ee..0937a92 100644 --- a/src/Load.hs +++ b/src/Load.hs @@ -10,6 +10,7 @@ import Control.Concurrent.MVar import Control.Monad (when) import qualified Data.Map as M +import qualified Data.Text as T import Data.Ecstasy import Data.Maybe @@ -27,7 +28,7 @@ loadLoad :: Affection UserData () loadLoad = do ad <- A.get ud <- getAffection - progress <- liftIO $ newMVar 0 + progress <- liftIO $ newMVar (0, "Starting up") future <- liftIO $ newEmptyMVar _ <- liftIO $ createFont (nano ud) "bedstead" (FileName "assets/font/Bedstead-Semicondensed.ttf") @@ -55,47 +56,101 @@ loadFork -> SDL.GLContext -> Context -> MVar (SystemState Entity IO, StateData) - -> MVar Float + -> MVar (Float, T.Text) -> IO () loadFork ws win glc nvg future progress = do let stateSteps = 22 increment = 1 / stateSteps SDL.glMakeCurrent win glc - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_asc\"" + ))) mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_desc\"" + ))) mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_corner_n\"" + ))) mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_corner_e\"" + ))) mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_corner_s\"" + ))) mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_corner_w\"" + ))) mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_t_ne\"" + ))) mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_t_se\"" + ))) mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_t_sw\"" + ))) mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_t_nw\"" + ))) mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_cross\"" + ))) mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"box1\"" + ))) mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"table1\"" + ))) mmisctable1 <- createImage nvg (FileName "assets/misc/table1.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"table2\"" + ))) mmisctable2 <- createImage nvg (FileName "assets/misc/table2.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"table3\"" + ))) mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"wall_table4\"" + ))) mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading asset \"tableCorner\"" + ))) mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0 - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading Animation \"intruder: standing\"" + ))) let mimgs = [ mwallasc, mwalldesc, mwallcornern, mwallcornere, mwallcorners, mwallcornerw, mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross, @@ -119,16 +174,28 @@ loadFork ws win glc nvg future progress = do [0 .. length (walkIds 0) - 1] playerStanding <- loadAnimationSprites "assets/intruder.png" nvg (zip (standIds 0) standConfigs) - liftIO $modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading Animation \"intruder: walking\"" + ))) playerWalking <- loadAnimationSprites "assets/intruder.png" nvg (zip (walkIds 0) walkConfigs) - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading Animation \"jdoem: standing\"" + ))) jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg (zip (standIds 1) standConfigs) - liftIO $modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading Animation \"jdoem: walking\"" + ))) jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg (zip (walkIds 1) walkConfigs) - modifyMVar_ progress (return . (+ increment)) + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Handing over" + ))) finish putMVar future ( ws diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index f66649d..1564280 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -44,7 +44,7 @@ loadMap = do uu1 <- partSubscribe m movePlayer uu2 <- partSubscribe k changeMaps future <- liftIO newEmptyMVar - progress <- liftIO $ newMVar 0 + progress <- liftIO $ newMVar (0, "Ohai!") _ <- liftIO $ forkIO $ loadMapFork ud future progress putAffection ud { stateData = None @@ -71,7 +71,7 @@ changeMaps _ = return () loadMapFork :: UserData -> MVar (SystemState Entity IO, StateData) - -> MVar Float + -> MVar (Float, T.Text) -> IO () loadMapFork ud future progress = do let loadSteps = 18 @@ -79,9 +79,9 @@ loadMapFork ud future progress = do (10, 10) [(5, 5), (5, 45)] (50, 50) - _ <- liftIO $ swapMVar progress (1 / loadSteps) + _ <- liftIO $ swapMVar progress (1 / loadSteps, "Building floor") (mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps) - _ <- liftIO $ swapMVar progress (11 / loadSteps) + _ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images") let imgmat = convertTileToImg mat exits = Prelude.foldl (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty @@ -90,19 +90,19 @@ loadMapFork ud future progress = do ) [] ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]) - _ <- liftIO $ swapMVar progress (12 / loadSteps) + _ <- liftIO $ swapMVar progress (12 / loadSteps, "Placing furniture") (inter, rps) <- placeInteriorIO mat imgmat exits gr - _ <- liftIO $ swapMVar progress (13 / loadSteps) + _ <- liftIO $ swapMVar progress (13 / loadSteps, "Placing NPCs") logIO A.Debug ("number of reachpoints: " ++ show (length rps)) let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps - npcposs <- placeNPCs inter mat rps 75 -- (length nnex) - _ <- liftIO $ swapMVar progress (14 / loadSteps) + npcposs <- placeNPCs inter mat rps 100 -- (length nnex) + _ <- liftIO $ swapMVar progress (14 / loadSteps, "Unfolding MindMap graph") A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) (mmintmat, mmgraph) <- buildFloorMap . springField <$> - buildMindMap (length npcposs) 3 - _ <- liftIO $ swapMVar progress (15 / loadSteps) + buildMindMap (length npcposs) 2 + _ <- liftIO $ swapMVar progress (15 / loadSteps, "Converting MindMap to images") let mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat - _ <- liftIO $ swapMVar progress (16 / loadSteps) + _ <- liftIO $ swapMVar progress (16 / loadSteps, "Creating WorldState") (nws, _) <- yieldSystemT (worldState ud) $ do let pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph)) @@ -125,7 +125,7 @@ loadMapFork ud future progress = do , rot = Just SE , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0 } - void $ liftIO $ swapMVar progress (17 / loadSteps) + void $ liftIO $ swapMVar progress (17 / loadSteps, "Registering NPCs into WorldState") mapM_ (\npcpos@(V2 nr nc) -> do fact <- liftIO $ randomRIO (0.5, 1.5) fut <- liftIO newEmptyMVar @@ -139,7 +139,7 @@ loadMapFork ud future progress = do , anim = Just $ AnimState (AnimId 1 "standing" SE) 0 0 } ) npcposs - void $ liftIO $ swapMVar progress (18 / loadSteps) + void $ liftIO $ swapMVar progress (18 / loadSteps, "Handing over") putMVar future (nws, MainData { mapMat = mat , imgMat = M.fromList (nrows inter) (ncols inter) $ diff --git a/src/MindMap.hs b/src/MindMap.hs index 38b448b..c11b03f 100644 --- a/src/MindMap.hs +++ b/src/MindMap.hs @@ -44,7 +44,7 @@ buildMindMap num difficulty = do vert <- randomRIO (1, num) x <- randomRIO (4.5, 5.5) :: IO Double y <- randomRIO (4.5, 5.5) :: IO Double - A.logIO A.Debug ("pos: " ++ show (x, y)) + -- A.logIO A.Debug ("pos: " ++ show (x, y)) let node = MMNode (V2 x y) vert if node `elem` acc then makeVert acc a @@ -54,13 +54,11 @@ springField :: AG.Graph MMNode -> AG.Graph MMNode springField = calcul where - -- This could be optimized in such a way, that you update both computation partners at once. - -- Limit the force calcul graph = - let deltas = calculDelta2 graph -- map (calculDelta graph) (vertexList graph) + let deltas = calculDelta2 graph in if any (\(_, v) -> len v > 1) - (A.log A.Debug ("deltas: " ++ show deltas) deltas) - -- deltas + -- (A.log A.Debug ("deltas: " ++ show deltas) deltas) + deltas then let deltaNodes = map (\n -> n { mmPos = mmPos n + snd (fromJust (find ((== mmId n) . fst) deltas))}) @@ -69,7 +67,9 @@ springField = in -- A.log A.Debug "\n\nRECURSING\n" (calcul ngraph) else graph - len v = sqrt (v `dot` v) + +len :: (Floating a, Metric f) => f a -> a +len v = sqrt (v `dot` v) normv :: (Eq a, Floating a) => V2 a -> V2 a normv v@(V2 0 0) = v @@ -82,7 +82,7 @@ buildFloorMap inGraph = (floor r + 2, floor c + 2) amat ) emptyFloor - (A.log A.Debug ("floorGraph: " ++ show floorGraph) floorGraph) + floorGraph , fmap (\n -> n { mmPos = (+ 2) <$> mmPos n} ) floorGraph ) where @@ -95,9 +95,7 @@ buildFloorMap inGraph = ( maximum $ map ((\(V2 _ c) -> c) . mmPos) (vertexList redGraph)) redGraph = fmap (\n -> n { mmPos = mmPos n - minVert }) inGraph in fmap (\n -> n { mmPos = mmPos n / maxVert }) redGraph - floorGraph = - fmap (\n -> n { mmPos = (* 45) <$> mmPos n} ) - (A.log A.Verbose ("normGraph: " ++ (show $ vertexList normGraph)) normGraph) + floorGraph = fmap (\n -> n { mmPos = (* 45) <$> mmPos n }) normGraph emptyFloor = M.matrix 50 50 (const 0) manhattan :: AG.Graph MMNode -> M.Matrix Int -> M.Matrix TileState @@ -140,7 +138,7 @@ calculDelta2 graph = sproing2 [] = [] sproing2 ((cnode, cacc):nodeaccs) = ( mmId cnode - , if (distance (V2 0 0) (V2 100 100 * normv deltasum)) < distance (V2 0 0) deltasum + , if (len (V2 100 100 * normv deltasum)) < len deltasum then V2 100 100 * normv deltasum else deltasum ) : sproing2 dnodeaccs diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index 9be31f3..db5c664 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -35,7 +35,7 @@ data UserData = UserData , worldState :: SystemState Entity IO , stateData :: StateData , stateMVar :: MVar (SystemState Entity IO, StateData) - , stateProgress :: MVar Float + , stateProgress :: MVar (Float, T.Text) , threadContext :: Maybe SDL.GLContext , window :: Maybe SDL.Window } diff --git a/src/Util.hs b/src/Util.hs index 741f35c..0ff1c1c 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -9,6 +9,7 @@ import qualified Data.Map as Map import Data.ByteString.Lazy (toStrict) import Data.Graph.AStar import Data.Maybe +import qualified Data.Text as T import qualified SDL import qualified Graphics.Rendering.OpenGL as GL hiding (get) @@ -175,8 +176,8 @@ naviGraph imgmat (V2 r c) = [(-1, -1), (-1, 1), (1, -1), (1, 1)] in HS.fromList (list1 ++ list2) -drawLoadScreen :: UserData -> Float -> IO () -drawLoadScreen ud progress = do +drawLoadScreen :: UserData -> (Float, T.Text) -> IO () +drawLoadScreen ud (progress, msg) = do let ctx = nano ud save ctx fillColor ctx (rgb 255 128 0) @@ -189,6 +190,8 @@ drawLoadScreen ud progress = do (640 - 640 * realToFrac progress) 450 (1280 * realToFrac progress) 20 closePath ctx fill ctx + fontSize ctx 25 + textBox ctx 0 500 1280 msg restore ctx loadAnimationSprites diff --git a/tracer-game.cabal b/tracer-game.cabal index 86361b2..efb7eca 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -47,7 +47,7 @@ executable tracer-game -- other-extensions: build-depends: base >=4.10 && <5 , affection == 0.0.0.9 - , sdl2 + , sdl2 >= 2.4.0.0 , OpenGL , nanovg >= 0.6.0.0 , stm @@ -55,7 +55,7 @@ executable tracer-game , containers , ecstasy >= 0.2.1.0 , linear - , matrix + , matrix >= 0.3.6.0 , random , vector , astar