Cleanup tesla arcs

src/Dodge/Data.hs

@@ -46,6 +46,7 @@ import Shape
 
 import GHC.Generics
 import Control.Lens
+import Control.Monad.State
 import System.Random
 import Data.Graph.Inductive
 import qualified Data.Set as S
@@ -640,7 +641,16 @@ data ItemParams
         , _currentWalkAngle :: Float
         , _walkSpeed :: Float
         }
-    | Arcing { _currentArc :: Maybe [(Point2,Float,Maybe (Either Creature Wall))] }
+    | Arcing 
+        { _currentArc :: Maybe [(Point2,Float,Maybe (Either Creature Wall))] 
+        , _arcSize :: Float
+        , _arcNumber :: Int
+        , _newArcStep :: ItemParams -> World 
+            -> (Point2,Float,Maybe (Either Creature Wall))
+            -> State StdGen (Maybe (Point2,Float,Maybe (Either Creature Wall)))
+        , _previousArcEffect :: PreviousArcEffect
+        }
+data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
 data Modification
     = ModIDTimerPoint3Bool
         { _mdID     :: Int
@@ -808,6 +818,7 @@ data Wall = Wall
     , _wlRotateTo   :: Bool
     , _wlStructure  :: WallStructure
     , _wlHeight     :: Float
+    , _wlDamageEff  :: Damage -> Wall -> World -> World
     }
 data Opacity
     = SeeThrough

src/Dodge/Default/Wall.hs

@@ -1,6 +1,7 @@
 module Dodge.Default.Wall
     where
 import Dodge.Data
+import Dodge.Wall.DamageEffect
 import Picture
 import Geometry.Data
 {- Indestructible wall.  -}
@@ -20,6 +21,7 @@ defaultWall = Wall
     , _wlStructure = StandaloneWall
     , _wlWalkable = False
     , _wlHeight = 100
+    , _wlDamageEff = defaultWallDamage
     }
 {- Indestructible see-through wall.  -}
 defaultCrystalWall :: Wall

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -39,6 +39,7 @@ sparkGun :: Item
 sparkGun = teslaGun
     & itName .~ "SPARKGUN"
     & itType .~ SPARKGUN
+    & itParams . arcSize .~ 10
 teslaGun :: Item
 teslaGun = defaultGun 
     { _itName = "TESLA"
@@ -65,7 +66,13 @@ teslaGun = defaultGun
             }
         , _dimSPic = teslaGunPic
         }
-    , _itParams = Arcing {_currentArc = Nothing}
+    , _itParams = Arcing 
+        { _currentArc = Nothing
+        , _arcSize = 20
+        , _arcNumber = 10
+        , _newArcStep = defaultArcStep
+        , _previousArcEffect = NoPreviousArcEffect
+        }
     }
 teslaGunPic :: Item -> SPic
 teslaGunPic _ = noPic $ colorSH blue $
@@ -196,59 +203,56 @@ tractorGunPic it =
 -- | assumes that the item is held
 shootTeslaArc :: Item -> Creature -> World -> World
 shootTeslaArc it cr w = w & randGen .~ g
