Work on sensor machines, remove some datatypes associated with placements

src/Dodge/WorldEvent/Damage.hs

@@ -0,0 +1,22 @@
+module Dodge.WorldEvent.Damage
+    ( damThingHitWith
+    ) where
+import Dodge.Data
+import Dodge.Data.DamageType
+import Dodge.Creature.State.Data
+import Geometry
+import Dodge.Wall.Damage
+
+import Control.Lens
+
+damThingHitWith 
+    :: (Point2 -> Point2 -> Point2 -> DamageType)
+    -> Point2
+    -> Point2
+    -> Maybe (Point2, Either Creature Wall)
+    -> World 
+    -> World
+damThingHitWith partDT sp ep mayEiCrWl = case mayEiCrWl of
+    Just (hitp,Left cr )  -> creatures . ix (_crID cr) . crState . crDamage %~ (partDT sp hitp ep :)
+    Just (hitp,Right wl) -> damageWall (partDT sp hitp ep) wl
+    Nothing -> id

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -5,25 +5,17 @@ module Dodge.WorldEvent.SpawnParticle
     ( makeGasCloud
     , aFlameParticle
     , makeFlameletTimed
-    , makeTeslaArcAt
-    , colSpark
-    , colSpark'
     ) where
 import Dodge.Data
 import Dodge.Data.DamageType
 import Dodge.Data.SoundOrigin
 import Dodge.Creature.State.Data
+--import Dodge.WorldEvent.Damage
 import Dodge.Base
-import Dodge.Zone
-import Dodge.Base.Collide
-import Dodge.Picture
---import Dodge.Picture.Layer
 import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.Flash
-import Dodge.Particle.Bullet.Draw
-import Dodge.Particle.Bullet.Update
 import Dodge.SoundLogic
 import Dodge.SoundLogic.LoadSound
 import Dodge.RandomHelp
@@ -37,9 +29,6 @@ import qualified IntMapHelp as IM
 import Control.Lens
 import System.Random
 import Control.Monad.State
-import Data.Function (on)
-import Data.List
-import Data.Maybe
 import Data.Tuple
 aFlameParticle 
     :: Int      -- ^ Timer
@@ -252,136 +241,3 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC
     damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w
     f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
     doDam cr = cr & crState . crDamage %~ (PoisonDam 1 :)
