Narrow down non-termination to thingsHit[LongLine]

src/Dodge/Item/Weapon.hs

@@ -337,7 +337,7 @@ launcher = defaultGun
     }
 bezierGun = defaultGun
     { _itName = "B-GUN"
-    , _wpFire = bezierTarget
+    , _wpFire = bezierControl' 
     }
 
 remoteLauncher = defaultGun 
@@ -1407,6 +1407,8 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5
                             $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 
                         ]
 
+bezTest cid w = mkBezierBul (0,11) (0,20) (0,20) cid w
+
 bezierTarget :: Int -> World -> World
 bezierTarget cid w = setTarget w
     where
@@ -1424,6 +1426,15 @@ bezierControl targetp cid w = resetGun $ shootWithSound 0 (mkBezierBul startp co
         startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
         resetGun = set (creatures . ix cid . crInv . ix j . wpFire) $ bezierTarget
 
+bezierControl' :: Int -> World -> World
+bezierControl' cid w = shootWithSound 0 (mkBezierBul startp controlp controlp) cid w
+    where 
+        j = _crInvSel $ _creatures w IM.! cid
+        controlp = _crPos cr +.+ (20,20)
+        cr = _creatures w IM.! cid
+        dir = _crDir cr
+        startp = _crPos cr +.+ (11,11)
+
 mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
 mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
     where 

src/Dodge/Item/Weapon/Bullet.hs

@@ -22,15 +22,14 @@ bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
 bulHitCr' bt p cr w = 
             let sp = head $ _btTrail' bt
                 ep = sp +.+ _btVel' bt
-               -- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ]
+                mvDams = [ PushDam 1 $ 2 *.* bulVel ]
-                mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ]
                 addDamage = over (creatures . ix cid . crState . crDamage)
                                     (\dams -> (Piercing 100 sp p ep : mvDams) ++ dams)
                 addDamageArmoured = over (creatures . ix cid . crState . crDamage)
                                     (\dams -> mvDams ++ dams)
                 hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
                 flashEff = over worldEvents ((.) $ flareAt red p)
-                bulVel = ep -.- sp
+                bulVel = _btVel' bt
                 ck cid  = (+.+) (crKnockBack cid *.* bulVel)
                 crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid
                 hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr
@@ -38,7 +37,10 @@ bulHitCr' bt p cr w =
                 sID     = newParticleKey w
                 (d1,g)  = randomR (-0.7,0.7) $ _randGen w
                 (colID,_) = randomR (0,11) $ _randGen w
-                hitEffect = addDamage . hitSound . flashEff $ w
+                hitEffect = addDamage 
+                            . hitSound 
+                            . flashEff 
+                            $ w
             in case hasArmour cr of  --shit this is ugly, to refactor
                     True -> if hitBack
                                         then hitEffect

src/Dodge/WorldActions.hs

@@ -1,10 +1,16 @@
 module Dodge.WorldActions 
     ( module Dodge.WorldActions
     , module Dodge.WorldActions.Bullet
+    , module Dodge.WorldActions.Flash
+    , module Dodge.WorldActions.ThingsHit
+    , module Dodge.WorldActions.HelperParticle
     )
     where
 
 import Dodge.WorldActions.Bullet
+import Dodge.WorldActions.Flash
+import Dodge.WorldActions.ThingsHit
+import Dodge.WorldActions.HelperParticle
 
 import Dodge.Data
 import Dodge.Base
@@ -230,13 +236,6 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
             where sp = head (_btTrail' bt)
                   ep = sp +.+ _btVel' bt
 
-flareAt :: Color -> Point2 -> World -> World
-flareAt c p = flareAt' c 0.02 0.5 p
-
-flareAt' :: Color -> Float -> Float -> Point2 -> World -> World
-flareAt' col alphax alphay p 
-    =  over particles' ((:) (flashColAt col alphax p))
-      . lowLightColAt col alphay p
 
         
 tLightFade :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
@@ -290,16 +289,6 @@ flashRadAt rad col alphax (x,y) =
         , _ptUpdate' = ptTimer' 1
         }
 
-flashColAt :: Color -> Float -> Point2 -> Particle'
-flashColAt col alphax (x,y) =
-    Particle' 
-        { _ptPict' = pictures $
-                         map (\i -> onLayerL [levLayer PtLayer] 
-                                    $ color (withAlpha alphax col) $ translate x y $ circleSolid i
-                         )
-                         [20,25,30,35,40,45,50]
-        , _ptUpdate' = ptTimer' 1
-        }
 lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
 lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps
     where ps = map ((+.+) p) $ nRaysRad rays rad
