add progress bar

This commit is contained in:
nek0 2018-08-10 10:29:12 +02:00
parent bcdd04e7d5
commit c8b81e90e5

View file

@ -299,7 +299,7 @@ drawMap = do
drawLoadScreen ud progress
_ -> do
dt <- getDelta
(_, (playerPos, posanims)) <- yieldSystemT (worldState ud) $ do
(_, (playerPos, posanims, posActions)) <- yieldSystemT (worldState ud) $ do
pc <- fmap head $ efor allEnts $ do
with player
with pos
@ -311,7 +311,18 @@ drawMap = do
pos' <- query pos
mbnds <- queryMaybe obstacle
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
mat = imgMat (stateData ud)
cols = fromIntegral (ncols mat)
@ -365,6 +376,23 @@ drawMap = do
(\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t)
(reverse $ zip [1..] ls))
(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
fontFace ctx (assetFonts ud Map.! FontBedstead)
textAlign ctx (S.fromList [AlignCenter,AlignTop])