From 11d954674c871033b4e3dc4577534d60d822a16e Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 24 Mar 2022 08:05:58 +0000 Subject: [PATCH] Cleanup tesla arcs --- src/Dodge/Data.hs | 13 ++- src/Dodge/Default/Wall.hs | 2 + src/Dodge/Item/Weapon/BatteryGuns.hs | 56 +++++----- src/Dodge/Particle/Bullet/HitEffect.hs | 2 +- src/Dodge/Particle/Spark.hs | 52 ++++++--- src/Dodge/Particle/TeslaArc.hs | 146 +++++-------------------- src/Dodge/Wall/Damage.hs | 34 +----- src/Geometry/Vector3D.hs | 2 +- 8 files changed, 111 insertions(+), 196 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 181edf823..f39255568 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs index b323ae0ef..e01032d7b 100644 --- a/src/Dodge/Default/Wall.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 3b6e3409e..690f759c1 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/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 - => Maybe [(Point2,Float,Maybe (Either Creature Wall))] +createArc :: ItemParams -> World -> Point2 -> Float - -> State g [(Point2,Float,Maybe (Either Creature Wall))] -createArc Nothing w p dir = createNewArc w p dir -createArc (Just thearc) w p dir = updateArc thearc w p dir + -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))] +createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir +createArc arcparams w p dir = updateArc arcparams w p dir -createNewArc :: RandomGen g => World -> Point2 -> Float - -> State g [(Point2,Float,Maybe (Either Creature Wall))] -createNewArc w p dir = take 10 - <$> unfoldrMID (newArcStep w) (p,dir,Nothing) +createNewArc :: ItemParams -> World -> Point2 -> Float + -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))] +createNewArc arcparams w p dir = take (_arcNumber arcparams) + <$> 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 -newArcStep w (p,dir,_) = do +defaultArcStep _ _ (_,_,Just _) = return Nothing +defaultArcStep itparams w (p,dir,_) = do + let csize = _arcSize itparams rot <- takeOne [pi/4,negate pi/4] - let csize = 10 - center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p + let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p newp <- (center +.+) <$> randInCirc csize let mcr = listToMaybe - . sortOn (dist p . _crPos) - . filter (\cr -> dist p (_crPos cr) < csize) + . sortOn (dist center . _crPos) + . 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) - . map (center +.+) + . mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint) $ 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 - => [(Point2,Float,Maybe (Either Creature Wall))] +updateArc :: ItemParams -> World -> Point2 -> Float - -> State g [(Point2,Float,Maybe (Either Creature Wall))] -updateArc _ w p dir = createNewArc w p dir + -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))] +updateArc = createNewArc shootLaser :: Item -> Creature -> World -> World shootLaser it cr = particles .:~ lasRayAt phasev pos dir diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 40b3eddbc..36167382b 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/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 diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs index 24d348d63..37945f6c1 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/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 diff --git a/src/Dodge/Particle/TeslaArc.hs b/src/Dodge/Particle/TeslaArc.hs index 0023d1f1e..8b7e6cf90 100644 --- a/src/Dodge/Particle/TeslaArc.hs +++ b/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.Base -import Dodge.Zone -import Dodge.Base.Collide +--import Dodge.WorldEvent.Damage +--import Dodge.Base +--import Dodge.Zone +--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.List -import Data.Maybe +--import Data.Function (on) +--import Data.List +--import Data.Maybe -aTeslaArcAt' :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle -aTeslaArcAt' col thearc = LinearParticle +aTeslaArcAt :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle +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 - | _ptTimer pt == 2 = (foldr damthings w thearc, Just $ pt & ptTimer -~ 1) +moveTeslaArc thearc w pt + | _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 diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 5c0e38ea0..f2965e59c 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/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) - BlockPart blid -> wallEff dt wl . (blocks . ix blid %~ damageBlockWith dt) + MachinePart mcid -> _wlDamageEff wl dt wl . (machines . ix mcid . mcDamage .:~ dt) + BlockPart blid -> _wlDamageEff wl dt wl . (blocks . ix blid %~ damageBlockWith dt) CreaturePart crid f -> f dt wl crid - _ -> wallEff 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 + _ -> _wlDamageEff wl dt wl damageBlockWith :: Damage -> Block -> Block damageBlockWith dm = case _dmType dm of diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs index 60ce2b5fb..4549a6129 100644 --- a/src/Geometry/Vector3D.hs +++ b/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 #-}