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

subtile collision for boxes

Browse source
This commit is contained in:
nek0 2018-03-04 22:24:30 +01:00
parent 38db226cc7
commit 22c0c87284
4 changed files with 130 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
assets/misc/box1.kra
View file

Binary file not shown.

BIN
assets/misc/box1.png
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 575 B

After

Width:  |  Height:  |  Size: 574 B

114
src/Test.hs
View file

@ -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,20 +149,64 @@ 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) =
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)
}
| otherwise =
| (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
@ -178,31 +222,57 @@ drawTile
-> Int
-> Maybe ImgId
-> IO ()
drawTile ai ctx pr pc row col img = do
let tileWidth = 64 :: Double
tileHeight = 32 :: Double
drawTile ai ctx pr pc row col img =
do
save ctx
let x = realToFrac $ 640 + ((fromIntegral col - pc) +
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)
unless (img == Nothing) $ do
let dist = distance (V2 (fromIntegral row) (fromIntegral col))
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)
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
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 - 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)
@ -211,10 +281,10 @@ drawTile ai ctx pr pc row col img = do
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
restore ctx

4
src/Types/UserData.hs
View file

@ -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)