justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove ptCrIgnore

Browse Source
This commit is contained in:
justin
2022-07-13 11:26:13 +01:00
parent 6c50021f04
commit cede677560
17 changed files with 42 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Damage.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/Inanimate.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/State.hs
-1
View File
@@ -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
src/Dodge/Data.hs
+6 -10
View File
@@ -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
src/Dodge/Item/Display.hs
+7 -1
View File
@@ -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)
src/Dodge/Item/Weapon/AmmoParams.hs
+1 -3
View File
@@ -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
src/Dodge/Item/Weapon/Launcher.hs
+2 -2
View File
@@ -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
src/Dodge/Layout.hs
-1
View File
@@ -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))
src/Dodge/Particle/Bullet/Spawn.hs
+1 -3
View File
@@ -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
src/Dodge/Particle/Bullet/Update.hs
+1 -2
View File
@@ -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
src/Dodge/Particle/Flame.hs
+2 -1
View File
@@ -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)
src/Dodge/Particle/Spark.hs
+2 -5
View File
@@ -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
src/Dodge/Particle/Update.hs
-1
View File
@@ -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
src/Dodge/Wall/DamageEffect.hs
+1 -1
View File
@@ -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
src/Dodge/WorldEvent/Explosion.hs
+2 -2
View File
@@ -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
src/Dodge/WorldEvent/SpawnParticle.hs
+14 -22
View File
@@ -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
src/Dodge/Zone.hs
+1 -1
View File
@@ -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