This commit is contained in:
nek0 2018-04-14 11:18:53 +02:00
parent 9fdb8a5e15
commit 52c976c7f0

View file

@ -134,7 +134,7 @@ drawMap = do
tileHeight = 32 :: Double
x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2)
y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2)
liftIO $ do
liftIO $ do -- draw floor
beginPath ctx
moveTo ctx (x + realToFrac tileWidth / 2) y
lineTo ctx
@ -180,14 +180,6 @@ updateMap dt = do
(checkBoundsCollision pos' npos)
(V2 1 1)
(
-- (imgObstacle (imgMat (stateData ud) M.! (floor nr, floor nc))) ++
-- Prelude.map (\(Boundaries (minr, minc) (maxr, maxc)) ->
-- let deltar = fromIntegral (floor pr - floor nr)
-- deltac = fromIntegral (floor pc - floor nc)
-- in Boundaries
-- (minr + deltar, minc + deltac)
-- (maxr + deltar, maxc + deltac)
-- )
concatMap
(\(dr, dc) ->
let bs = fromMaybe [] (imgObstacle <$> (M.safeGet
@ -262,24 +254,11 @@ drawTile ai ctx pr pc row col img =
drawImage = do
beginPath ctx
paint <- imagePattern
-- ctx x (y - (74 * fact - realToFrac tileHeight))
ctx x (y - (74 - realToFrac tileHeight))
(realToFrac tileWidth) 74
0
(ai Map.! fromJust img)
fact
-- if fact < 1
-- then do
-- moveTo ctx x (y + (realToFrac tileHeight - 74 * fact))
-- lineTo ctx
-- (x + realToFrac tileWidth)
-- (y + (realToFrac tileHeight - 74 * fact))
-- lineTo ctx (x + realToFrac tileWidth) (y + realToFrac tileHeight / 2)
-- lineTo ctx (x + realToFrac tileWidth / 2) (y + realToFrac tileHeight)
-- lineTo ctx x (y + realToFrac tileHeight / 2)
-- closePath ctx
-- else
-- rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74
rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74
fillPaint ctx paint
fill ctx