Fix aiming with no weapon crash

This commit is contained in:
2022-02-08 12:47:58 +00:00
parent 9ead5b3979
commit 0a860e6f68
39 changed files with 317 additions and 244 deletions
+1 -1
View File
@@ -89,7 +89,7 @@ makeExplosionAt p w
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
sizes = randomRs (2,9) $ _randGen w
times = randomRs (20,25) $ _randGen w
mF q z v size time = makeFlameletTimed q z v Nothing size time
mF q z v size time = makeFlamelet q z v Nothing size time
newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
addFlames w' = foldr ($) w' newFs
pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w
+8 -10
View File
@@ -48,13 +48,11 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare
(a:b:c:d:_) = randomRs (2,20) (_randGen w)
flareCircleAt :: Color -> Float -> Point3 -> World -> World
flareCircleAt col alphax tranv = particles .:~ theFlareCircle
where
theFlareCircle = Particle
{ _ptDraw = const . setLayer 1 . translate3 tranv
$ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
, _ptUpdate = ptSimpleTime 1
}
flareCircleAt col alphax tranv = particles .:~ Particle
{ _ptDraw = const . setLayer 1 . translate3 tranv
$ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
, _ptUpdate = ptSimpleTime 1
}
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc (addZ 20 p)
@@ -65,8 +63,8 @@ explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc
flameFlicker :: Particle -> World -> World
flameFlicker pt
| _btTimer' pt `mod` 5 == 0 = tempLightSources .:~ theLight
| _ptTimer pt `mod` 5 == 0 = tempLightSources
.:~ tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10)
| otherwise = id
where
V2 x y = _btPos' pt
theLight = tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10)
V2 x y = _ptPos pt
+6 -6
View File
@@ -28,8 +28,8 @@ destroyOnImpact crEff wlEff pt hitThings w = case hitThings of
mvPt :: Particle -> Maybe Particle
mvPt pt = Just $ pt
& ptTrail %~ f
& btTimer' -~ 1
& btPassThrough' .~ Nothing
& ptTimer -~ 1
& ptCrIgnore .~ Nothing
where
f trl = head trl +.+ _ptVel pt : trl
@@ -37,13 +37,13 @@ destroyAt :: Point2 -> Particle -> Maybe Particle
destroyAt hitp pt = Just $ pt
& ptUpdate .~ killBulletUpdate
& ptTrail .:~ hitp
& btTimer' %~ (min 3 . subtract 1)
& ptTimer %~ (min 3 . subtract 1)
killBulletUpdate :: World -> Particle -> (World,Maybe Particle)
killBulletUpdate w pt
| _btTimer' pt <= 0 = (w,Nothing)
| _ptTimer pt <= 0 = (w,Nothing)
| otherwise = (w
,Just $ pt & btTimer' -~ 1
,Just $ pt & ptTimer -~ 1
& ptTrail %~ (\(x:xs) -> x:x:xs)
)
@@ -65,7 +65,7 @@ doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage .:~
Flaming amount sp p ep
where
sp = _btPos' pt
sp = _ptPos pt
ep = sp +.+ _ptVel pt
noEff :: a -> b -> c -> d -> d
+30 -30
View File
@@ -26,39 +26,39 @@ makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave
{ _ptDraw = drawShockwave
, _ptUpdate = mvShockwave is
, _ptColor = col
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = 10
, _btTimer' = 10
, _ptPos = p
, _ptRad = rad
, _ptDam = dam
, _ptPush = push
, _ptMaxTime = 10
, _ptTimer = 10
}
{- Shockwave picture. -}
drawShockwave :: Particle -> Picture
drawShockwave pt = setDepth 20
. setLayer 1
. uncurryV translate (_btPos' pt)
. uncurryV translate (_ptPos pt)
. color (_ptColor pt)
$ thickCircle rad thickness
where
r = _btRad' pt
r = _ptRad pt
thickness = tFraction**2 * r
rad = r - (3/4) * r * tFraction
tFraction = fromIntegral (_btTimer' pt) / fromIntegral (_btMaxTime' pt)
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
mvShockwave
:: [Int] -- ^ IDs of invulnerable creatures.
-> World -> Particle -> (World, Maybe Particle)
mvShockwave is w pt
| _btTimer' pt <= 0 = ( w , Nothing)
| otherwise = (doDams w , Just $ pt & btTimer' -~ 1)
| _ptTimer pt <= 0 = ( w , Nothing)
| otherwise = (doDams w , Just $ pt & ptTimer -~ 1)
where
r = _btRad' pt
p = _btPos' pt
push = _btPush' pt
dam = _btDam' pt
t = _btTimer' pt
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
r = _ptRad pt
p = _ptPos pt
push = _ptPush pt
dam = _ptDam pt
t = _ptTimer pt
tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt)
rad = r - (3/4) * r * tFraction
doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageWall (Explosive 10000 p)))
hitBlocks
@@ -79,12 +79,12 @@ inverseShockwaveAt p rad dam push = particles .:~ Shockwave
{ _ptDraw = drawInverseShockwave
, _ptUpdate = moveInverseShockwave
, _ptColor = cyan
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = 10
, _btTimer' = 10
, _ptPos = p
, _ptRad = rad
, _ptDam = dam
, _ptPush = push
, _ptMaxTime = 10
, _ptTimer = 10
}
moveInverseShockwave
:: World
@@ -92,11 +92,11 @@ moveInverseShockwave
-> (World, Maybe Particle)
moveInverseShockwave w pt
| t <= 0 = ( w, Nothing)
| otherwise = (dams w, Just $ btTimer' -~ 1 $ pt )
| otherwise = (dams w, Just $ ptTimer -~ 1 $ pt )
where
p = _btPos' pt
r = _btRad' pt
t = _btTimer' pt
p = _ptPos pt
r = _ptRad pt
t = _ptTimer pt
rad = r - 0.1 * r * fromIntegral (10 - t)
dams = over creatures (IM.map damCr) . flip (foldr (damageBlocksBy 1)) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
@@ -110,8 +110,8 @@ drawInverseShockwave pt
= setLayer 1 $ onLayer PtLayer $ uncurryV translate p
$ color cyan $ thickCircle rad thickness
where
p = _btPos' pt
r = _btRad' pt
t = _btTimer' pt
p = _ptPos pt
r = _ptRad pt
t = _ptTimer pt
rad = r - 0.1 * r * fromIntegral (10 - t)
thickness = fromIntegral (10 - t) **2 * rad / 40
+35 -35
View File
@@ -2,7 +2,7 @@
module Dodge.WorldEvent.SpawnParticle
( makeGasCloud
, aFlameParticle
, makeFlameletTimed
, makeFlamelet
) where
import Dodge.Data
import Dodge.Base
@@ -31,11 +31,11 @@ aFlameParticle t pos vel maycid = PtZ
, _ptUpdate = moveFlame vel
, _ptVel = vel
, _ptColor = red
, _btPos' = pos
, _btPassThrough' = maycid
, _btWidth' = 4
, _btTimer' = t
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff
, _ptPos = pos
, _ptCrIgnore = maycid
, _ptWidth = 4
, _ptTimer = t
, _ptHitEff = destroyOnImpact (doFlameDam 1) noEff
, _ptZ = 20
}
drawFlame
@@ -49,7 +49,7 @@ drawFlame rotd pt = pictures
, aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1
]
where
ep = _btPos' pt
ep = _ptPos pt
aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
aPic lay offset depth (V2 scalex scaley) col
= setLayer lay
@@ -61,7 +61,7 @@ drawFlame rotd pt = pictures
$ circleSolid 5
glow = setLayer 1 $ setDepth 0.3 $ uncurryV translate ep
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
time = _btTimer' pt
time = _ptTimer pt
scaleChange
| time < 80 = 3
| otherwise = 3 - (fromIntegral time - 80) * 0.2
@@ -76,20 +76,20 @@ moveFlame
-> (World, Maybe Particle)
moveFlame rotd w pt
| time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
| otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
| otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
((_,Left _):_) -> (doSound damcrs , mvPt 0.7)
(thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p)
_ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98)
where
time = _btTimer' pt
time = _ptTimer pt
doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2)
sp@(V2 x y) = _btPos' pt
sp@(V2 x y) = _ptPos pt
vel = _ptVel pt
ep = sp +.+ vel
mvPt speed = Just $ pt
{ _btTimer' = time - 1
, _btPos' = ep
, _btPassThrough' = Nothing
{ _ptTimer = time - 1
, _ptPos = ep
, _ptCrIgnore = Nothing
, _ptVel = speed *.* vel }
damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w
$ IM.filter closeCrs $ _creatures w
@@ -97,37 +97,37 @@ moveFlame rotd w pt
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
angleCoeff x' = abs $ 1 - abs ( (x' * 2 - pi) / pi )
hiteff = _btHitEffect' pt pt
hiteff = _ptHitEff pt pt
rfl wl p = Just $ pt
{ _btTimer' = time -1
, _btPos' = pOut p
{ _ptTimer = time -1
, _ptPos = pOut p
, _ptVel = reflV wl
}
pOut p = p +.+ squashNormalizeV (sp -.- p)
reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
+.+ (0.2 *.* vel)
makeFlameletTimed
makeFlamelet
:: Point2 -- ^ Position
-> Float -- ^ z position
-> Point2 -- ^ Velocity
-> Maybe Int -- ^ Creature id
-> Maybe Int -- ^ Ignore creature id
-> Float -- ^ Size
-> Int -- ^ Timer
-> World
-> World
makeFlameletTimed (V2 x y) z vel maycid size time w = w
makeFlamelet (V2 x y) z vel maycid size time w = w
& randGen .~ g
& instantParticles .:~ PtZ
{ _ptDraw = drawFlameletZ rot
, _ptUpdate = moveFlamelet
, _ptVel = vel
, _ptColor = red
, _btPos' = V2 x y
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff
, _ptPos = V2 x y
, _ptCrIgnore = maycid
, _ptWidth = size
, _ptTimer = time
, _ptHitEff = destroyOnImpact (doFlameDam 1) noEff
, _ptZ = z
}
where
@@ -144,12 +144,12 @@ drawFlameletZ rot pt = pictures
]
where
z = _ptZ pt
sp = _btPos' pt
sp = _ptPos pt
vel = _ptVel pt
ep = sp +.+ vel
size = _btWidth' pt
size = _ptWidth pt
siz2 = size + 0.2
time = _btTimer' pt
time = _ptTimer pt
piu = setDepth (z + 25)
. uncurryV translate ep
. color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
@@ -182,17 +182,17 @@ drawFlameletZ rot pt = pictures
Applies movement and attaches damage to nearby creatures. -}
moveFlamelet :: World -> Particle -> (World, Maybe Particle)
moveFlamelet w pt
| _btTimer' pt <= 0 = ( w, Nothing)
| _ptTimer pt <= 0 = ( w, Nothing)
| otherwise = (flameFlicker pt damcrs, mvPt)
where
sp = _btPos' pt
sp = _ptPos pt
vel = _ptVel pt
ep = sp +.+ vel
size = _btWidth' pt
mvPt = Just $ pt & btTimer' -~ 1
& btPos' .~ ep
& btPassThrough' .~ Nothing
& ptVel .~ 0.8 *.* vel
size = _ptWidth pt
mvPt = Just $ pt & ptTimer -~ 1
& ptPos .~ ep
& ptCrIgnore .~ Nothing
& ptVel .~ 0.8 *.* vel
damcrs = w & creatures %~ IM.map damifclose
isClose cr = dist ep (_crPos cr) < _crRad cr + size
damifclose cr
+21
View File
@@ -4,6 +4,7 @@ Find which objects lie upon a line.
-}
module Dodge.WorldEvent.ThingsHit
( thingsHit
, wallsHit
, thingHit
, thingsHitLongLine
, thingsHitExceptCr
@@ -59,6 +60,26 @@ thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
crNotCid (_,Left cr) = _crID cr /= cid
crNotCid _ = True
wallsHit
:: Point2 -- ^ Line start point
-> Point2 -- ^ Line end point
-> World
-> [(Point2, Wall)]
wallsHit sp ep w
| sp == ep = []
| otherwise = sortOn (dist sp . fst) wls
where
hitWls = wallsOnLine sp ep
$ IM.unions [f b $ f a $ _znObjects $ _wallsZone w
| a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
-- $ _walls w
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
wls = zip (map (fromJust . hitPoint) hitWls) hitWls
hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
thingsHitExceptCrLongLine
:: Maybe Int
-> Point2