-makeTeslaArcAt :: Color -> Point2 -> Float -> Particle
-makeTeslaArcAt col pos dir = LinearParticle
-    { _ptPoints = [pos]
-    , _ptDraw = drawTeslaArc
-    , _ptUpdate = moveTeslaArc pos dir
-    , _ptTimer = 2
-    , _ptColor = brightX 100 1.5 col
-    }
-drawTeslaArc :: Particle -> Picture
-drawTeslaArc pt = setLayer 1 $ pictures 
-    [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ lineOfThickness  3 ps
-    , setDepth 20   $ color (V4 0 0 0 0.5)              $ lineOfThickness 10 ps
-    ]
-  where
-    ps = _ptPoints pt
--- todo: fix electrical damage location
-moveTeslaArc 
-    :: Point2   -- ^ Emmission position
-    -> Float    -- ^ Emmission direction
-    -> World 
-    -> Particle
-    -> (World, Maybe Particle)
-moveTeslaArc p d w pt
-    | t == 2 = 
-        (foldr damCrs w hitCrs & randGen .~ g
-            & colSpark 8 nc q2 (argV sv)
-        , Just $ pt 
-            & ptTimer -~ 1
-            & ptPoints .~ ps'
-        )
-    | t < 1 = (w , Nothing)
-    | otherwise = (w , Just $ pt & ptTimer -~ 1)
- where 
-    t = _ptTimer pt
-    ps = take 25 $ p : map f (crsLightChain p d 0 w)
-    f (E3x1 cr) = _crPos cr
-    f (E3x2 p1) = p1
-    f (E3x3 p1) = p1
-    ps' = lightningMids d pers ps
-    pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
-    nc = brightX 100 1.5 $ numColor colid
-    (colid,g) = randomR (0::Int,5) $ _randGen w
-    f1 (E3x1 cr) = Just $ _crID cr
-    f1 _         = Nothing
-    hitCrs       = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
-    damCrs cid = over (creatures . ix cid . crState . crDamage) (Electrical 5 cpos cpos cpos :)
-      where 
-        cpos = _crPos (_creatures w IM.! cid)
-    q1 = last $ init ps'
-    q2 = last ps'
-    hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
-    sv = maybe (q2 -.- q1) snd hitWall
-{- Finds a point somewhere roughly inbetween two points.  -}
-lightningMid :: Float -> Point2 -> Point2 -> Point2
-lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
-    where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
-{- Finds extra middle points between successive points in a list of points.  -}
-lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
-lightningMids d1 (p:pers) (p1:p3:ps)
-    = let p2 = p +.+ lightningMid d1 p1 p3
-          d2 = argV $ p3 -.- p2
-      in  p1 : p2 : lightningMids d2 pers (p3:ps)
-lightningMids _ _ ps = ps
-{- Finds a list of hit things from a given point.
-'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space.  -}
-crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
-crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of
-    E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) 
-                                       (min 1 (wlAttract + 0.3)) w
-    E3x2 p1 -> [E3x2 p1]
-    E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
-  where 
-    (dChange, g) = randomR (-0.5,0.5) $ _randGen w
-{-
-Finds whether a creature or wall is in front of a given point and direction.
-Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
-Has a parameter to tweak how attracted the test is to walls.
- -}
-crOrWallSensitive 
-    :: Point2   -- ^ Start point
-    -> Float    -- ^ Direction (radians)
-    -> Float    -- ^ Wall attraction parameter
-    -> World 
-    -> Either3 Creature Point2 Point2
-crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
-    . listToMaybe 
-    . sortBy (compare `on` g)
-    $ catMaybes [cr,wlp]
-  where 
-    cr  = E3x1 <$> nearestCrInFront p dir 100 w
-    wlp = fmap E3x2 
-        . listToMaybe
-        . sortBy (compare `on` dist p)
-        $ mapMaybe 
-            ( fmap fst
-            . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w)
-            . (+.+) p
-            . (\d -> rotateV d (V2 100 0))
-            . (+ dir)
-            . (* wlAttract)
-            )
-            [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
-    g (E3x2 p1)  = 100 + dist p p1 -- tweak makes it more likely to hit crs first
-    --g (E3x2 p1)  = dist p p1 - 100 -- tweak makes it more likely to hit walls first
-    g (E3x1 cr1) = dist p $ _crPos cr1
-    g _ = 0
-    (arcLen,_) = randomR (25,50) $ _randGen w
--- BUG: can hit crs through walls
-
-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 :) . )
-    & randGen .~ g
-  where 
-    (a,g)  = randomR (-randDir,randDir) $ _randGen w
-    dir = a + baseDir
-    spark = BulletPt
-        { _ptDraw = drawBul
-        , _ptUpdate = mvGenBullet
-        , _btVel' = rotateV dir (V2 5 0)
-        , _btColor' = col
-        , _btTrail' = [pos]
-        , _btPassThrough' = Nothing
-        , _btWidth' = 1
-        , _btTimer' = time
-        , _btHitEffect' = destroyOnImpact sparkEff noEff
-        }
-    sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
-      where 
-        sp = head (_btTrail' bt)
-        ep = sp +.+ _btVel' bt

src/Dodge/WorldEvent/ThingsHit.hs

@@ -3,6 +3,7 @@ Find which objects lie upon a line.
  -}
 module Dodge.WorldEvent.ThingsHit
     ( thingsHit
+    , thingHit
     , thingsHitLongLine
     , thingsHitExceptCr
     , thingsHitExceptCrLongLine
@@ -40,6 +41,8 @@ thingsHit sp ep w
         _        -> IM.empty
     wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
     hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
+thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
+thingHit sp ep = listToMaybe . thingsHit sp ep
 {- List objects that appear on a line.
 Can filter out a creature.  -}
 thingsHitExceptCr