-    & particles .:~ aTeslaArcAt' col newarc
+    & particles .:~ aTeslaArcAt col newarc
     & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itParams . currentArc ?~ newarc
   where 
     pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
     dir = _crDir cr
     (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
-    newarc = createArc (_currentArc (_itParams it)) w pos dir & evalState $ _randGen w
+    newarc = createArc (_itParams it) w pos dir & evalState $ _randGen w
 
-createArc :: RandomGen g
+createArc :: ItemParams
-    => Maybe [(Point2,Float,Maybe (Either Creature Wall))]
     -> World
     -> Point2
     -> Float
-    -> State g [(Point2,Float,Maybe (Either Creature Wall))]
+    -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
-createArc Nothing w p dir = createNewArc w p dir
+createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
-createArc (Just thearc) w p dir = updateArc thearc w p dir
+createArc arcparams w p dir = updateArc arcparams w p dir
 
-createNewArc :: RandomGen g => World -> Point2 -> Float
+createNewArc :: ItemParams -> World -> Point2 -> Float
-    -> State g [(Point2,Float,Maybe (Either Creature Wall))]
+    -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
-createNewArc w p dir = take 10
+createNewArc arcparams w p dir = take (_arcNumber arcparams)
-    <$> unfoldrMID (newArcStep w) (p,dir,Nothing)
+    <$> unfoldrMID (_newArcStep arcparams arcparams w) (p,dir,Nothing)
 
-newArcStep :: RandomGen g => World -> (Point2,Float,Maybe (Either Creature Wall))
+defaultArcStep :: RandomGen g => ItemParams -> World -> (Point2,Float,Maybe (Either Creature Wall))
     -> State g (Maybe (Point2,Float,Maybe (Either Creature Wall)))
-newArcStep _ (_,_,Just _) = return Nothing
+defaultArcStep _     _ (_,_,Just _) = return Nothing
-newArcStep w (p,dir,_) = do
+defaultArcStep itparams w (p,dir,_) = do
+    let csize = _arcSize itparams
     rot <- takeOne [pi/4,negate pi/4]
-    let csize = 10
+    let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
-        center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
     newp <- (center +.+) <$> randInCirc csize
     let mcr = listToMaybe 
-            . sortOn (dist p . _crPos) 
+            . sortOn (dist center . _crPos) 
-            . filter (\cr -> dist p (_crPos cr) < csize)
+            . filter (\cr -> dist center (_crPos cr) < csize)
             . IM.elems
             $ _creatures w
         wlsnearpoint = wallsNearPoint p w
         mwl = listToMaybe
             . sortOn (dist p . fst)
-            . mapMaybe (\ q -> collidePointWallsWall p q wlsnearpoint)
+            . mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint)
-            . map (center +.+)
             $ polyCirc 6 csize
         f (q,wl) = (q,dir,Just $ Right wl)
-        g (cr)   = (_crPos cr +.+ 10 *.* unitVectorAtAngle dir, dir,Just $ Left cr)
+        g cr   = (_crPos cr +.+ csize *.* unitVectorAtAngle dir, dir,Just $ Left cr)
     return . listToMaybe . sortOn (dist p . (^. _1)) 
         $ (newp,dir,Nothing) : catMaybes [fmap f mwl,fmap g mcr]
 
-updateArc :: RandomGen g 
+updateArc :: ItemParams
-    => [(Point2,Float,Maybe (Either Creature Wall))]
     -> World
     -> Point2
     -> Float
-    -> State g [(Point2,Float,Maybe (Either Creature Wall))]
+    -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
-updateArc _ w p dir = createNewArc w p dir
+updateArc = createNewArc
 
 shootLaser :: Item -> Creature -> World -> World
 shootLaser it cr = particles .:~ lasRayAt phasev pos dir

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -109,7 +109,7 @@ bulletDestroySpawn :: (Point2 -> State StdGen Particle)
     -> (World, Maybe Particle)
 bulletDestroySpawn f = destroyOnImpact (bulDestroyCr f) (bulDestroyWall f)
 
-{- | Create a flamelet when hitting a creature.  -}
+{- | Create a particle when hitting a creature.  -}
 bulDestroyCr :: (Point2 -> State StdGen Particle) 
     -> Particle -> Point2 -> Creature -> World -> World
 bulDestroyCr f bt p cr w = w

src/Dodge/Particle/Spark.hs

@@ -2,19 +2,22 @@ module Dodge.Particle.Spark
     ( colSpark
     , colSparkRandDir
     , createBarrelSpark
+    , randColDirTimeSpark
     )
     where
 import Dodge.Data
 import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
-import Dodge.WorldEvent.HitEffect
+import Dodge.Particle.Bullet.DestroyDamage
+--import Dodge.WorldEvent.HitEffect
 import Color
 import Geometry
 import LensHelp
 
+import Control.Monad.State
 import System.Random
 --import Control.Lens
-
+-- TODO remove/simplify this function
 createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> World
 createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt  
     { _ptDraw = drawBul
@@ -26,16 +29,40 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
     , _ptCrIgnore = maycid
     , _ptWidth = 1
     , _ptTimer = time
-    , _ptHitEff = destroyOnImpact sparkEff noEff
+    , _ptHitEff = bulletDestroyDamage SparkDam 1
     }
-  where 
-    sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage 
-        .:~ Damage SparkDam 1 sp p ep NoDamageEffect
-      where
-        sp = head (_ptTrail bt)
-        ep = sp +.+ _ptVel bt
 colSpark :: Int -> Color -> Point2 -> Float -> World -> World
 colSpark = colSparkRandDir 0.7