@@ -308,29 +297,11 @@ lowLightRadAt :: Color -> Float -> Int -> Float -> Point2 -> World -> World
 lowLightRadAt col alphay rays rad p w = foldr (lowLightColHit col alphay p) w ps
     where ps = map ((+.+) p) $ nRaysRad rays rad
 
-lowLightColAt :: Color -> Float ->  Point2 -> World -> World
-lowLightColAt col alphay p w = foldr (lowLightColHit col alphay p) w ps
-    where ps = map ((+.+) p) $ nRaysRad 20 30
 
 lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World
 lowLightDirected col alpha a b angles w
     = foldr (\angle w' -> lowLightColHit col alpha a (a +.+ rotateV angle b) w') w angles
 
-lowLightColHit :: Color -> Float -> Point2 -> Point2 -> World -> World
-lowLightColHit col alphay a b w 
-    = case thingsHitLongLine a b w of
-        ((p, E3x2 wall):_) 
-            -> over particles' ((:) (wallGlareCol col alphay p wall)) w
-        ((p, E3x1 cr):_) 
-            -> over afterParticles' ((:) (crGlareCol col alphay p cr)) w
-        _  -> w
-
-wallGlareCol :: Color -> Float -> Point2 -> Wall -> Particle'
-wallGlareCol col alphay p wl = wallGlareWidth 10 5 col alphay p wl
-
-crGlareCol :: Color -> Float -> Point2 -> Creature -> Particle'
-crGlareCol col alphay p cr = crGlareWidth 5 col alphay p cr
-
 lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
 lowLightWidthHit len wdth col alphay a b w 
     = case thingsHitLongLine a b w of
@@ -340,34 +311,6 @@ lowLightWidthHit len wdth col alphay a b w
             -> over afterParticles' ((:) (crGlareWidth wdth col alphay p cr)) w
         _  -> w
 
-wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
-wallGlareWidth len wdth col alphay p wl = 
-    Particle'
-        { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l
-        , _ptUpdate' = ptTimer' 1
-        }
-    where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x]
-          x = len *.* ( normalizeV $ a -.- b)
-          (a:b:_) = _wlLine wl
-
-crGlareWidth :: Float -> Color -> Float -> Point2 -> Creature -> Particle'
-crGlareWidth wdth col alphay p cr =
-    Particle'
-        { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp
-        , _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w
-                                              ,_ptUpdate' = ptTimer' 0
-                                              }
-                                )
-        }
-    where l x = uncurry translate x
-                $ rotate (-0.25*pi + argV (p -.- x))
-                $ color (withAlpha alphay col) 
-                $ thickArc 0 (pi/2) (_crRad cr) wdth
-          cp = _crPos cr
-          cid = _crID cr
-          upp cid' w' = case w' ^? creatures . ix cid . crPos of
-                            Just y -> l y 
-                            _      -> blank
 
 muzFlareAt :: Point2 -> World -> World
 muzFlareAt p = over particles' ((:) (muzzleFlareAt p))
@@ -383,9 +326,6 @@ muzzleFlareAt (x,y) =
         , _ptUpdate' = ptTimer' 1
         }
 
-ptTimer' :: Int -> World -> Particle' -> (World, Maybe Particle')
-ptTimer' 0 w pt = (w, Nothing)
-ptTimer' n w pt = (w, Just $ pt {_ptUpdate' = ptTimer' (n-1)})
 
 lowLightAt :: Point2 -> World -> World
 lowLightAt p w = lowLightWidthAt 10 5 white 0.5 20 30 p w
@@ -434,34 +374,6 @@ threeEff' crEff wlEff ffEff pt thing w = case thing of
 
 
 
-thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World 
-                        -> [(Point2, (Either3 Creature Wall ForceField))]
-thingsHitExceptCrLongLine Nothing    sp ep = thingsHitLongLine sp ep
-thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
-    where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
-          crNotCid _ = True
-
-thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
---thingsHitLongLine sp ep w = crs ++ walls
-thingsHitLongLine sp ep w = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
-    where hitCrs = IM.elems $ IM.filter (\cr -> circOnLine 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
-          crs   = zip crPs (map E3x1 hitCrs)
-        --  hitWls   = wallsOnLine sp ep (f y $ f x $ _wallsZone w)
-          hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
-          --hitWls = wallsOnLine sp ep $ _walls w
-          f i m = case IM.lookup i m of Just val -> val
-                                        _        -> IM.empty
-          --walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
-          walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
-          hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
---          hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
-          hitFFs   = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
-          ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
-          cr = _creatures w IM.! 0
 
 makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
 makeFlameletTimed  pos vel levelInt maycid size time w