diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index a95e82690..2eac243ec 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -166,15 +166,15 @@ aLaser it cr = particles .:~ makeLaserAt phasev pos dir makeLaserAt :: Float -> Point2 -> Float -> Particle makeLaserAt phasev pos dir = Particle { _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 -> Float -> World -> Particle -> (World, Maybe Particle) -moveLaser phasev pos dir w pt +mvLaser phasev pos dir w pt = ( damThingHitWith (Lasering 19) pos xp thHit w , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 } ) diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 1c17d782d..7ce21a069 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} {- | Find which objects lie upon a line. -} @@ -121,7 +122,10 @@ thingsHitLongLine sp ep w | sp == ep = [] | otherwise = sortOn (dist sp . fst) (crs ++ wls) 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 . IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr)) $ _creatures w diff --git a/src/Geometry.hs b/src/Geometry.hs index f4d54cc99..45da21e59 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -194,16 +194,6 @@ ssaTriPoint' pa pb pc' bc = Nothing | otherwise = 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. pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2 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'' 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. -- The base is the line between the first two points. heron :: Point2 -> Point2 -> Point2 -> Float diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs index 86766a182..02bdb4f87 100644 --- a/src/Geometry/Intersect.hs +++ b/src/Geometry/Intersect.hs @@ -251,10 +251,16 @@ orthogonalPointOnSeg a b p | otherwise = Just $ a +.+ param *.* (normalizeV $ b -.- a) where 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 c r a b | 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 d = closestPointOnLine a b c x = dist d c