subtile collision for boxes
This commit is contained in:
nek0
parent
38db226cc7
commit
22c0c87284
4 changed files with 130 additions and 56 deletions
Binary file not shown.
Binary file not shown.
|
Before Width: | Height: | Size: 575 B After Width: | Height: | Size: 574 B |
182
src/Test.hs
182
src/Test.hs
|
|
@ -14,7 +14,7 @@ import qualified Data.Set as S
|
|||
import qualified Data.Text as T
|
||||
import Data.Matrix as M
|
||||
import Data.Ecstasy as E
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Maybe
|
||||
|
||||
import NanoVG hiding (V2(..))
|
||||
|
||||
|
|
@ -149,21 +149,65 @@ updateMap dt = do
|
|||
pos'@(V2 or oc) <- E.get pos
|
||||
vel' <- E.get vel
|
||||
let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel'
|
||||
let ent
|
||||
| Wall /= matrix M.! (floor nr, floor nc) =
|
||||
defEntity'
|
||||
{ pos = Set npos
|
||||
}
|
||||
| Wall /= matrix M.! (floor nr, floor oc) =
|
||||
defEntity'
|
||||
{ pos = Set (V2 nr oc)
|
||||
}
|
||||
| Wall /= matrix M.! (floor or, floor nc) =
|
||||
defEntity'
|
||||
{ pos = Set (V2 or nc)
|
||||
}
|
||||
| otherwise =
|
||||
defEntity'
|
||||
let ent =
|
||||
case imgObstacle (imgMat (stateData ud) M.! (floor nr, floor nc)) of
|
||||
Just (Boundaries (minr, minc) (maxr, maxc))
|
||||
| (nr - fromIntegral (floor nr) >= minr &&
|
||||
nr - fromIntegral (floor nr) <= maxr) &&
|
||||
(nc - fromIntegral (floor nc) >= minc &&
|
||||
nc - fromIntegral (floor nc) <= maxc) &&
|
||||
(or - fromIntegral (floor or) < minr ||
|
||||
or - fromIntegral (floor or) > maxr) ->
|
||||
defEntity'
|
||||
{ pos = Set (V2 or nc)
|
||||
}
|
||||
| (nr - fromIntegral (floor nr) >= minr &&
|
||||
nr - fromIntegral (floor nr) <= maxr) &&
|
||||
(nc - fromIntegral (floor nc) >= minc &&
|
||||
nc - fromIntegral (floor nc) <= maxc) &&
|
||||
(oc - fromIntegral (floor oc) < minc ||
|
||||
oc - fromIntegral (floor oc) > maxc) ->
|
||||
defEntity'
|
||||
{ pos = Set (V2 nr oc)
|
||||
}
|
||||
| (nr - fromIntegral (floor nr) < minr ||
|
||||
nr - fromIntegral (floor nr) > maxr) &&
|
||||
(nc - fromIntegral (floor nc) < minc ||
|
||||
nc - fromIntegral (floor nc) > maxc) ->
|
||||
defEntity'
|
||||
{ pos = Set npos
|
||||
}
|
||||
| (nr - fromIntegral (floor nr) < minr ||
|
||||
nr - fromIntegral (floor nr) > maxr) &&
|
||||
(nc - fromIntegral (floor nc) >= minc &&
|
||||
nc - fromIntegral (floor nc) <= maxc) ->
|
||||
defEntity'
|
||||
{ pos = Set npos
|
||||
}
|
||||
| (nr - fromIntegral (floor nr) >= minr &&
|
||||
nr - fromIntegral (floor nr) <= maxr) &&
|
||||
(nc - fromIntegral (floor nc) < minc ||
|
||||
nc - fromIntegral (floor nc) > maxc) ->
|
||||
defEntity'
|
||||
{ pos = Set npos
|
||||
}
|
||||
| otherwise ->
|
||||
defEntity'
|
||||
Nothing
|
||||
| Wall /= matrix M.! (floor nr, floor nc) ->
|
||||
defEntity'
|
||||
{ pos = Set npos
|
||||
}
|
||||
| Wall /= matrix M.! (floor nr, floor oc) ->
|
||||
defEntity'
|
||||
{ pos = Set (V2 nr oc)
|
||||
}
|
||||
| Wall /= matrix M.! (floor or, floor nc) ->
|
||||
defEntity'
|
||||
{ pos = Set (V2 or nc)
|
||||
}
|
||||
| otherwise ->
|
||||
defEntity'
|
||||
return ent
|
||||
putAffection ud
|
||||
{ worldState = nws
|
||||
|
|
@ -178,43 +222,69 @@ drawTile
|
|||
-> Int
|
||||
-> Maybe ImgId
|
||||
-> IO ()
|
||||
drawTile ai ctx pr pc row col img = do
|
||||
let tileWidth = 64 :: Double
|
||||
tileHeight = 32 :: Double
|
||||
save ctx
|
||||
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)
|
||||
unless (img == Nothing) $ do
|
||||
let dist = distance (V2 (fromIntegral row) (fromIntegral col))
|
||||
(V2 (realToFrac pr - 1) (realToFrac pc)) / 4
|
||||
fact = if (floor pr <= row && floor pc >= col) && isWall (fromJust img)
|
||||
then min 1 dist
|
||||
else 1
|
||||
paint <- imagePattern
|
||||
ctx x (y - (74 * fact - realToFrac tileHeight))
|
||||
(realToFrac tileWidth) 74
|
||||
0
|
||||
(ai Map.! fromJust img)
|
||||
fact
|
||||
beginPath ctx
|
||||
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
|
||||
fillPaint ctx paint
|
||||
fill ctx
|
||||
when (floor pr == row && floor pc == col) $ do
|
||||
beginPath ctx
|
||||
circle ctx 640 360 5
|
||||
closePath ctx
|
||||
fillColor ctx (rgba 0 255 255 255)
|
||||
fill ctx
|
||||
restore ctx
|
||||
drawTile ai ctx pr pc row col img =
|
||||
do
|
||||
save ctx
|
||||
if (isNothing img)
|
||||
then drawPlayer
|
||||
else do
|
||||
if (isNothing mb)
|
||||
then do
|
||||
drawImage
|
||||
drawPlayer
|
||||
else do
|
||||
let (Boundaries (minr, minc) (maxr, maxc)) = fromJust mb
|
||||
if (pr <= fromIntegral (floor pr) + minr &&
|
||||
pc >= fromIntegral (floor pc) + minc)
|
||||
then do
|
||||
drawPlayer
|
||||
drawImage
|
||||
else do
|
||||
drawImage
|
||||
drawPlayer
|
||||
-- when (isNothing img) drawPlayer
|
||||
restore ctx
|
||||
where
|
||||
tileWidth = 64 :: Double
|
||||
tileHeight = 32 :: Double
|
||||
x = realToFrac $ 640 + ((fromIntegral col - pc) +
|
||||
(fromIntegral row - pr)) * (tileWidth / 2)
|
||||
y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) -
|
||||
(fromIntegral col - pc)) * (tileHeight / 2)
|
||||
dist = distance (V2 (fromIntegral row) (fromIntegral col))
|
||||
(V2 (realToFrac pr - 1) (realToFrac pc)) / 4
|
||||
fact =
|
||||
if (floor pr <= row && floor pc >= col) &&
|
||||
isWall (fromJust img)
|
||||
then min 1 dist
|
||||
else 1
|
||||
mb = imgObstacle img
|
||||
drawImage = do
|
||||
beginPath ctx
|
||||
paint <- imagePattern
|
||||
ctx x (y - (74 * fact - 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
|
||||
fillPaint ctx paint
|
||||
fill ctx
|
||||
drawPlayer = do
|
||||
when (floor pr == row && floor pc == col) $ do
|
||||
beginPath ctx
|
||||
circle ctx 640 360 5
|
||||
closePath ctx
|
||||
fillColor ctx (rgba 0 255 255 255)
|
||||
fill ctx
|
||||
|
|
|
|||
|
|
@ -58,6 +58,10 @@ isWall :: ImgId -> Bool
|
|||
isWall ImgMiscBox1 = False
|
||||
isWall _ = True
|
||||
|
||||
imgObstacle :: Maybe ImgId -> Maybe (Boundaries Double)
|
||||
imgObstacle (Just ImgMiscBox1) = Just (Boundaries (0.2, 0.34) (0.8, 1))
|
||||
imgObstacle _ = Nothing
|
||||
|
||||
data FontId
|
||||
= FontBedstead
|
||||
deriving (Show, Eq, Ord, Enum)
|
||||
|
|
|
|||
Loading…
Reference in a new issue