justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Identify broken wall collisions

Browse Source
This commit is contained in:
justin
2021-11-19 00:35:04 +00:00
parent 15f2c419d2
commit b1a49bbdc3
13 changed files with 112 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+6
View File
@@ -68,6 +68,12 @@ wallsOnLine p1 p2 ws = hitWalls
hitPoint w = uncurry (intersectSegSeg p1 p2) (_wlLine w)
hitWalls = filter (isJust . hitPoint) (IM.elems ws)
wallsOnLine3D :: Point3 -> Point3 -> IM.IntMap Wall -> [Wall]
wallsOnLine3D = undefined
-- where
-- hitPoint w = uncurry (intersectSegSeg p1 p2) (_wlLine w)
-- hitWalls = filter (isJust . hitPoint) (IM.elems ws)
wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
wallsOnCirc p r = IM.filter f
where
src/Dodge/Data.hs
+1
View File
@@ -638,6 +638,7 @@ data Wall = Wall
, _wlDraw :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
, _wlHeight :: Float
}
data Opacity
= SeeThrough
src/Dodge/Default/Wall.hs
+1
View File
@@ -18,6 +18,7 @@ defaultWall = Wall
, _wlRotateTo = True
, _wlStructure = StandaloneWall
, _wlWalkable = False
, _wlHeight = 100
}
{- Indestructible see-through wall. -}
defaultCrystalWall :: Wall
src/Dodge/Particle/Bullet/Spawn.hs
+4 -4
View File
@@ -21,7 +21,7 @@ aGenBulAt
-> Particle
aGenBulAt maycid pos vel hiteff width = BulletPt
{ _ptDraw = drawBul
, _ptUpdate = mvGenBullet
, _ptUpdate = mvBullet
, _btVel' = vel
, _btColor' = V4 2 2 2 2
, _btTrail' = [pos]
@@ -40,7 +40,7 @@ aDelayedBulAt
-> Particle
aDelayedBulAt vfact maycid pos vel hiteff width = BulletPt
{ _ptDraw = drawBul
, _ptUpdate = \w -> resetVel . mvGenBullet w
, _ptUpdate = \w -> resetVel . mvBullet w
, _btVel' = vfact *.* vel
, _btColor' = V4 2 2 2 2
, _btTrail' = [pos]
@@ -50,7 +50,7 @@ aDelayedBulAt vfact maycid pos vel hiteff width = BulletPt
, _btHitEffect' = hiteff
}
where
resetVel = second $ fmap $ (ptUpdate .~ mvGenBullet) . (btVel' .~ vel)
resetVel = second $ fmap $ (ptUpdate .~ mvBullet) . (btVel' .~ vel)
aCurveBulAt
:: Maybe Int -- ^ Pass-through creature id
@@ -63,7 +63,7 @@ aCurveBulAt
-> Particle
aCurveBulAt maycid col pos control targ hiteff width = BulletPt
{ _ptDraw = drawBul
, _ptUpdate = \w -> mvGenBullet w . setVel
, _ptUpdate = \w -> mvBullet w . setVel
, _btVel' = V2 0 0
, _btColor' = col
, _btTrail' = [pos]
src/Dodge/Particle/Bullet/Update.hs
+12 -9
View File
@@ -1,27 +1,30 @@
{-# LANGUAGE TupleSections #-}
{- Bullet update. -}
module Dodge.Particle.Bullet.Update
( mvGenBullet
( mvBullet
) where
import Dodge.Data
--import Dodge.Base
import Dodge.WorldEvent.ThingsHit
--import Picture
import Geometry
--import Geometry.Vector3D
import Control.Lens
{-
Update for a generic bullet.
-}
mvGenBullet :: World -> Particle -> (World, Maybe Particle)
mvGenBullet w bt
| t <= 0 = (w, Nothing)
| t < 4 = (w, Just $ bt
& btPassThrough' .~ Nothing
& btTrail' .~ (p:p:ps)
& btTimer' -~ 1
)
mvBullet :: World -> Particle -> (World, Maybe Particle)
mvBullet w bt
| t <= 0 = wAnd Nothing
| t < 4 = wAnd $ Just $ bt
& btPassThrough' .~ Nothing
& btTrail' .~ (p:p:ps)
& btTimer' -~ 1
-- | otherwise = hiteff bt (thingsHitExceptCr3D' mcr (addZ 20 p) (addZ 20 (p +.+ vel)) w) w
| otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
where
wAnd = (w,)
mcr = _btPassThrough' bt
(p:ps) = _btTrail' bt
vel = _btVel' bt
src/Dodge/Particle/Spark.hs
+1 -1
View File
@@ -24,7 +24,7 @@ colSpark' randDir time col pos baseDir w = w
dir = a + baseDir
spark = BulletPt
{ _ptDraw = drawBul
, _ptUpdate = mvGenBullet
, _ptUpdate = mvBullet
, _btVel' = rotateV dir (V2 5 0)
, _btColor' = col
, _btTrail' = [pos]
src/Dodge/Placement/Instance/Wall.hs
+15 -2
View File
@@ -9,14 +9,27 @@ import Color
import Data.List
import Control.Lens
lowWall :: [Point2] -> Placement
lowWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 30 ps)
heightWall :: Float -> [Point2] -> Placement
heightWall h ps = ps0j (PutForeground . colorSH col $ upperPrismPoly h ps)
$ sps0 $ PutWall ps theWall
where
col = _wlColor defaultWall
theWall = defaultWall
{ _wlOpacity = SeeAbove
, _wlDraw = False
, _wlHeight = h
}
midWall :: [Point2] -> Placement
midWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 50 ps)
$ sps0 $ PutWall ps theWall
where
col = _wlColor defaultWall
theWall = defaultWall
{ _wlOpacity = SeeAbove
, _wlDraw = False
, _wlHeight = 50
}
src/Dodge/Room/Corridor.hs
+6 -2
View File
@@ -32,9 +32,13 @@ corridor = defaultRoom
keyholeCorridor :: Room
keyholeCorridor = corridor
{ _rmPath = []
, _rmPmnts = [ lowWall $ rectNSEW 50 30 0 15
, lowWall $ rectNSEW 50 30 25 40]
, _rmPmnts =
[ midWall $ rectNSEW top bot 0 15
, midWall $ rectNSEW top bot 25 40]
}
where
top = 55
bot = 25
corridorN :: Room
corridorN = defaultRoom
src/Dodge/Room/RoadBlock.hs
+1 -1
View File
@@ -98,7 +98,7 @@ lasTunnel = defaultRoom
, _rmBound = polys
, _rmLinks = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)]
, _rmPmnts = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi)
, lowWall (rectNSEW 65 40 0 25)
, midWall (rectNSEW 65 40 0 25)
, mntLS vShape (V2 50 10) (V3 40 20 50)
]
}
src/Dodge/Room/Start.hs
+11 -2
View File
@@ -16,6 +16,8 @@ import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
import Dodge.Layout.Tree.Polymorphic
import Dodge.Item.Random
import Dodge.Item.Weapon.BulletGuns
import Dodge.Item.Weapon.Utility
--import Dodge.LevelGen.Data
import Geometry.Data
import Padding
@@ -31,8 +33,15 @@ import System.Random
minigunfakeout :: RandomGen g => State g (Tree (Either Room Room))
minigunfakeout = do
rcol <- rezColor
ncor <- state $ randomR (1,5)
return $ ([Left $ rezBox rcol,Left door] ++ replicate ncor (Left corridor)
ncor <- state $ randomR (1,3)
roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150
& rmPmnts %~ ([plRRpt 0 (PutFlIt miniGun),plRRpt 0 (PutFlIt shrinkGun)]++)
return $ ([Left $ rezBox rcol
,Left door
,Left roomwithmini
,Left door
]
++ replicate ncor (Left corridor)
++ [Left keyholeCorridor,Left corridor])
`treeFromPost` Right door
src/Dodge/WorldEvent.hs
+1 -1
View File
@@ -32,7 +32,7 @@ createBarrelSpark pos dir maycid time colid w
where
spark = BulletPt
{ _ptDraw = drawBul
, _ptUpdate = mvGenBullet
, _ptUpdate = mvBullet
, _btVel' = rotateV dir (V2 5 0)
, _btColor' = numColor colid
, _btTrail' = [pos]
src/Dodge/WorldEvent/ThingsHit.hs
+48 -1
View File
@@ -6,6 +6,7 @@ module Dodge.WorldEvent.ThingsHit
, thingHit
, thingsHitLongLine
, thingsHitExceptCr
, thingsHitExceptCr3D'
, thingsHitExceptCrLongLine
)
where
@@ -13,12 +14,14 @@ import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Geometry
import Geometry.Vector3D
import qualified Data.IntMap.Strict as IM
import Data.List
import Data.Maybe
import Data.Bifunctor
{- List those objects that appear on a line. -}
thingsHit
thingsHit
:: Point2 -- ^ Line start point
-> Point2 -- ^ Line end point
-> World
@@ -41,8 +44,52 @@ thingsHit sp ep w
_ -> IM.empty
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
{- List those objects that appear on a line. -}
thingsHit3D
:: Point3 -- ^ Line start point
-> Point3 -- ^ Line end point
-> World
-> [(Point3, Either Creature Wall)]
thingsHit3D sp ep w
| sp == ep = []
| otherwise = sortOn (dist3 sp . fst) (crs ++ wls)
where
hitCrs = IM.elems
$ IM.filter (\cr -> circOnSeg (stripZ sp) (stripZ ep) (_crPos cr) (_crRad cr))
$ _creatures w
crPs = map (\cr -> ssaTriPoint (stripZ ep) (_crPos cr) (stripZ sp) (_crRad cr)) hitCrs
crs = zip (map (addZ 20) crPs) (map Left hitCrs)
hitWls = wallsOnLine (stripZ sp) (stripZ ep)
(IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1]
, b<-[y-1,y,y+1]])
(x,y) = zoneOfPoint (0.5 *.* (stripZ sp +.+ stripZ ep))
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
wls = zip (map (addZ 20 . fromJust . hitPoint) hitWls) (map Right hitWls)
hitPoint w' = uncurry (intersectSegSeg (stripZ sp) (stripZ ep)) (_wlLine w')
thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
thingHit sp ep = listToMaybe . thingsHit sp ep
thingsHitExceptCr3D'
:: Maybe Int -- ^ A possible creature ID
-> Point3 -- ^ Line start point
-> Point3 -- ^ Line end point
-> World
-> [(Point2, Either Creature Wall)]
thingsHitExceptCr3D' mcid sp ep = fmap (first stripZ) . thingsHitExceptCr3D mcid sp ep
{- List objects that appear on a line.
Can filter out a creature. -}
thingsHitExceptCr3D
:: Maybe Int -- ^ A possible creature ID
-> Point3 -- ^ Line start point
-> Point3 -- ^ Line end point
-> World
-> [(Point3, Either Creature Wall)]
thingsHitExceptCr3D Nothing sp ep = thingsHit3D sp ep
thingsHitExceptCr3D (Just cid) sp ep = filter crNotCid . thingsHit3D sp ep
where
crNotCid (_,Left cr) = _crID cr /= cid
crNotCid _ = True
{- List objects that appear on a line.
Can filter out a creature. -}
thingsHitExceptCr
src/Geometry.hs
+5 -1
View File
@@ -184,12 +184,16 @@ circOnSegNoEndpoints !p1 !p2 !c !rad = isJustTrue (fmap (\p -> magV (p -.- c) <
-- the distance to the endpoints of the segment.
circOnSeg :: Point2 -> Point2 -> Point2 -> Float -> Bool
{-# INLINE circOnSeg #-}
circOnSeg !p1 !p2 !c !rad = magV (p1 -.- c) <= rad || magV (p2 -.- c) <= rad
circOnSeg !p1 !p2 !c !rad = magV (p1 -.- c) <= rad
|| magV (p2 -.- c) <= rad
|| isJustTrue (fmap (\p -> magV (p -.- c) < rad) y)
where
y = intersectSegLine p1 p2 c (c +.+ vNormal (p1 -.- p2))
isJustTrue (Just True) = True
isJustTrue _ = False
cylinderOnSeg :: Point3 -> Point3 -> Point3 -> Float -> Bool
{-# INLINE cylinderOnSeg #-}
cylinderOnSeg = undefined
-- | Find the difference between two Nums.
difference :: (Ord a, Num a) => a -> a -> a
difference x y