fix off by one error

This commit is contained in:
nek0 2018-02-28 00:36:54 +01:00
parent c742827e07
commit fa0ca04128
2 changed files with 61 additions and 62 deletions

View file

@ -39,7 +39,7 @@ foreign import ccall unsafe "glewInit"
load :: IO UserData
load = do
_ <- glewInit
nvg <- createGL3 (S.fromList [StencilStrokes])
nvg <- createGL3 (S.fromList [Antialias, StencilStrokes])
subs <- Subsystems
<$> (Window <$> newTVarIO [])
<*> (Mouse <$> newTVarIO [])

View file

@ -96,8 +96,8 @@ drawMap :: Affection UserData ()
drawMap = do
ud <- getAffection
let matrix = mapMat (stateData ud)
mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [0..] ls))
(zip [0..] (toLists matrix))
mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [1..] ls))
(zip [1..] (toLists matrix))
updateMap :: Double -> Affection UserData ()
updateMap dt = do
@ -161,10 +161,10 @@ drawTile row col tile = do
liftIO $ do
save ctx
beginPath ctx
let x = realToFrac $ 640 + ((fromIntegral col - pc + 1) +
(fromIntegral row - pr + 1)) * (tileWidth / 2)
y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr + 1) -
(fromIntegral col - pc + 1)) * (tileHeight / 2)
let x = realToFrac $ 640 + ((fromIntegral col - pc) +
(fromIntegral row - pr)) * (tileWidth / 2)
y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) -
(fromIntegral col - pc)) * (tileHeight / 2)
fillColor ctx (case tile of
Wall -> rgba 128 128 128 255
Door -> rgba 255 128 128 255
@ -182,67 +182,66 @@ drawTile row col tile = do
closePath ctx
fill ctx
when (tile == Wall) $ do
let img = case neighWalls prow pcol mat of
let img = case neighWalls row col mat of
4 ->
assetImages ud Map.! ImgWallCross
assetImages ud Map.! ImgWallCross
3
| M.safeGet (prow + 1) pcol mat /= Just Wall &&
M.safeGet (prow + 1) pcol mat /= Just Door ->
assetImages ud Map.! ImgWallTNW
| M.safeGet prow (pcol + 1) mat /= Just Wall &&
M.safeGet prow (pcol + 1) mat /= Just Door ->
assetImages ud Map.! ImgWallTSW
| M.safeGet (prow - 1) pcol mat /= Just Wall &&
M.safeGet (prow - 1) pcol mat /= Just Door ->
assetImages ud Map.! ImgWallTSE
| otherwise ->
assetImages ud Map.! ImgWallTNE
| M.safeGet (row + 1) col mat /= Just Wall &&
M.safeGet (row + 1) col mat /= Just Door ->
assetImages ud Map.! ImgWallTNW
| M.safeGet row (col + 1) mat /= Just Wall &&
M.safeGet row (col + 1) mat /= Just Door ->
assetImages ud Map.! ImgWallTSW
| M.safeGet (row - 1) col mat /= Just Wall &&
M.safeGet (row - 1) col mat /= Just Door ->
assetImages ud Map.! ImgWallTSE
| otherwise ->
assetImages ud Map.! ImgWallTNE
2
| (M.safeGet (prow + 1) pcol mat == Just Wall ||
M.safeGet (prow + 1) pcol mat == Just Door) &&
(M.safeGet (prow - 1) pcol mat == Just Wall ||
M.safeGet (prow - 1) pcol mat == Just Door) ->
assetImages ud Map.! ImgWallDesc
| (M.safeGet prow (pcol + 1) mat == Just Wall ||
M.safeGet prow (pcol + 1) mat == Just Door) &&
(M.safeGet prow (pcol - 1) mat == Just Wall ||
M.safeGet prow (pcol - 1) mat == Just Door) ->
assetImages ud Map.! ImgWallAsc
| (M.safeGet (prow - 1) pcol mat == Just Wall ||
M.safeGet (prow - 1) pcol mat == Just Door) &&
(M.safeGet prow (pcol - 1) mat == Just Wall ||
M.safeGet prow (pcol - 1) mat == Just Door) ->
assetImages ud Map.! ImgWallCornerW
| (M.safeGet prow (pcol - 1) mat == Just Wall ||
M.safeGet prow (pcol - 1) mat == Just Door) &&
(M.safeGet (prow + 1) pcol mat == Just Wall ||
M.safeGet (prow + 1) pcol mat == Just Door) ->
assetImages ud Map.! ImgWallCornerS
| (M.safeGet (prow + 1) pcol mat == Just Wall ||
M.safeGet (prow + 1) pcol mat == Just Door) &&
(M.safeGet prow (pcol + 1) mat == Just Wall ||
M.safeGet prow (pcol + 1) mat == Just Door) ->
assetImages ud Map.! ImgWallCornerE
| otherwise ->
assetImages ud Map.! ImgWallCornerN
| (M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door) &&
(M.safeGet (row - 1) col mat == Just Wall ||
M.safeGet (row - 1) col mat == Just Door) ->
assetImages ud Map.! ImgWallDesc
| (M.safeGet row (col + 1) mat == Just Wall ||
M.safeGet row (col + 1) mat == Just Door) &&
(M.safeGet row (col - 1) mat == Just Wall ||
M.safeGet row (col - 1) mat == Just Door) ->
assetImages ud Map.! ImgWallAsc
| (M.safeGet (row - 1) col mat == Just Wall ||
M.safeGet (row - 1) col mat == Just Door) &&
(M.safeGet row (col - 1) mat == Just Wall ||
M.safeGet row (col - 1) mat == Just Door) ->
assetImages ud Map.! ImgWallCornerW
| (M.safeGet row (col - 1) mat == Just Wall ||
M.safeGet row (col - 1) mat == Just Door) &&
(M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door) ->
assetImages ud Map.! ImgWallCornerS
| (M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door) &&
(M.safeGet row (col + 1) mat == Just Wall ||
M.safeGet row (col + 1) mat == Just Door) ->
assetImages ud Map.! ImgWallCornerE
| otherwise ->
assetImages ud Map.! ImgWallCornerN
1
| M.safeGet (prow - 1) pcol mat == Just Wall ||
M.safeGet (prow - 1) pcol mat == Just Door ->
assetImages ud Map.! ImgWallDesc
| M.safeGet (prow + 1) pcol mat == Just Wall ||
M.safeGet (prow + 1) pcol mat == Just Door ->
assetImages ud Map.! ImgWallDesc
| M.safeGet prow (pcol + 1) mat == Just Wall ||
M.safeGet prow (pcol + 1) mat == Just Door ->
assetImages ud Map.! ImgWallAsc
| otherwise ->
assetImages ud Map.! ImgWallAsc
| M.safeGet (row - 1) col mat == Just Wall ||
M.safeGet (row - 1) col mat == Just Door ->
assetImages ud Map.! ImgWallDesc
| M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door ->
assetImages ud Map.! ImgWallDesc
| M.safeGet row (col + 1) mat == Just Wall ||
M.safeGet row (col + 1) mat == Just Door ->
assetImages ud Map.! ImgWallAsc
| otherwise ->
assetImages ud Map.! ImgWallAsc
0 ->
assetImages ud Map.! ImgWallCross
assetImages ud Map.! ImgWallCross
_ ->
error "unexpected number if neighbouring walls"
error "unexpected number if neighbouring walls"
mat = mapMat (stateData ud)
(prow, pcol) = (row + 1, col + 1)
paint <- imagePattern
ctx x (y - (74 - realToFrac tileHeight)) 64 74 0
img
@ -251,7 +250,7 @@ drawTile row col tile = do
rect ctx x (y - (74 - realToFrac tileHeight)) 64 74
fillPaint ctx paint
fill ctx
when (floor pr == row + 1 && floor pc == col + 1) $ do
when (floor pr == row && floor pc == col) $ do
beginPath ctx
circle ctx 640 360 5
closePath ctx