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

Implement wall penetrating bullets

Browse Source
This commit is contained in:
jgk
2021-03-23 12:06:46 +01:00
parent 63a50f0e05
commit 941fef134d
7 changed files with 67 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Weapon.hs
+7 -7
View File
@@ -64,7 +64,7 @@ pistol = Weapon
. withRandomDir 0.1
. withMuzFlare
. withVelWthHiteff (30,0) 2
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
$ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
, _wpSpread = 0.02
, _wpRange = 20
, _itHammer = HammerUp
@@ -130,14 +130,14 @@ autoFireMode = shootWithSound (fromIntegral autoGunSound)
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
$ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
singleFireMode = shootWithSound (fromIntegral autoGunSound)
. withRecoil 40
. torqueAfter 0.03
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
$ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
incMode :: Int -> World -> World
incMode _ w
@@ -373,7 +373,7 @@ mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
where
bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos')
(threeEff' bulHitCr' bulHitWall' bulHitFF') 5
(destroyOnImpact bulHitCr' bulHitWall' bulHitFF') 5
(randPos,randPos') = flip evalState (_randGen w)
$ do a <- randInCirc 10
b <- randInCirc 20
@@ -428,7 +428,7 @@ hvAutoGun = defaultAutoGun
. withThinSmoke
. withMuzFlare
. withVelWthHiteff (80,0) 6
$ threeEff'
$ penWalls
hvBulHitCr' hvBulHitWall' bulHitFF'
ltAutoGun = defaultAutoGun
@@ -567,7 +567,7 @@ longGun = defaultGun
. torqueAfter 0.05
. withMuzFlare
. withVelWthHiteff (60,0) 6
$ threeEff' hvBulHitCr' hvBulHitWall' bulHitFF'
$ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
, _wpSpread = 0.0
, _wpRange = 200
@@ -895,7 +895,7 @@ makeFlame pos vel maycid = over particles' ((:) theFlame)
, _btPassThrough' = maycid
, _btWidth' = 4
, _btTimer' = 100
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
src/Dodge/Item/Weapon/Bullet.hs
+2 -2
View File
@@ -218,10 +218,10 @@ bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World
bulHitFF' _ _ _ = id
bulletEffect' :: HitEffect
bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF'
bulletEffect' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
bulletParticleSideEffect :: Particle' -> HitEffect
bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff
bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff
where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]})
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle'
src/Dodge/LevelGen/Block.hs
+2 -2
View File
@@ -35,7 +35,6 @@ updateBlocks w = (\w' -> seq (_wallsZone w') w') $ flip (foldr removeFromZone) d
killBlock :: Wall -> World -> World
killBlock bl w = f bl .
flip (foldr unshadow)
-- flip (foldr (\i -> set (walls . ix i . blVisible) (True)))
(_blShadows bl)
$ w
where
@@ -50,7 +49,8 @@ killBlock bl w = f bl .
unshadow :: Int -> World -> World
unshadow bid w = case w ^? walls . ix bid of
Just b -> let (x,y) = zoneOfPoint $ pHalf (_wlLine b !! 0) (_wlLine b !! 1)
in w & wallsZone . ix x . ix y . ix bid . blVisible %~ \_ -> True
in w & wallsZone . ix x . ix y . ix bid . blVisible %~ (\_ -> True)
& walls . ix bid . blVisible %~ \_ -> True
Nothing -> w
degradeBlock :: Wall -> World -> World
src/Dodge/LevelGen/WindowBlock.hs
+3 -56
View File
@@ -33,59 +33,6 @@ basePane = Block
evenOddSplit = foldr f ([],[])
where f a (ls,rs) = (rs, a : ls)
putWindowBlock :: Point2 -> Point2 -> World -> World
putWindowBlock a b w = removePathsCrossing a b $ foldr (makeBlockAt bSide) w $ zip ps ns
where d = dist a b
rot = argV (b -.- a)
numPoints = 2 * floor (d / 20)
ns = take (numPoints+1) [0..]
ps = map (\i -> a +.+ i/ (fromIntegral numPoints) *.* (b -.- a))
$ map fromIntegral ns
bSide = d / (fromIntegral numPoints)
makeBlockAt :: Float -> (Point2,Int) -> World -> World
makeBlockAt bSide (p,i) w =
let k = newKey $ _walls w
ds = [(-bSide,-9),(-bSide,9),(bSide,9),(bSide,-9)]
polyAtP p = map ((+.+) p . rotateV rot) ds
ksAtN i = [k+i*4,k+i*4 + 1 ,k+i*4 +2, k+i*4+3]
(k0:k1:k2:k3:_) = ksAtN i
(bl:tl:tr:br:_) = polyAtP p
shadows | i == 0 = ksAtN 1
| i == numPoints - 1 = ksAtN $ numPoints - 2
| otherwise = ksAtN (i-1) ++ ksAtN (i+1)
seen | even i = True
| otherwise = False
isLeftmost | i == 0 = True
| otherwise = False
isRightmost | i == numPoints = True
| otherwise = False
l = baseBlock
{ _wlLine = [bl,tl]
, _wlID = k0
, _blVisible = isLeftmost
}
t = baseBlock
{ _wlLine = [tl,tr]
, _wlID = k1
, _blVisible = seen
}
r = baseBlock
{ _wlLine = [tr,br]
, _wlID = k2
, _blVisible = isRightmost
}
b = baseBlock
{ _wlLine = [br,bl]
, _wlID = k3
, _blVisible = seen
}
baseBlock = basePane
{ _blIDs = ksAtN i
, _blShadows = shadows
}
f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
in over walls f w
putWindowBlock' :: Point2 -> Point2 -> World -> World
putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
where d = dist a b
@@ -108,11 +55,11 @@ putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
| i == numBlocks - 1 = [False,True, True,True]
| otherwise = [False,True,False,True]
shadowsAt i | i == 0 = ksAtI 1
| i == numBlocks - 1 = ksAtI $ numBlocks - 1
| i == numBlocks - 1 = ksAtI $ numBlocks - 2
| otherwise = ksAtI (i-1) ++ ksAtI (i+1)
makeBlockAt :: Point2 -> Int -> [Wall]
makeBlockAt p i = zipWith3 (makePane i) (ksAtI i) (visibilityAt i) (linesAt p)
makePane i k' visStatus ps
makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
makePane i visStatus k' ps
= basePane {_wlID = k'
,_wlLine = ps
,_blIDs = ksAtI i
src/Dodge/WorldEvent.hs
+43 -16
View File
@@ -25,6 +25,7 @@ import Control.Monad.State
import System.Random
import Data.Bifunctor
import Data.Maybe
import Data.Function
import Data.List
@@ -205,7 +206,7 @@ createSpark time colid pos dir maycid w = over worldEvents
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = threeEff' sparkEff noEff noEff
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0)
@@ -228,7 +229,7 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = threeEff' sparkEff noEff noEff
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0)
@@ -243,22 +244,48 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
noEff _ _ _ = id
threeEff' ::
( Particle' -> Point2 -> Creature -> World -> World ) ->
( Particle' -> Point2 -> Wall -> World -> World ) ->
( Particle' -> Point2 -> ForceField -> World -> World ) ->
type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
threeEff' crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> error "threeEff called without hitting anything"
((p,E3x1 cr):_) -> (crEff pt p cr w, updatePt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, updatePt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, updatePt p)
where updatePt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
((p,E3x2 wl):hs) | isJust (wl ^? blHP)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel levelInt maycid size time w
@@ -273,7 +300,7 @@ makeFlameletTimed pos vel levelInt maycid size time w
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
(rot ,g) = randomR (0,3) $ _randGen w
@@ -288,7 +315,7 @@ makeFlamelet pos vel levelInt maycid size w = set randGen g $ over particles' ((
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = 20
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
(rot ,g) = randomR (0.5,1.5) $ _randGen w
moveFlamelet :: Int -> Float -> World -> Particle' -> (World, Maybe Particle')
src/Dodge/WorldEvent/Bullet.hs
+8 -7
View File
@@ -88,13 +88,14 @@ mvGenBullet' w bt
$ set ptPict' (bulLine col wth (p:p:ps))
$ set btTimer' (t-1) bt
)
| otherwise = case thingsHitExceptCr mcr p (p +.+ vel) w of
[] -> (w, Just $ set btPassThrough' Nothing
$ set btTrail' (p +.+ vel :p:ps)
$ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
$ set btTimer' (t-1) bt
)
hits -> hiteff bt hits w
| otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
-- case thingsHitExceptCr mcr p (p +.+ vel) w of
-- [] -> (w, Just $ set btPassThrough' Nothing
-- $ set btTrail' (p +.+ vel :p:ps)
-- $ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
-- $ set btTimer' (t-1) bt
-- )
-- hits -> hiteff bt hits w
where mcr = _btPassThrough' bt
col = _btColor' bt
(p:ps) = _btTrail' bt
src/Picture/Render.hs
+2
View File
@@ -70,7 +70,9 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
renderFoldable pdata $ picToLTree (Just 2) pic
depthMask $= Disabled
renderWalls pdata windowPoints pmat
depthMask $= Enabled
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
endTicks <- SDL.ticks