Remove ssaTri, bullet movement is broken

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 :)
-  where   
-    theFlamelet = PtZ 
+    & particles .:~ 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 
-        $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
+    crs = mapMaybe 
+        (\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
+        . IM.elems 
         $ _creatures w
-    --    $ creaturesAlongLine sp ep w
-    crPs  = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
-    crs   = zip crPs (map Left hitCrs)
-    hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1]
-                                                                      , b<-[y-1,y,y+1]])
-    --hitWls = wallsOnLine sp ep $ _walls w
+    hitWls   = wallsOnLine sp ep 
+        $ IM.unions [f b $ f a $ _znObjects $ _wallsZone w 
+            | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
+       -- $ _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))