Correctly intersect lines and circles
This commit is contained in:
@@ -166,15 +166,15 @@ aLaser it cr = particles .:~ makeLaserAt phasev pos dir
|
|||||||
makeLaserAt :: Float -> Point2 -> Float -> Particle
|
makeLaserAt :: Float -> Point2 -> Float -> Particle
|
||||||
makeLaserAt phasev pos dir = Particle
|
makeLaserAt phasev pos dir = Particle
|
||||||
{ _ptDraw = const blank
|
{ _ptDraw = const blank
|
||||||
, _ptUpdate = moveLaser phasev pos dir
|
, _ptUpdate = mvLaser phasev pos dir
|
||||||
}
|
}
|
||||||
moveLaser :: Float -- ^ Phase velocity, controls deflection through windows
|
mvLaser :: Float -- ^ Phase velocity, controls deflection through windows
|
||||||
-> Point2
|
-> Point2
|
||||||
-> Float
|
-> Float
|
||||||
-> World
|
-> World
|
||||||
-> Particle
|
-> Particle
|
||||||
-> (World, Maybe Particle)
|
-> (World, Maybe Particle)
|
||||||
moveLaser phasev pos dir w pt
|
mvLaser phasev pos dir w pt
|
||||||
= ( damThingHitWith (Lasering 19) pos xp thHit w
|
= ( damThingHitWith (Lasering 19) pos xp thHit w
|
||||||
, Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
|
, Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
{- |
|
{- |
|
||||||
Find which objects lie upon a line.
|
Find which objects lie upon a line.
|
||||||
-}
|
-}
|
||||||
@@ -121,7 +122,10 @@ thingsHitLongLine sp ep w
|
|||||||
| sp == ep = []
|
| sp == ep = []
|
||||||
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
|
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
|
||||||
where
|
where
|
||||||
crs = zip crPs (map Left hitCrs)
|
crs = mapMaybe
|
||||||
|
(\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
|
||||||
|
. IM.elems $ _creatures w
|
||||||
|
--crs = zip crPs (map Left hitCrs)
|
||||||
hitCrs = IM.elems
|
hitCrs = IM.elems
|
||||||
. IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
. IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
||||||
$ _creatures w
|
$ _creatures w
|
||||||
|
|||||||
@@ -194,16 +194,6 @@ ssaTriPoint' pa pb pc' bc
|
|||||||
= Nothing
|
= Nothing
|
||||||
| otherwise
|
| otherwise
|
||||||
= Just $ ssaTriPoint pa pb pc' bc
|
= Just $ ssaTriPoint pa pb pc' bc
|
||||||
-- | A potential correction of 'ssaTriPoint'.
|
|
||||||
-- This should be tested and benchmarked.
|
|
||||||
--ssaTriPointCorrect :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
|
|
||||||
--ssaTriPointCorrect pa pb pc' bc
|
|
||||||
-- | param <= 1 && param >= 0 = Just p
|
|
||||||
-- | otherwise = Nothing
|
|
||||||
-- where
|
|
||||||
-- p = ssaTriPoint pa pb pc' bc
|
|
||||||
-- param = closestPointOnLineParam pa pc' p
|
|
||||||
|
|
||||||
-- | Return Just a point if it is inside a circle, Nothing otherwise.
|
-- | Return Just a point if it is inside a circle, Nothing otherwise.
|
||||||
pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2
|
pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2
|
||||||
pointInCircle p r c
|
pointInCircle p r c
|
||||||
@@ -223,9 +213,6 @@ collidePointCirc' p1 p2 rad c = fmap (\x -> magV (x -.- p1))
|
|||||||
collidePointCirc'' :: Point2 -> Point2 -> Float -> Point2 -> Maybe (Point2,Float)
|
collidePointCirc'' :: Point2 -> Point2 -> Float -> Point2 -> Maybe (Point2,Float)
|
||||||
collidePointCirc'' p1 p2 rad c = (,) <$> collidePointCirc p1 p2 rad c
|
collidePointCirc'' p1 p2 rad c = (,) <$> collidePointCirc p1 p2 rad c
|
||||||
<*> collidePointCirc' p1 p2 rad c
|
<*> collidePointCirc' p1 p2 rad c
|
||||||
-- | As 'collidePointCirc', but uses the supposedly correct version of ssaTriPoint.
|
|
||||||
--collidePointCircCorrect :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
|
|
||||||
--collidePointCircCorrect p1 p2 rad c = ssaTriPointCorrect p2 c p1 rad
|
|
||||||
-- | Finds the height of a triangle using herons formula.
|
-- | Finds the height of a triangle using herons formula.
|
||||||
-- The base is the line between the first two points.
|
-- The base is the line between the first two points.
|
||||||
heron :: Point2 -> Point2 -> Point2 -> Float
|
heron :: Point2 -> Point2 -> Point2 -> Float
|
||||||
|
|||||||
@@ -251,10 +251,16 @@ orthogonalPointOnSeg a b p
|
|||||||
| otherwise = Just $ a +.+ param *.* (normalizeV $ b -.- a)
|
| otherwise = Just $ a +.+ param *.* (normalizeV $ b -.- a)
|
||||||
where
|
where
|
||||||
param = closestPointOnLineParam a b p
|
param = closestPointOnLineParam a b p
|
||||||
|
|
||||||
|
inSegArea :: Point2 -> Point2 -> Point2 -> Bool
|
||||||
|
inSegArea a b c = param >= 0 && param <= dotV (b -.- a) (b -.- a)
|
||||||
|
where
|
||||||
|
param = dotV (b -.- a) (c -.- a)
|
||||||
|
|
||||||
intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
|
intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
|
||||||
intersectCircSeg c r a b
|
intersectCircSeg c r a b
|
||||||
| y < 0 = []
|
| y < 0 = []
|
||||||
| otherwise = nub $ filter ( (< dist a b) . dist a ) [ d -.- v, d +.+ c ]
|
| otherwise = nub $ filter (inSegArea a b) [ d -.- v, d +.+ c ]
|
||||||
where
|
where
|
||||||
d = closestPointOnLine a b c
|
d = closestPointOnLine a b c
|
||||||
x = dist d c
|
x = dist d c
|
||||||
|
|||||||
Reference in New Issue
Block a user