Move towards removal of ssaTri, which was buggy

src/Dodge/Base.hs

@@ -193,9 +193,9 @@ newCrKey :: World -> Int
 newCrKey = IM.newKey .  _creatures
 {- | TODO: determine precisely what this does. -}
 reflectPointCreature :: Point2 -> Point2 -> Creature -> Maybe (Point2, Point2, Int)
-reflectPointCreature p1 p2 cr = case collidePointCirc p1 p2 (_crRad cr) (_crPos cr) of
+reflectPointCreature p1 p2 cr = case intersectCircSegFirst (_crPos cr) (_crRad cr) p1 p2 of
     Nothing -> Nothing
-    Just _ -> Just 
+    Just a -> Just 
         ( p1
         , errorNormalizeV 35 (ssaTriPoint p2 (_crPos cr) p1 (_crRad cr) -.- _crPos cr) 
             +.+ (_crPos cr -.- _crOldPos cr)
@@ -214,7 +214,7 @@ reflectCircCreature
     -> Point2   -- ^ End point
     -> Creature 
     -> Maybe (Point2, Point2, Int)
-reflectCircCreature rad p1 p2 cr = case collidePointCirc p1 p2 (rad + _crRad cr) (_crPos cr) of
+reflectCircCreature rad p1 p2 cr = case intersectCircSegFirst (_crPos cr) (rad + _crRad cr) p1 p2 of
     Nothing -> Nothing
     Just _ -> Just 
         ( p1
@@ -335,55 +335,45 @@ collidePointWallsNorm p1 p2 ws
   where 
     f (a,_) = magV (p1 -.- a)
 -- | Returns the first creature, if any, that a point intersects with.
-collidePointCreatures :: Point2 -> Point2 -> World -> Maybe Int
+collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
-collidePointCreatures p1 p2 w 
+collidePointCreatures p1 p2 crs
     = fmap fst 
     . safeMinimumOn snd
     . IM.toList 
-    . IM.mapMaybe (\x -> collidePointCirc' p1 p2 (_crRad x) (_crPos x)) 
+    . IM.mapMaybe (\x -> fmap (dist p1) $ intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
-    $_creatures w
+    $ crs
 -- | As for 'collidePointCreatures', only increases the radius of creatures by a
 --fixed amount, thus collides a moving circle with creaures.
-collideCircCreatures :: Point2 -> Point2 -> Float -> World -> Maybe Int
+collideCircCreatures :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe Int
-collideCircCreatures p1 p2 rad w 
+collideCircCreatures p1 p2 rad = collidePointCreatures p1 p2 . fmap (crRad +~ rad)
-    = fmap fst 
+
-    . safeMinimumOn snd
-    . IM.toList 
-    . IM.mapMaybe (\x -> collidePointCirc' p1 p2 (rad + _crRad x) (_crPos x)) 
-    $ _creatures w
 -- | Returns the first creature id, if any, that a point intersects with, gives point
 --in creature on line.
-collidePointCrsPoint :: Point2 -> Point2 -> World -> Maybe (Point2,Int)
+collidePointCrsPoint :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Int)
-collidePointCrsPoint p1 p2 w 
+collidePointCrsPoint p1 p2 crs
     = fmap f 
-    . safeMinimumOn (snd . snd)
+    . safeMinimumOn (dist p1 . snd)
     . IM.toList 
-    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
+    . IM.mapMaybe (\x -> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
-    $ _creatures w
+    $ crs
   where 
-    f (cID,(p,_)) = (p,cID)
+    f (cID,p) = (p,cID)
 {- | Finds the first creature hit on a line.
 Maybe evaluates the creature id and hit point. -}
-collideCircCrsPoint :: Point2 -> Point2 -> Float -> World -> Maybe (Point2,Int)
+collideCircCrsPoint :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe (Point2,Int)
-collideCircCrsPoint p1 p2 rad w 
+collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
-    = fmap f 
+
-    . safeMinimumOn (snd . snd)
+---- | Makes a creature not hittable.
-    . IM.toList 
+--collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
-    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (rad + _crRad x) (_crPos x)) 
+--collidePointCrsWithoutPoint cid p1 p2 w 
-    $ _creatures w
+--    = fmap f 
-  where 
+--    . safeMinimumOn (snd . snd)
-    f (cID,(p,_)) = (p,cID)
+--    . IM.toList 
--- | Makes a creature not hittable.
+--    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
-collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
+--    . IM.delete cid 
-collidePointCrsWithoutPoint cid p1 p2 w 
+--    $ _creatures w
-    = fmap f 
+--  where 
-    . safeMinimumOn (snd . snd)
+--    f (cID,(p,_)) = (p,cID)
-    . IM.toList 
-    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
-    . IM.delete cid 
-    $ _creatures w
-  where 
-    f (cID,(p,_)) = (p,cID)
 {- | Test if a circle collides with any wall. 
  - Note no check on whether the wall is walkable. -}
 circOnSomeWall :: Point2 -> Float -> World -> Bool

src/Dodge/Item/Weapon/Launcher.hs

@@ -204,7 +204,7 @@ moveShell pj w
     vel      = _pjVel pj
     projectileExplosion = _pjPayload pj
     newPos   = oldPos +.+ vel
-    hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
+    hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 (_creatures w)
     hitWl    = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
 
@@ -363,7 +363,7 @@ moveRemoteShell cid itid pj w
     accel    = rotateV newdir (V2 2 0)
     (frict,g)  = randomR (0.6,0.9) $ _randGen w
     (sparkD,_) = randomR (-0.5,0.5) $ _randGen w
-    hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
+    hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 (_creatures w)
     hitWl    = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
     r1 = _randGen w & evalState (randInCirc 10)

src/Dodge/Item/Weapon/UseEffect.hs

@@ -1,11 +1,10 @@
 {- |
 Effects centered on creatures.
 These are typically item effects, and typical occur when an item is explictly used.  -}
-module Dodge.Item.Weapon.UseEffect
+module Dodge.Item.Weapon.UseEffect where
-    where
 import Dodge.Data
-import Dodge.Zone
+--import Dodge.Zone
-import Dodge.Picture.Layer
+--import Dodge.Picture.Layer
 import Picture
 import Geometry
 
@@ -78,7 +77,8 @@ mvRadar
     -> Point2   -- ^ Center of expanding circle
     -> World -> Particle -> (World, Maybe Particle)
 mvRadar 0 _ w _  = (w, Nothing)
-mvRadar x p w pt = undefined
+mvRadar _ _ w _  = (w, Nothing)
+--mvRadar x p w pt = undefined
 --    ( putBlips w
 --    , Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p }
 --    )

src/Dodge/Placement/Instance/Turret.hs

@@ -37,7 +37,7 @@ putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMa
 lasTurret :: MachineType
 lasTurret = Turret
     { _tuWeapon = lasGun
-    --{ _tuWeapon = autoRifle
+--    { _tuWeapon = autoRifle
     , _tuTurnSpeed = 0.1
     , _tuFireTime = 0
     , _tuMCrID = Nothing

src/Dodge/WorldEvent/ThingsHit.hs

@@ -124,14 +124,9 @@ thingsHitLongLine sp ep w
   where 
     crs = mapMaybe 
         (\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
-        . IM.elems $ _creatures w
+        . IM.elems 
-    --crs  = zip crPs (map Left hitCrs)
-    hitCrs = IM.elems 
-        . IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
         $ _creatures w
     --   $ creaturesAlongLine sp ep w
-    crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
-    --crPs = map _crPos hitCrs
     wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
     --hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
     hitWls = wallsOnLine sp ep $ _walls w

src/Geometry.hs

@@ -188,12 +188,12 @@ ssaTriPoint pa pb pc' bc
           ac = ssaTri ab bc a
       in  pa +.+ (ac *.* errorNormalizeV 47 (pc' -.- pa))
 -- | Safe version of 'ssaTriPoint'.
-ssaTriPoint' :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
+--ssaTriPoint' :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
-ssaTriPoint' pa pb pc' bc
+--ssaTriPoint' pa pb pc' bc
-    | dist pb (closestPointOnSeg pa pc' pb) >= bc
+--    | dist pb (closestPointOnSeg pa pc' pb) >= bc
-        = Nothing
+--        = Nothing
-    | otherwise
+--    | otherwise
-        = Just $ ssaTriPoint pa pb pc' bc
+--        = Just $ ssaTriPoint pa pb pc' bc
 -- | Return Just a point if it is inside a circle, Nothing otherwise.
 pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2
 pointInCircle p r c 
@@ -203,16 +203,16 @@ pointInCircle p r c
 -- | Determines if a moving point intersects with a circle,
 -- if so, returns a point on circle that intersects with the line passing
 -- throught the circle : HOPEFULLY THE CORRECT OF THE TWO!
-collidePointCirc :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
+--collidePointCirc :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
-collidePointCirc p1 p2 rad c = ssaTriPoint' p2 c p1 rad
+--collidePointCirc p1 p2 rad c = ssaTriPoint' p2 c p1 rad
 -- | As 'collidePointCirc', but changes the point to a measure of the distance.
-collidePointCirc' :: Point2 -> Point2 -> Float -> Point2 -> Maybe Float
+--collidePointCirc' :: Point2 -> Point2 -> Float -> Point2 -> Maybe Float
-collidePointCirc' p1 p2 rad c = fmap (\x -> magV (x -.- p1))
+--collidePointCirc' p1 p2 rad c = fmap (\x -> magV (x -.- p1))
-    (collidePointCirc p1 p2 rad c)
+--    (collidePointCirc p1 p2 rad c)
 -- | As 'collidePointCirc', but returns both the point and the measure of the distance.
-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
 -- | Finds the height of a triangle using herons formula.
 -- The base is the line between the first two points.
 heron :: Point2 -> Point2 -> Point2 -> Float

src/Geometry/Intersect.hs

@@ -8,8 +8,7 @@ import Geometry.LHS
 import Control.Applicative
 
 import Data.List
-
+import Data.Maybe
-import Data.Maybe (isNothing)
 -- | If two lines intersect, return 'Just' that point.
 intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectLineLine' #-}
@@ -267,3 +266,6 @@ intersectCircSeg c r a b
     y = r ** 2 - x ** 2
     z = sqrt y
     v = z *.* normalizeV (b -.- a)
+
+intersectCircSegFirst :: Point2 -> Float -> Point2 -> Point2 -> Maybe Point2
+intersectCircSegFirst c r a = listToMaybe . intersectCircSeg c r a