+
+randColDirTimeSpark 
+    :: State StdGen Color 
+    -> State StdGen Float 
+    -> State StdGen Int 
+    -> Point2
+    -> World
+    -> World
+randColDirTimeSpark randcol randdir randtime pos w = w
+    & instantParticles .:~ spark
+    & randGen .~ g
+  where
+    ((col,dir,time),g) = (`runState` _randGen w) $ do
+        c <- randcol
+        d <- randdir
+        t <- randtime
+        return (c,d,t)
+    spark = BulletPt
+        { _ptDraw   = drawBul
+        , _ptUpdate = mvBullet
+        , _btDrag   = 0.9
+        , _ptVel    = rotateV dir (V2 5 0)
+        , _ptColor  = col
+        , _ptTrail  = [pos]
+        , _ptCrIgnore = Nothing
+        , _ptWidth = 1
+        , _ptTimer = time
+        , _ptHitEff = bulletDestroyDamage SparkDam 1
+        }
+
 colSparkRandDir :: Float -> Int -> Color -> Point2 -> Float -> World -> World
 colSparkRandDir randDir time col pos baseDir w = w 
     & instantParticles .:~ spark
@@ -53,10 +80,5 @@ colSparkRandDir randDir time col pos baseDir w = w
         , _ptCrIgnore = Nothing
         , _ptWidth = 1
         , _ptTimer = time
-        , _ptHitEff = destroyOnImpact sparkEff noEff
+        , _ptHitEff = bulletDestroyDamage SparkDam 1
         }
-    sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage 
-        .:~ Damage SparkDam 1 sp p ep NoDamageEffect
-      where 
-        sp = head (_ptTrail bt)
-        ep = sp +.+ _ptVel bt

src/Dodge/Particle/TeslaArc.hs

@@ -1,45 +1,35 @@
-{-# LANGUAGE TupleSections #-}
 module Dodge.Particle.TeslaArc
     ( aTeslaArcAt
-    , aTeslaArcAt'
     ) where
 import Dodge.Data
 import Dodge.Damage
-import Dodge.WorldEvent.Damage
+--import Dodge.WorldEvent.Damage
-import Dodge.Base
+--import Dodge.Base
-import Dodge.Zone
+--import Dodge.Zone
-import Dodge.Base.Collide
+--import Dodge.Base.Collide
 import Dodge.Particle.Spark
-import Dodge.WorldEvent.ThingsHit
+--import Dodge.WorldEvent.ThingsHit
 import Dodge.RandomHelp
 import Picture
 import Geometry
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 import LensHelp
 
 import System.Random
 import Control.Monad.State
-import Data.Function (on)
+--import Data.Function (on)
-import Data.List
+--import Data.List
-import Data.Maybe
+--import Data.Maybe
 
-aTeslaArcAt' :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle
+aTeslaArcAt :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle
-aTeslaArcAt' col thearc = LinearParticle
+aTeslaArcAt col thearc = LinearParticle
     { _ptPoints = map (^. _1) thearc
     , _ptDraw = drawTeslaArc
-    , _ptUpdate = moveTeslaArc' thearc
+    , _ptUpdate = moveTeslaArc thearc
     , _ptTimer = 2
     , _ptColor = brightX 100 1.5 col
     }
 
-aTeslaArcAt :: Color -> Point2 -> Float -> Particle
-aTeslaArcAt 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) $ thickLine  3 ps
@@ -47,112 +37,26 @@ drawTeslaArc pt = setLayer 1 $ pictures
     ]
   where
     ps = _ptPoints pt
-moveTeslaArc' :: [(Point2,Float,Maybe (Either Creature Wall))]
+moveTeslaArc :: [(Point2,Float,Maybe (Either Creature Wall))]
     -> World
     -> Particle
     -> (World,Maybe Particle)
-moveTeslaArc' thearc w pt
+moveTeslaArc thearc w pt
-    | _ptTimer pt == 2  = (foldr damthings w thearc, Just $ pt & ptTimer -~ 1)
+    | _ptTimer pt == 2  = (makesparks $ foldr damthings w thearc, Just $ pt & ptTimer -~ 1)
     | _ptTimer pt < 1   = (w, Nothing)
     | otherwise         = (w, Just $ pt & ptTimer -~ 1)
   where
