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

add progress bar

Browse source
This commit is contained in:
nek0 2018-08-10 10:29:12 +02:00
parent bcdd04e7d5
commit c8b81e90e5
1 changed files with 30 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
src/MainGame/WorldMap.hs
View file

@ -299,7 +299,7 @@ drawMap = do
drawLoadScreen ud progress drawLoadScreen ud progress
_ -> do _ -> do
dt <- getDelta dt <- getDelta
(_, (playerPos, posanims)) <- yieldSystemT (worldState ud) $ do (_, (playerPos, posanims, posActions)) <- yieldSystemT (worldState ud) $ do
pc <- fmap head $ efor allEnts $ do pc <- fmap head $ efor allEnts $ do
with player with player
with pos with pos
@ -311,7 +311,18 @@ drawMap = do
pos' <- query pos pos' <- query pos
mbnds <- queryMaybe obstacle mbnds <- queryMaybe obstacle
return (pos', stat, mbnds) return (pos', stat, mbnds)
return (pc, posanims) posActions <- efor allEnts $ do
with objType
with objState
with objStateTime
with pos
pos' <- query pos
t <- query objType
s <- query objState
let maxt = actionTime t s
ttl <- query objStateTime
return (pos', realToFrac (1 - ttl / maxt))
return (pc, posanims, posActions)
let V2 pr pc = playerPos let V2 pr pc = playerPos
mat = imgMat (stateData ud) mat = imgMat (stateData ud)
cols = fromIntegral (ncols mat) cols = fromIntegral (ncols mat)
@ -365,6 +376,23 @@ drawMap = do
(\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t) (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t)
(reverse $ zip [1..] ls)) (reverse $ zip [1..] ls))
(zip [1..] (toLists mat)) (zip [1..] (toLists mat))
mapM_ (\(V2 sr sc, perc) -> do
let lx = realToFrac $ 640 + ((sc - pc) +
(sr - pr)) * (tileWidth / 2) :: CFloat
ly = realToFrac $ 360 - (tileHeight / 2) + ((sr - pr) -
(sc - pc)) * (tileHeight / 2) :: CFloat
fillColor ctx (rgb 0 255 0)
strokeColor ctx (rgb 0 255 0)
strokeWidth ctx 2
beginPath ctx
rect ctx (lx - 25) (ly - 50) 50 10
stroke ctx
closePath ctx
beginPath ctx
rect ctx (lx - 25 * perc) (ly - 50) (50 * perc) 10
fill ctx
closePath ctx
) posActions
fontSize ctx 20 fontSize ctx 20
fontFace ctx (assetFonts ud Map.! FontBedstead) fontFace ctx (assetFonts ud Map.! FontBedstead)
textAlign ctx (S.fromList [AlignCenter,AlignTop]) textAlign ctx (S.fromList [AlignCenter,AlignTop])