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

*cough*

Browse source
This commit is contained in:
nek0 2018-04-14 11:18:53 +02:00
parent 9fdb8a5e15
commit 52c976c7f0
1 changed files with 1 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
src/Test.hs
View file

@ -134,7 +134,7 @@ drawMap = do
tileHeight = 32 :: Double tileHeight = 32 :: Double
x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2) x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2)
y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2) y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2)
liftIO $ do liftIO $ do -- draw floor
beginPath ctx beginPath ctx
moveTo ctx (x + realToFrac tileWidth / 2) y moveTo ctx (x + realToFrac tileWidth / 2) y
lineTo ctx lineTo ctx
@ -180,14 +180,6 @@ updateMap dt = do
(checkBoundsCollision pos' npos) (checkBoundsCollision pos' npos)
(V2 1 1) (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 concatMap
(\(dr, dc) -> (\(dr, dc) ->
let bs = fromMaybe [] (imgObstacle <$> (M.safeGet let bs = fromMaybe [] (imgObstacle <$> (M.safeGet
@ -262,24 +254,11 @@ drawTile ai ctx pr pc row col img =
drawImage = do drawImage = do
beginPath ctx beginPath ctx
paint <- imagePattern paint <- imagePattern
-- ctx x (y - (74 * fact - realToFrac tileHeight))
ctx x (y - (74 - realToFrac tileHeight)) ctx x (y - (74 - realToFrac tileHeight))
(realToFrac tileWidth) 74 (realToFrac tileWidth) 74
0 0
(ai Map.! fromJust img) (ai Map.! fromJust img)
fact 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 rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74
fillPaint ctx paint fillPaint ctx paint
fill ctx fill ctx