detailed loading output

This commit is contained in:
nek0 2018-07-19 04:51:07 +02:00
parent b04ae8759b
commit 2b86eaf230
7 changed files with 160 additions and 64 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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