Refactoring, linting

src/Dodge/Item/Weapon/UseEffect.hs

@@ -6,6 +6,7 @@ module Dodge.Item.Weapon.UseEffect
 import Dodge.Data
 import Dodge.Base
 import Dodge.Item.Weapon.Decoration
+import Dodge.Item.Weapon.TriggerType
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Picture
@@ -102,9 +103,97 @@ mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic
                       ++ (IM.elems $ wallsAlongCirc p r w)
     r = fromIntegral (800 - x*16)
     sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
-                --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
-                --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
+                 --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
+                 --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
                 ]
     globalAlpha | x > 10 = 1
                 | otherwise = fromIntegral x / 10
     colHelper y = color (withAlpha (y * globalAlpha) red)
+
+aTractorBeam 
+    :: Int      -- ^ Color id
+    -> Int      -- ^ Creature id
+    -> World 
+    -> World
+aTractorBeam col cid w
+        = set (creatures . ix cid . crInv . ix itRef . wpFire)
+                        (shoot $ aTractorBeam ((col + 1) `mod` 10))
+                      $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
+  where 
+    i = newProjectileKey w
+    cr  = (_creatures w IM.! cid)
+    pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir)
+    dir = _crDir cr
+    itRef = _crInvSel cr
+
+tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile
+tractorBeamAt colID i pos dir = Projectile
+    { _pjPos = pos
+    , _pjStartPos = p'
+    , _pjVel = d
+    , _pjPict = blank
+    , _pjID = i
+    , _pjUpdate = updateTractor colID 10 i
+    }
+  where 
+    d  = unitVectorAtAngle dir
+    p' = pos +.+ 400 *.* d
+
+{- |
+The interaction of this with objects, walls etc needs more thought.  -}
+updateTractor :: Int -> Int -> Int -> World -> World
+updateTractor colID time i w
+    | time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i) 
+                    $ set (projectiles . ix i . pjPict) pic
+                    $ over creatures (IM.map tractCr) 
+                    $ over floorItems (IM.map tractFlIt) 
+                        w
+    | otherwise = over projectiles (IM.delete i) w
+  where 
+    tractCr cr 
+        | circOnSeg p1 p2 cP 10
+                    = over crPos (\p -> 
+                                   p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4))
+                                 ) cr
+        | otherwise = cr
+       where 
+        x = abs y + 1
+        y = errorClosestPointOnLineParam 1 p1 p3 cP
+        cP = _crPos cr
+        m | dist cP p1 < 350 = 1
+          | otherwise        = (400 - dist cP p1) / 50
+    tractFlIt it | circOnSeg p1 p2 iP 10
+                           = over flItPos  (\p -> p -.- m *.* 
+                                                      ( (0.3/ x) *.* q +.+ (f y *.* p4))
+                                           ) it
+                 | otherwise = it
+          where x = abs y + 1
+                y = errorClosestPointOnLineParam 2 p1 p3 iP
+                iP = _flItPos it
+                m | dist iP p1 < 350 = 1
+                  | otherwise        = (410 - dist iP p1) / 60
+    pj = _projectiles w IM.! i
+    q = _pjVel pj
+    p1 = _pjPos pj
+    p' = _pjStartPos pj
+    p2 = maybe p' fst $ collidePointWalls p1 p' $ wallsNearPoint p' w
+    p4 = vNormal p5
+    p5 = errorNormalizeV 12 $ p2 -.- p1
+    p3 = p1 +.+ p4
+    g x | x > 5 = (10 - x) / 5
+        | x > 1 = 1
+        | x > -1 = x
+        | x > -5 = -1
+        | otherwise = (x - 10) / 5
+    d = errorNormalizeV 13 $ p' -.- p1
+    f x = g x / 50
+    cID = fromIntegral colID / 10
+    col = mixColors 0.5 0.5 white blue
+    px z = (fromIntegral time + 5) *.* z
+    pz z = fromIntegral time * 10 *.* z
+    pic = setLayer 1 $ onLayer PtLayer $ color (withAlpha 0.05 col) 
+              $ polygon [ p1 +.+ px p4 
+                        , p1 -.- 10 *.* p5
+                        , p1 -.- px p4
+                        , (p' -.- pz p5) -.- px p4
+                        , (p' -.- pz p5) +.+ px p4]