Remove ssaTri, bullet movement is broken

src/Dodge/Base.hs

@@ -191,50 +191,6 @@ newProjectileKey = IM.newKey . _props
 {- | Finds unused creature key. -}
 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 intersectCircSegFirst (_crPos cr) (_crRad cr) p1 p2 of
-    Nothing -> Nothing
-    Just a -> Just 
-        ( p1
-        , errorNormalizeV 35 (ssaTriPoint p2 (_crPos cr) p1 (_crRad cr) -.- _crPos cr) 
-            +.+ (_crPos cr -.- _crOldPos cr)
-        , _crID cr)
-{- | TODO: determine precisely what this does. -}
-reflectPointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Point2,Int)
-reflectPointCreatures p1 p2 cs 
-    = safeMinimumOn f
-    $ IM.mapMaybe (reflectPointCreature p1 p2) cs
-  where 
-    f (a,_,_) = magV (a -.- p1)
-{- | TODO: determine precisely what this does. -}
-reflectCircCreature 
-    :: Float    -- ^ Radius
-    -> Point2   -- ^ Start point
-    -> Point2   -- ^ End point
-    -> Creature 
-    -> Maybe (Point2, Point2, Int)
-reflectCircCreature rad p1 p2 cr = case intersectCircSegFirst (_crPos cr) (rad + _crRad cr) p1 p2 of
-    Nothing -> Nothing
-    Just _ -> Just 
-        ( p1
-        , errorNormalizeV 37 (ssaTriPoint p2 (_crPos cr) p1 (_crRad cr) -.- _crPos cr) 
-            +.+ (_crPos cr -.- _crOldPos cr)
-        , _crID cr
-        )
-{- | TODO: determine precisely what this does. -}
-reflectCircCreatures 
-    :: Float    -- ^ Radius
-    -> Point2   -- ^ Start point
-    -> Point2   -- ^ End point
-    -> IM.IntMap Creature 
-    -> Maybe (Point2,Point2,Int)
-reflectCircCreatures rad p1 p2 cs 
-    = safeMinimumOn f 
-    $ IM.mapMaybe (reflectCircCreature rad p1 p2) cs
-  where 
-    f (a,_,_) = magV (a -.- p1)
-
 -- | collides a point with forcefields
 -- if found, returns point of collision, deflection if required, and the id
 collidePointFFs :: a
@@ -336,12 +292,10 @@ collidePointWallsNorm p1 p2 ws
     f (a,_) = magV (p1 -.- a)
 -- | Returns the first creature, if any, that a point intersects with.
 collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
-collidePointCreatures p1 p2 crs
+collidePointCreatures p1 p2 = fmap fst 
-    = fmap fst 
     . safeMinimumOn snd
     . IM.toList 