+    rcol = brightX 100 1.5 <$> takeOne [white,azure,blue,cyan]
+    rdir = state (randomR (-0.7,0.7)) <&> (+ ld)
+    rtime = state $ randomR (5,8)
+    makeaspark = randColDirTimeSpark rcol rdir rtime lp
+    makesparks = makeaspark . makeaspark . makeaspark
+    (lp,ld) = case last thearc of
+        (lp',ld',Nothing) -> (lp',ld')
+        (lp',ld',Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
+        (lp',ld',Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
     damthings (_,_,Nothing) = id
     damthings (p,dir,Just crwl) = damageCrWall (thedamage p dir) crwl
-    thedamage p dir = Damage Electrical 5 (p -.- q) p (p +.+ q) NoDamageEffect
+    thedamage p dir = Damage Electrical 50 (p -.- q) p (p +.+ q) NoDamageEffect
       where
         q = 5 *.* unitVectorAtAngle dir
--- 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)
-            & damThingHitWith (\p1 p2 p3 -> Damage Electrical 50 p1 p2 p3 NoDamageEffect) 
-                    q1 ((2 *.* q2) -.- q1) thHit
-        , Just $ pt & ptTimer -~ 1 & ptPoints .~ ps'
-        )
-    | t < 1     = (w , Nothing)
-    | otherwise = (w , Just $ pt & ptTimer -~ 1)
- where 
-    t = _ptTimer pt
-    ps = take 5 $ 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 = creatures . ix cid . crState . crDamage 
-        .:~ Damage Electrical 5 cpos cpos cpos NoDamageEffect
-      where 
-        cpos = _crPos (_creatures w IM.! cid)
-    q1 = last $ init ps'
-    q2 = last ps'
-    hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
-    thHit = thingHit q1 ((2 *.* q2) -.- 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,Wall) 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,Wall) 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 . fst)
-        $ mapMaybe 
-            ( (\p1 -> collidePointWallsWall 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

src/Dodge/Wall/Damage.hs

@@ -6,42 +6,14 @@ module Dodge.Wall.Damage
     , damageWall
     ) where
 import Dodge.Data
-import Dodge.Wall.Reflect
-import Dodge.Wall.Dust
-import Dodge.Particle.Spark
-import Geometry
-import Color
 import LensHelp
 
 damageWall :: Damage -> Wall -> World -> World
 damageWall dt wl = case _wlStructure wl of
-    MachinePart mcid -> wallEff dt wl . (machines . ix mcid . mcDamage .:~ dt)
+    MachinePart mcid -> _wlDamageEff wl dt wl . (machines . ix mcid . mcDamage .:~ dt)
-    BlockPart blid   -> wallEff dt wl . (blocks . ix blid %~ damageBlockWith dt)
+    BlockPart blid   -> _wlDamageEff wl dt wl . (blocks . ix blid %~ damageBlockWith dt)
     CreaturePart crid f -> f dt wl crid
-    _   -> wallEff dt wl
+    _   -> _wlDamageEff wl dt wl
-{- | Damage effects on indestructible walls -}
--- TODO take into account damage amount for amount of dust/sparks?
-wallEff :: Damage -> Wall -> World -> World
-wallEff dm wl = case _dmType dm of
-    Lasering -> colSpark 8 lSparkCol outTo (reflDirWall sp p wl)
-    Piercing -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl)
-        . wlDustAt wl outTo
-    Blunt    -> wlDustAt wl outTo
-    Explosive-> id
-    Cutting -> id
-    SparkDam -> id
-    Flaming  -> id
-    Electrical -> id
-    Concussive -> id
-    TorqueDam -> id
-    PushDam -> id
-    PoisonDam -> id
-  where
-    sp = _dmFrom dm
-    p = _dmTo dm
-    outTo = p +.+ squashNormalizeV (sp -.- p)
-    pSparkCol = brightX 100 1.5 white
-    lSparkCol = V4 20 (-5) 0 1
 
 damageBlockWith :: Damage -> Block -> Block
 damageBlockWith dm = case _dmType dm of

src/Geometry/Vector3D.hs

@@ -91,7 +91,7 @@ addZ z (V2 x y) = V3 x y z
 
 v2z :: Point2 -> Float -> Point3
 {-# INLINE v2z #-}
-v2z (V2 x y) z = V3 x y z
+v2z (V2 x y) = V3 x y
 
 stripZ :: Point3 -> Point2
 {-# INLINE stripZ #-}