From cede677560a046fa0386d5fe074eead9a3e4a855 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 13 Jul 2022 11:26:13 +0100 Subject: [PATCH] Remove ptCrIgnore --- src/Dodge/Creature/Damage.hs | 2 +- src/Dodge/Creature/Inanimate.hs | 2 +- src/Dodge/Creature/State.hs | 1 - src/Dodge/Data.hs | 16 +++++------- src/Dodge/Item/Display.hs | 8 +++++- src/Dodge/Item/Weapon/AmmoParams.hs | 4 +-- src/Dodge/Item/Weapon/Launcher.hs | 4 +-- src/Dodge/Layout.hs | 1 - src/Dodge/Particle/Bullet/Spawn.hs | 4 +-- src/Dodge/Particle/Bullet/Update.hs | 3 +-- src/Dodge/Particle/Flame.hs | 3 ++- src/Dodge/Particle/Spark.hs | 7 ++---- src/Dodge/Particle/Update.hs | 1 - src/Dodge/Wall/DamageEffect.hs | 2 +- src/Dodge/WorldEvent/Explosion.hs | 4 +-- src/Dodge/WorldEvent/SpawnParticle.hs | 36 +++++++++++---------------- src/Dodge/Zone.hs | 2 +- 17 files changed, 42 insertions(+), 58 deletions(-) diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index c013d3bfa..e9ced9026 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -38,7 +38,7 @@ applyDamageEffect dm de cr w = case de of & creatures . ix (_crID cr) . crDir +~ rot BounceBullet bt | crIsArmouredFrom p cr -> w & instantParticles .:~ bouncer where - bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) + bouncer = (aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt) ) {_ptTimer = _ptTimer bt - 1} pOut = p +.+ 2 *.* newDir diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 6a0b8005b..09c778839 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -71,7 +71,7 @@ updateExpBarrel cr w damages = _csDamage $ _crState cr pierceSparks :: [World -> World] pierceSparks - = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr)) + = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p)) poss as times colids as = randomRs (-0.7,0.7) g colids = randomRs (0,11) g diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 1f54eaf33..7e8fc922d 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -179,7 +179,6 @@ movementSideEff cr w (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi)) 20 (momentum +.+ 1 *.* rotateV randDir (vInverse v)) - Nothing 1 20 _ -> w diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index eaa656732..a26659d95 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -670,21 +670,19 @@ data Particle , _btDrag :: Float , _ptColor :: Color , _ptTrail :: [Point2] - , _ptCrIgnore :: Maybe Int - , _ptWidth :: Float - , _ptTimer :: Int + , _ptWidth :: Float + , _ptTimer :: Int , _ptHitEff :: HitEffect } | PtFlame { _ptUpdate :: World -> Particle -> (World, Maybe Particle) , _ptVel :: Point2 , _ptColor :: Color - , _ptPos :: Point2 - , _ptCrIgnore :: Maybe Int - , _ptWidth :: Float - , _ptTimer :: Int + , _ptPos :: Point2 + , _ptWidth :: Float + , _ptTimer :: Int , _ptHitEff :: HitEffect - , _ptZ :: Float + , _ptZ :: Float , _ptOriginalVel :: Point2 } | PtIncBall @@ -692,7 +690,6 @@ data Particle , _ptVel :: Point2 , _ptColor :: Color , _ptPos :: Point2 - , _ptCrIgnore :: Maybe Int , _ptWidth :: Float , _ptTimer :: Int , _ptHitEff :: HitEffect @@ -704,7 +701,6 @@ data Particle , _ptVel :: Point2 , _ptColor :: Color , _ptPos :: Point2 - , _ptCrIgnore :: Maybe Int , _ptWidth :: Float , _ptTimer :: Int , _ptHitEff :: HitEffect diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index df3d0b570..525678f7a 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -16,13 +16,19 @@ import Data.Sequence itemString :: Item -> String itemString = head . itemDisplay +itemBaseName :: Item -> String +itemBaseName it = case _iyBase $ _itType it of + CRAFT str -> show str + HELD str -> show str + x -> show x + itemDisplayWithNumber :: String -> Item -> [String] itemDisplayWithNumber numberstr it = Prelude.take (itSlotsTaken it) $ (midPadL 15 ' ' thename (' ' : numberstr) ++ theparam) : catMaybes [maybeWarmupStatus it,maybeRateStatus it] ++ moduleStrings it ++ repeat "*" where - thename = show . _iyBase $ _itType it + thename = itemBaseName it theparam = fromMaybe [] . listToMaybe $ mapMaybe ($ it) diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index 84bf4b4dc..d4344f643 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/src/Dodge/Item/Weapon/AmmoParams.hs @@ -40,15 +40,13 @@ useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt vfact thetraj -- extra update Nothing -- color (default) - (Just cid) -- pass through creature sp (rotateV dir (muzvel *.* _amBulVel bultype)) -- vel (_rifling $ _itParams it) -- drag (_amBulEff bultype) (_amBulWth bultype) where - sp = _crPos cr +.+ muzlength *.* unitVectorAtAngle dir - cid = _crID cr + sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir dir = _crDir cr bultype = _laAmmoType $ _itConsumption it muzvel = _muzVel $ _itParams it diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index f0395434c..1c22fe9d4 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -157,7 +157,7 @@ doThrust pj w = w & randGen .~ g & props . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) - & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 + & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) 3 10 & shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))) where accel = _pjAcc pj @@ -302,7 +302,7 @@ moveRemoteShell cid itid pj w ) & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) & smokeGen - & makeFlamelet oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 + & makeFlamelet oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) 3 10 | time > -200 = w | otherwise = doExplosion where diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 4712cc8b7..6a8345498 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -44,7 +44,6 @@ generateLevelFromRoomList gr' w = initWallZoning $ w { _walls = wallsFromRooms rs , _gameRooms = gameRoomsFromRooms (IM.elems rs') , _pathGraph = path --- , _pathGraphP = pairPath } & pnZoning %~ (\zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty) (labNodes path)) diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index 7bcb49388..7ba369f82 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -14,21 +14,19 @@ aBulAt :: Maybe Float -- ^ Start velocity step factor -> (Particle -> Particle) -> Maybe Color - -> Maybe Int -- ^ Pass-through creature id -> Point2 -- ^ Start position -> Point2 -- ^ Velocity -> Float -- ^ Drag -> HitEffect -> Float -- ^ Bullet width -> Particle -aBulAt vfact updatemod mcol maycid pos vel drag hiteff width = BulletPt +aBulAt vfact updatemod mcol pos vel drag hiteff width = BulletPt { _ptUpdate = theupdate , _ptVel = fromMaybe 1 vfact *.* vel , _btDrag = drag , _ptColor = fromMaybe (V4 200 200 200 2) mcol -- , _ptColor = V4 2 2 2 2 , _ptTrail = [pos] - , _ptCrIgnore = maycid , _ptWidth = width , _ptTimer = 100 , _ptHitEff = hiteff diff --git a/src/Dodge/Particle/Bullet/Update.hs b/src/Dodge/Particle/Bullet/Update.hs index 5aa476c9e..e00f6ba87 100644 --- a/src/Dodge/Particle/Bullet/Update.hs +++ b/src/Dodge/Particle/Bullet/Update.hs @@ -16,12 +16,11 @@ mvBullet :: World -> Particle -> (World, Maybe Particle) mvBullet w bt' | t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing) | otherwise = second (fmap dodrag) $ - hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w + hiteff bt (thingsHit p (p +.+ vel) w) w where bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w dodrag = ptVel .*.*~ drag drag = _btDrag bt - mcr = _ptCrIgnore bt (p:_) = _ptTrail bt vel = _ptVel bt hiteff = _ptHitEff bt diff --git a/src/Dodge/Particle/Flame.hs b/src/Dodge/Particle/Flame.hs index 095f9fe6f..09fe190dc 100644 --- a/src/Dodge/Particle/Flame.hs +++ b/src/Dodge/Particle/Flame.hs @@ -7,7 +7,8 @@ import LensHelp import System.Random makeFlame :: Point2 -> Point2 -> World -> World -makeFlame pos vel w = w & instantParticles .:~ aFlameParticle t pos vel Nothing +makeFlame pos vel w = w + & instantParticles .:~ aFlameParticle t pos vel & randGen .~ g where (t,g) = randomR (99,101) (_randGen w) diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs index b234bdacc..40b4b4340 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/src/Dodge/Particle/Spark.hs @@ -18,14 +18,13 @@ 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 +createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World +createBarrelSpark pos dir time colid = instantParticles .:~ BulletPt { _ptUpdate = mvBullet , _ptVel = rotateV dir (V2 5 0) , _btDrag = 0.9 , _ptColor = numColor colid , _ptTrail = [pos] - , _ptCrIgnore = maycid , _ptWidth = 1 , _ptTimer = time , _ptHitEff = expireAndDamage basicSparkDams @@ -55,7 +54,6 @@ randColDirTimeSpark randcol randdir randtime pos w = w , _ptVel = rotateV dir (V2 5 0) , _ptColor = col , _ptTrail = [pos] - , _ptCrIgnore = Nothing , _ptWidth = 1 , _ptTimer = time , _ptHitEff = expireAndDamage basicSparkDams @@ -74,7 +72,6 @@ colSparkRandDir randDir time col pos baseDir w = w , _ptVel = rotateV dir (V2 5 0) , _ptColor = col , _ptTrail = [pos] - , _ptCrIgnore = Nothing , _ptWidth = 1 , _ptTimer = time , _ptHitEff = expireAndDamage basicSparkDams diff --git a/src/Dodge/Particle/Update.hs b/src/Dodge/Particle/Update.hs index b7b89c128..47af2a369 100644 --- a/src/Dodge/Particle/Update.hs +++ b/src/Dodge/Particle/Update.hs @@ -7,7 +7,6 @@ mvPt :: Particle -> Maybe Particle mvPt pt = Just $ pt & ptTrail %~ f & ptTimer -~ 1 - & ptCrIgnore .~ Nothing where f trl = head trl +.+ _ptVel pt : trl diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index d88a74493..2a4778297 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -135,7 +135,7 @@ wallDamageEffect dm wl w = case _dmEffect dm of BounceBullet bt -> w & instantParticles .:~ thebouncer where reflectVel = reflVelWall wl (_ptVel bt) - thebouncer = aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt) + thebouncer = aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt) & ptTimer .~ _ptTimer bt - 1 pOut = p +.+ squashNormalizeV (sp -.- p) p = _dmAt dm diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index c691f23e7..184efa442 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -61,7 +61,7 @@ makeFlameExplosionAt p w & instantParticles .++~ newFlames where newFlames = zipWith makeFlameWithVelAndTime velocities timers - makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing + makeFlameWithVelAndTime vel time = aFlameParticle time p vel velocities = replicateM 15 (randInCirc 1) & evalState $ _randGen w timers = randomRs (80,100) $ _randGen w -- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the @@ -87,7 +87,7 @@ makeExplosionAt p w = w sizes = randomRs (2,9) $ _randGen w --times = randomRs (20,25) $ _randGen w times = randomRs (15,20) $ _randGen w - mF q z v size time = makeFlamelet q z v Nothing size time + mF q z v size time = makeFlamelet q z v size time newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times addFlames w' = foldl' (flip ($)) w' newFs --pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q wls diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 2646877b6..1e4fc6bcb 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -31,42 +31,39 @@ aFlameParticle :: Int -- ^ Timer -> Point2 -- ^ Position -> Point2 -- ^ Velocity - -> Maybe Int -- ^ Creature id -> Particle -aFlameParticle t pos vel maycid = PtFlame - { _ptUpdate = moveFlame vel +aFlameParticle t pos vel = PtFlame + { _ptUpdate = moveFlame , _ptVel = vel , _ptColor = red , _ptPos = pos - , _ptCrIgnore = maycid , _ptWidth = 4 , _ptTimer = t - , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 + , _ptHitEff = expireAndDamage $ simpleDam FLAMING 1 , _ptZ = 20 , _ptOriginalVel = vel } {- TODO: add generalised area damage particles/hiteffects. -} -moveFlame :: Point2 -- ^ Rotation direction - -> World +moveFlame :: World -> Particle -> (World, Maybe Particle) -moveFlame rotd w pt +moveFlame w pt | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) - | otherwise = case runIdentity . S.head_ $ thingsHitExceptCr (_ptCrIgnore pt) sp ep w of + | otherwise = case runIdentity . S.head_ $ thingsHit sp ep w of Just (_,Left _) -> (doSound $ dodamage w , mvPt' 0.7) Just (p,Right wl) -> (doSound $ dodamage w , rfl wl p) _ -> (ptFlicker pt $ doSound $ dodamage w , mvPt' 0.98) where + rotd = _ptOriginalVel pt time = _ptTimer pt doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2) sp@(V2 x y) = _ptPos pt vel = _ptVel pt ep = sp +.+ vel - mvPt' speed = Just $ pt - { _ptTimer = time - 1 - , _ptPos = ep - , _ptCrIgnore = Nothing - , _ptVel = speed *.* vel } + mvPt' drag = Just $ pt + & ptTimer -~ 1 + & ptPos .~ ep + & ptVel %~ (drag *.*) dodamage = damageInArea closeCrs closeWls pt closeWls wl = uncurry segOnCirc (_wlLine wl) ep 5 closeCrs cr = dist ep (_crPos cr) @@ -102,7 +99,6 @@ aStaticBall p = return PtStaticBall , _ptVel = 0 , _ptColor = blue , _ptPos = p - , _ptCrIgnore = Nothing , _ptWidth = 3 , _ptTimer = 20 , _ptHitEff = expireAndDamage $ simpleDam ELECTRICAL 20 @@ -113,22 +109,20 @@ makeFlamelet :: Point2 -- ^ Position -> Float -- ^ z position -> Point2 -- ^ Velocity - -> Maybe Int -- ^ Ignore creature id -> Float -- ^ Size -> Int -- ^ Timer -> World -> World -makeFlamelet (V2 x y) z vel maycid size time w = w +makeFlamelet (V2 x y) z vel size time w = w & randGen .~ g & instantParticles .:~ PtIncBall { _ptUpdate = moveFlamelet , _ptVel = vel , _ptColor = red , _ptPos = V2 x y - , _ptCrIgnore = maycid , _ptWidth = size , _ptTimer = time - , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 + , _ptHitEff = expireAndDamage $ simpleDam FLAMING 1 , _ptZ = z , _ptRot = rot } @@ -218,10 +212,9 @@ incBall p = do , _ptVel = 0 , _ptColor = red , _ptPos = p - , _ptCrIgnore = Nothing , _ptWidth = 3 , _ptTimer = 20 - , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 + , _ptHitEff = expireAndDamage $ simpleDam FLAMING 1 , _ptZ = 20 , _ptRot = rot } @@ -237,5 +230,4 @@ moveFlamelet w pt mvPt' = pt & ptTimer -~ 1 & ptPos .~ _ptPos pt +.+ _ptVel pt - & ptCrIgnore .~ Nothing & ptVel .*.*~ 0.8 diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index 78ffd3fed..f2f23d929 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -92,7 +92,7 @@ nearSeg f p r w = streamFromZone zn $ zoneOfSeg (_znSize zn) p r where zn = f w -wlsNearSeg :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity () +wlsNearSeg :: Point2 -> Point2 -> World -> StreamOf Wall {-# INLINE wlsNearSeg #-} wlsNearSeg = nearSeg _wlZoning