-    . IM.mapMaybe (\x -> fmap (dist p1) $ intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
+    . IM.mapMaybe (\x -> dist p1 <$> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
-    $ 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 -> IM.IntMap Creature -> Maybe Int
@@ -350,12 +304,10 @@ collideCircCreatures p1 p2 rad = collidePointCreatures p1 p2 . fmap (crRad +~ ra
 -- | Returns the first creature id, if any, that a point intersects with, gives point
 --in creature on line.
 collidePointCrsPoint :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Int)
-collidePointCrsPoint p1 p2 crs
+collidePointCrsPoint p1 p2 = fmap f 
-    = fmap f 
     . safeMinimumOn (dist p1 . snd)
     . IM.toList 
     . IM.mapMaybe (\x -> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
-    $ crs
   where 
     f (cID,p) = (p,cID)
 {- | Finds the first creature hit on a line.

src/Dodge/Data.hs

@@ -463,7 +463,7 @@ data Particle
     | BulletPt  
         { _ptDraw   :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _btVel'   :: Point2
+        , _ptVel    :: Point2
         , _btDrag   :: Float
         , _btColor' :: Color
         , _btTrail' :: [Point2]
@@ -475,7 +475,7 @@ data Particle
     | PtZ  
         { _ptDraw :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _btVel' :: Point2
+        , _ptVel    :: Point2
         , _btColor' :: Color
         , _btPos' :: Point2
         , _btPassThrough' :: Maybe Int

src/Dodge/Magnet.hs

@@ -6,17 +6,17 @@ import Control.Lens
 
 dampField :: Magnet -> Particle -> Particle
 dampField mg pt = case pt of
-    BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 100 -> pt & btVel' *~ 0.5
+    BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 100 -> pt & ptVel *~ 0.5
     _ -> pt
 
 curveLeftField :: Magnet -> Particle -> Particle
 curveLeftField mg pt = case pt of
-    BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 500 -> pt & btVel' %~ rotateV 0.2
+    BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 500 -> pt & ptVel %~ rotateV 0.2
     _ -> pt
 
 curveAroundField :: Float -> Float -> Magnet -> Particle -> Particle
 curveAroundField minrad maxrad mg pt = case pt of
-    BulletPt{} | thedist < maxrad -> pt & btVel' %~ rotateToCircle
+    BulletPt{} | thedist < maxrad -> pt & ptVel %~ rotateToCircle
       where
         thedist = dist btpos mgpos
         mgpos = _mgPos mg

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -28,7 +28,7 @@ bulHitCr bt p cr w
     | otherwise = addDamage . bulletHitSound p $ w
   where
     sp = head $ _btTrail' bt
-    bulVel = _btVel' bt
+    bulVel = _ptVel bt
     ep = sp +.+ bulVel
     mvDams = [ PushDam 1 $ 2 *.* bulVel ]
     addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
@@ -46,7 +46,7 @@ bulBounceArmCr' bt p cr w
     | otherwise = addDamage . bulletHitSound p $ w
   where
     sp = head $ _btTrail' bt
-    bulVel = _btVel' bt
+    bulVel = _ptVel bt
     ep = sp +.+ bulVel
     mvDams = [ PushDam 1 $ 2 *.* bulVel ]
     addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
@@ -77,9 +77,9 @@ bulPenCr' bt p cr w
     (d1,_)  = randomR (-0.7,0.7) $ _randGen w
     cid = _crID cr
     sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
     addPiercer = over particles (piercer :)
-    piercer = (aGenBulAt (Just cid) p (_btVel' bt) (_btDrag bt)
+    piercer = (aGenBulAt (Just cid) p (_ptVel bt) (_btDrag bt)
                                       (_btHitEffect' bt) (_btWidth' bt)
               ) {_btTimer' = _btTimer' bt - 1}
 {- | Heavy bullet effects when hitting creature:
@@ -100,7 +100,7 @@ hvBulHitCr bt p cr w
     (d1,_)  = randomR (-0.7,0.7) $ _randGen w
     cid = _crID cr
     sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
 {- | Create a flamelet when hitting a creature.  -}
 bulIncCr :: Particle -> Point2 -> Creature -> World -> World
 bulIncCr bt p cr w 
@@ -112,7 +112,7 @@ bulIncCr bt p cr w
   where   
     cid = _crID cr
     sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
     v = evalState (randInCirc 1) $ _randGen w
     incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20)
 {- | Creates a shockwave when hitting a creature.  -}
@@ -124,23 +124,23 @@ bulConCr bt p cr
   where   
     cid = _crID cr
     sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
 {- | Hitting wall effects: create a spark, damage blocks.  -}
 bulHitWall :: Particle -> Point2 -> Wall -> World -> World
 bulHitWall bt p = damageWall (Piercing 100 sp p ep)
   where 
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
     sp = head $ _btTrail' bt
 {- | Bounce off walls, do damage to blocks.  -}
 bulBounceWall :: Particle -> Point2 -> Wall -> World -> World
 bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addBouncer
   where 
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
     sp = head $ _btTrail' bt
     pOut = p +.+ squashNormalizeV (sp -.- p)
     bouncer = (aGenBulAt Nothing pOut reflectVel 0.5 (_btHitEffect' bt) (_btWidth' bt)
               ) {_btTimer' = _btTimer' bt - 1}
-    reflectVel = reflVelWall wl (_btVel' bt)
+    reflectVel = reflVelWall wl (_ptVel bt)
     addBouncer = ( over particles (bouncer : ) . )
 -- the hack is to get around the fact that the particles list gets reset after
 -- all projectiles in it are checked, so we cannot add to it as we accumulate over
@@ -155,11 +155,11 @@ bulIncWall
     -> World
 bulIncWall bt p wl =  damageWall (Blunt 50 sp p ep) wl . incFlamelets
   where   
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
     sp = head $ _btTrail' bt
     pOut = p +.+ squashNormalizeV (sp -.- p)
     wallV = uncurry (-.-) (_wlLine wl)
-    reflectVel = squashNormalizeV $ reflectIn wallV (_btVel' bt)
+    reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt)
     incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20)
 {- | Create a shockwave on wall-}
 bulConWall
@@ -171,7 +171,7 @@ bulConWall
 bulConWall bt p wl = damageWall (Blunt 10 sp p ep) wl .
     over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) 
   where   
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
     sp = head $ _btTrail' bt
 
 hvBulHitWall 
@@ -184,7 +184,7 @@ hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl
     . damageWall (Blunt 100 sp p ep) wl  
     $ set randGen g $ foldr ($) w (sparks pOut sv)
   where 
-    ep = sp +.+ _btVel' bt
+    ep = sp +.+ _ptVel bt
     sp = head $ _btTrail' bt
     pOut = p +.+ squashNormalizeV (sp -.- p)
     (a, g) = randomR (-0.2,0.2) $ _randGen w

src/Dodge/Particle/Bullet/Spawn.hs

@@ -23,7 +23,7 @@ aGenBulAt
 aGenBulAt maycid pos vel drag hiteff width = BulletPt
     { _ptDraw = drawBul
     , _ptUpdate = mvBullet
-    , _btVel'   = vel
+    , _ptVel    = vel
     , _btDrag   = drag
     , _btColor' = V4 2 2 2 2
     , _btTrail' = [pos]
@@ -44,7 +44,7 @@ aDelayedBulAt
 aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt
     { _ptDraw = drawBul
     , _ptUpdate = \w -> resetVel . mvBullet w
-    , _btVel' = vfact *.* vel
+    , _ptVel  = vfact *.* vel
     , _btDrag = drag
     , _btColor' = V4 2 2 2 2
     , _btTrail' = [pos]
@@ -54,7 +54,7 @@ aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt
     , _btHitEffect' = hiteff
     }
   where
-    resetVel = second $ fmap $ (ptUpdate .~ mvBullet) . (btVel' .~ vel)
+    resetVel = second $ fmap $ (ptUpdate .~ mvBullet) . (ptVel .~ vel)
 
 aCurveBulAt 
     :: Maybe Int -- ^ Pass-through creature id
@@ -68,7 +68,7 @@ aCurveBulAt
 aCurveBulAt maycid col pos control targ hiteff width = BulletPt
     { _ptDraw = drawBul
     , _ptUpdate = \w -> mvBullet w . setVel
-    , _btVel' = V2 0 0
+    , _ptVel  = V2 0 0
     , _btDrag = 1
     , _btColor' = col
     , _btTrail' = [pos]
@@ -78,5 +78,5 @@ aCurveBulAt maycid col pos control targ hiteff width = BulletPt
     , _btHitEffect' = hiteff
     }
   where 
-    setVel pt = pt & btVel' .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt)
+    setVel pt = pt & ptVel .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt)
     bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05

src/Dodge/Particle/Bullet/Update.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 {- Bullet update.  -}
 module Dodge.Particle.Bullet.Update
     ( mvBullet
@@ -15,15 +15,15 @@ import Control.Lens
 {- Update for a generic bullet.  -}
 mvBullet :: World -> Particle -> (World, Maybe Particle)
 mvBullet w bt' 
-    | t <= 0 || magV (_btVel' bt) < 1 = (w,Nothing)
+    | t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
     | otherwise = second (fmap dodrag) $ 
         hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
   where
     bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
-    dodrag = btVel' %~ (drag *.*)
+    dodrag = ptVel %~ (drag *.*)
     drag = _btDrag bt
     mcr     = _btPassThrough' bt
     (p:_)  = _btTrail' bt
-    vel     = _btVel' bt
+    vel     = _ptVel bt
     hiteff  = _btHitEffect' bt
     t       = _btTimer' bt

src/Dodge/Particle/Spark.hs

@@ -16,30 +16,28 @@ import System.Random
 --import Control.Lens
 
 createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> World
-createBarrelSpark pos dir maycid time colid w = w 
+createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt  
-    & instantParticles .:~ spark
+    { _ptDraw = drawBul
+    , _ptUpdate = mvBullet
+    , _ptVel = rotateV dir (V2 5 0)
+    , _btDrag = 0.9
+    , _btColor' = numColor colid
+    , _btTrail' = [pos]
+    , _btPassThrough' = maycid
+    , _btWidth' = 1
+    , _btTimer' = time
+    , _btHitEffect' = destroyOnImpact sparkEff noEff
+    }
   where 
-    spark = BulletPt  
-        { _ptDraw = drawBul
-        , _ptUpdate = mvBullet
-        , _btVel' = rotateV dir (V2 5 0)
-        , _btDrag = 0.9
-        , _btColor' = numColor colid
-        , _btTrail' = [pos]
-        , _btPassThrough' = maycid
-        , _btWidth' = 1
-        , _btTimer' = time
-        , _btHitEffect' = destroyOnImpact sparkEff noEff
-        }
     sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
-      where 
+      where
         sp = head (_btTrail' bt)
-        ep = sp +.+ _btVel' bt
+        ep = sp +.+ _ptVel bt
 colSpark :: Int -> Color -> Point2 -> Float -> World -> World
 colSpark = colSpark' 0.7
 colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World
 colSpark' randDir time col pos baseDir w = w 
-    & worldEvents %~ ( over particles (spark :) . )
+    & instantParticles .:~ spark
     & randGen .~ g
   where 
     (a,g)  = randomR (-randDir,randDir) $ _randGen w
@@ -48,7 +46,7 @@ colSpark' randDir time col pos baseDir w = w
         { _ptDraw = drawBul
         , _ptUpdate = mvBullet
         , _btDrag   = 0.9
-        , _btVel' = rotateV dir (V2 5 0)
+        , _ptVel = rotateV dir (V2 5 0)
         , _btColor' = col
         , _btTrail' = [pos]
         , _btPassThrough' = Nothing
@@ -59,4 +57,4 @@ colSpark' randDir time col pos baseDir w = w
     sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
       where 
         sp = head (_btTrail' bt)
-        ep = sp +.+ _btVel' bt
+        ep = sp +.+ _ptVel bt

src/Dodge/WorldEvent/HitEffect.hs

@@ -47,7 +47,7 @@ mvPt pt = Just $ pt
     & btTimer' -~ 1
     & btPassThrough' .~ Nothing
   where
-    f trl = head trl +.+ _btVel' pt : trl
+    f trl = head trl +.+ _ptVel pt : trl
 
 destroyAt :: Point2 -> Particle -> Maybe Particle
 destroyAt hitp pt = Just $ pt 
@@ -60,7 +60,7 @@ killBulletUpdate w pt
     | _btTimer' pt <= 0 = (w,Nothing)
     | otherwise = (w
         ,Just $ pt & btTimer' -~ 1
-            & btTrail' %~ (\(x:xs) -> (x:x:xs))
+            & btTrail' %~ (\(x:xs) -> x:x:xs)
         )
 
 penWalls 
@@ -82,7 +82,7 @@ doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
     (Flaming amount sp p ep :)
   where 
     sp = _btPos' pt
-    ep = sp +.+ _btVel' pt
+    ep = sp +.+ _ptVel pt
 
 noEff :: a -> b -> c -> d -> d
 noEff _ _ _ = id

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -20,8 +20,8 @@ import Geometry
 --import Geometry.Vector3D
 --import Geometry.Data
 import qualified IntMapHelp as IM
+import LensHelp
 
-import Control.Lens
 import System.Random
 import Control.Monad.State
 import Data.Tuple
@@ -34,7 +34,7 @@ aFlameParticle
 aFlameParticle t pos vel maycid = PtZ
     { _ptDraw         = drawFlame vel
     , _ptUpdate       = moveFlame vel
-    , _btVel'         = vel
+    , _ptVel          = vel
     , _btColor'       = red
     , _btPos'         = pos
     , _btPassThrough' = maycid
@@ -90,13 +90,13 @@ moveFlame rotd w pt
     time = _btTimer' pt
     doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2)
     sp@(V2 x y) = _btPos' pt
-    vel = _btVel' pt
+    vel = _ptVel pt
     ep = sp +.+ vel
     mvPt speed = Just $ pt 
         { _btTimer' = time - 1
         , _btPos' = ep
         , _btPassThrough' = Nothing
-        , _btVel' = speed *.* vel    }
+        , _ptVel = speed *.* vel    }
     damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w 
         $ IM.filter closeCrs $ _creatures w
     closeCrs cr = dist ep (_crPos cr) 
@@ -107,7 +107,7 @@ moveFlame rotd w pt
     rfl wl p = Just $ pt 
         { _btTimer' = time -1
         , _btPos' = pOut p
-        , _btVel' = reflV wl
+        , _ptVel = reflV wl
         }
     pOut p = p +.+ squashNormalizeV (sp -.- p)
     reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
@@ -124,12 +124,10 @@ makeFlameletTimed
     -> World
 makeFlameletTimed (V2 x y) z vel maycid size time w = w
     & randGen   .~ g
-    & particles %~ (theFlamelet :)
+    & particles .:~ PtZ 
-  where   
-    theFlamelet = PtZ 
         { _ptDraw         = drawFlameletZ rot
         , _ptUpdate       = moveFlamelet
-        , _btVel'         = vel
+        , _ptVel         = vel
         , _btColor'       = red
         , _btPos'         = V2 x y
         , _btPassThrough' = maycid
@@ -138,6 +136,7 @@ makeFlameletTimed (V2 x y) z vel maycid size time w = w
         , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff
         , _ptZ = z
         }
+  where
     (rot ,g) = randomR (0,3) $ _randGen w
 
 drawFlameletZ
@@ -152,7 +151,7 @@ drawFlameletZ rot pt = pictures
   where
     z = _ptZ pt
     sp = _btPos' pt
-    vel = _btVel' pt
+    vel = _ptVel pt
     ep = sp +.+ vel
     size = _btWidth' pt
     siz2 = size + 0.2
@@ -193,13 +192,13 @@ moveFlamelet w pt
     | otherwise         = (flameFlicker pt damcrs,    mvPt)
   where   
     sp = _btPos' pt
-    vel = _btVel' pt
+    vel = _ptVel pt
     ep = sp +.+ vel
     size = _btWidth' pt
     mvPt = Just $ pt & btTimer'       -~ 1
                      & btPos'         .~ ep
                      & btPassThrough' .~ Nothing
-                     & btVel'         .~ 0.8 *.* vel
+                     & ptVel         .~ 0.8 *.* vel
     damcrs = w & creatures %~ IM.map damifclose
     isClose cr = dist ep (_crPos cr) < _crRad cr + size
     damifclose cr 

src/Dodge/WorldEvent/ThingsHit.hs

@@ -7,7 +7,6 @@ module Dodge.WorldEvent.ThingsHit
     , thingHit
     , thingsHitLongLine
     , thingsHitExceptCr
-    , thingsHitExceptCr3D'
     , thingsHitExceptCrLongLine
     )
     where
@@ -19,7 +18,7 @@ import Geometry
 import qualified Data.IntMap.Strict as IM
 import Data.List
 import Data.Maybe
-import Data.Bifunctor
+--import Data.Bifunctor
 {- List those objects that appear on a line.  -}
 thingsHit
     :: Point2    -- ^ Line start point
@@ -30,67 +29,22 @@ thingsHit sp ep w
     | sp == ep  = []
     | otherwise = sortOn (dist sp . fst) (crs ++ wls)
   where 
-    hitCrs = IM.elems 
+    crs = mapMaybe 
-        $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
+        (\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
+        . IM.elems 
         $ _creatures w
-    --    $ creaturesAlongLine sp ep w
+    hitWls   = wallsOnLine sp ep 
-    crPs  = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
+        $ IM.unions [f b $ f a $ _znObjects $ _wallsZone w 
-    crs   = zip crPs (map Left hitCrs)
+            | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
-    hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1]
+       -- $ _walls w
-                                                                      , b<-[y-1,y,y+1]])
-    --hitWls = wallsOnLine sp ep $ _walls w
     (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
     f i m = case IM.lookup i m of 
         Just val -> val
         _        -> 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 
@@ -120,7 +74,7 @@ thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine
 thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
 thingsHitLongLine sp ep w 
     | sp == ep  = []
-    | otherwise = sortOn (dist sp . fst) (crs ++  wls)
+    | otherwise = sortOn (dist sp . fst) (crs ++ wls)
   where 
     crs = mapMaybe 
         (\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))

src/Geometry.hs

@@ -164,55 +164,13 @@ diffAngles x y
     | otherwise  = diffAngles (x + 2*pi) y
   where 
     diff = x-y
--- | Given a triangle where we know the length of a first side,
--- the length of a second side, and the angle between the first side and the
--- third side, finds the length of the third side.
--- Note this doesn't necessarily find ALL solutions, asin is a map not a function.
-ssaTri :: Float -> Float -> Float -> Float
-ssaTri ab bc a 
-    | sin a == 0 = ab - bc
-    | bc == 0    = ab
-    | otherwise = 
-        let c = asin ( (ab * sin a)/bc)
-            b = pi - (a + c)
-        in  sin b * bc / sin a
--- | Given two points of a triangle and a third point, return
--- the point which lies between pa and pc' on a line from pb of length bc.
--- Note that there are likely two such points, this should return the point
--- closer to pc'.
--- TODO this still causes errors, should be made error free
-ssaTriPoint :: Point2 -> Point2 -> Point2 -> Float -> Point2
-ssaTriPoint pa pb pc' bc
-    = let ab = magV (pa -.- pb)
-          a  = errorAngleVV 6 (pb -.- pa) (pc' -.- pa)
-          ac = ssaTri ab bc a
-      in  pa +.+ (ac *.* errorNormalizeV 47 (pc' -.- pa))
--- | Safe version of 'ssaTriPoint'.
---ssaTriPoint' :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
---ssaTriPoint' pa pb pc' bc
---    | dist pb (closestPointOnSeg pa pc' pb) >= bc
---        = Nothing
---    | otherwise
---        = 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 
     | p == c = Just p
     | magV (p -.- c) < r = Just p
     | otherwise = Nothing
--- | 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 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' p1 p2 rad c = fmap (\x -> magV (x -.- p1))
---    (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'' 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

@@ -247,7 +247,7 @@ closestPointOnSeg segP1 segP2 p
 orthogonalPointOnSeg :: Point2 -> Point2 -> Point2 -> Maybe Point2
 orthogonalPointOnSeg a b p
     | param < 0 || param > 1 = Nothing
-    | otherwise              = Just $ a +.+ param *.* (normalizeV $ b -.- a)
+    | otherwise              = Just $ a +.+ param *.* normalizeV (b -.- a)
   where
     param = closestPointOnLineParam a b p
 

test/Spec.hs

@@ -3,7 +3,7 @@ import Test.Tasty
 import qualified Test.Tasty.QuickCheck as QC
 import Test.Tasty.HUnit
 import Dodge.Room.CheckConsistency
-import Geometry
+--import Geometry
 
 import Dodge.LevelGen.StaticWalls
 import Geometry