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:
justin
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 . withRandomDir 0.1
. withMuzFlare . withMuzFlare
. withVelWthHiteff (30,0) 2 . withVelWthHiteff (30,0) 2
$ threeEff' bulHitCr' bulHitWall' bulHitFF' $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
@@ -130,14 +130,14 @@ autoFireMode = shootWithSound (fromIntegral autoGunSound)
. withRandomDir (autogunSpread/2) . withRandomDir (autogunSpread/2)
. withMuzFlare . withMuzFlare
. withVelWthHiteff (50,0) 3 . withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF' $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
singleFireMode = shootWithSound (fromIntegral autoGunSound) singleFireMode = shootWithSound (fromIntegral autoGunSound)
. withRecoil 40 . withRecoil 40
. torqueAfter 0.03 . torqueAfter 0.03
. withRandomDir (autogunSpread/2) . withRandomDir (autogunSpread/2)
. withMuzFlare . withMuzFlare
. withVelWthHiteff (50,0) 3 . withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF' $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
incMode :: Int -> World -> World incMode :: Int -> World -> World
incMode _ w incMode _ w
@@ -373,7 +373,7 @@ mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
where where
bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos') 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) (randPos,randPos') = flip evalState (_randGen w)
$ do a <- randInCirc 10 $ do a <- randInCirc 10
b <- randInCirc 20 b <- randInCirc 20
@@ -428,7 +428,7 @@ hvAutoGun = defaultAutoGun
. withThinSmoke . withThinSmoke
. withMuzFlare . withMuzFlare
. withVelWthHiteff (80,0) 6 . withVelWthHiteff (80,0) 6
$ threeEff' $ penWalls
hvBulHitCr' hvBulHitWall' bulHitFF' hvBulHitCr' hvBulHitWall' bulHitFF'
ltAutoGun = defaultAutoGun ltAutoGun = defaultAutoGun
@@ -567,7 +567,7 @@ longGun = defaultGun
. torqueAfter 0.05 . torqueAfter 0.05
. withMuzFlare . withMuzFlare
. withVelWthHiteff (60,0) 6 . withVelWthHiteff (60,0) 6
$ threeEff' hvBulHitCr' hvBulHitWall' bulHitFF' $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
, _wpSpread = 0.0 , _wpSpread = 0.0
, _wpRange = 200 , _wpRange = 200
@@ -895,7 +895,7 @@ makeFlame pos vel maycid = over particles' ((:) theFlame)
, _btPassThrough' = maycid , _btPassThrough' = maycid
, _btWidth' = 4 , _btWidth' = 4
, _btTimer' = 100 , _btTimer' = 100
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
} }
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle') 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 bulHitFF' _ _ _ = id
bulletEffect' :: HitEffect bulletEffect' :: HitEffect
bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF' bulletEffect' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
bulletParticleSideEffect :: Particle' -> HitEffect bulletParticleSideEffect :: Particle' -> HitEffect
bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff
where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]}) where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]})
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle' 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 :: Wall -> World -> World
killBlock bl w = f bl . killBlock bl w = f bl .
flip (foldr unshadow) flip (foldr unshadow)
-- flip (foldr (\i -> set (walls . ix i . blVisible) (True)))
(_blShadows bl) (_blShadows bl)
$ w $ w
where where
@@ -50,7 +49,8 @@ killBlock bl w = f bl .
unshadow :: Int -> World -> World unshadow :: Int -> World -> World
unshadow bid w = case w ^? walls . ix bid of unshadow bid w = case w ^? walls . ix bid of
Just b -> let (x,y) = zoneOfPoint $ pHalf (_wlLine b !! 0) (_wlLine b !! 1) 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 Nothing -> w
degradeBlock :: Wall -> World -> World degradeBlock :: Wall -> World -> World
src/Dodge/LevelGen/WindowBlock.hs
+3 -56
View File
@@ -33,59 +33,6 @@ basePane = Block
evenOddSplit = foldr f ([],[]) evenOddSplit = foldr f ([],[])
where f a (ls,rs) = (rs, a : ls) 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' :: Point2 -> Point2 -> World -> World
putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
where d = dist a b 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] | i == numBlocks - 1 = [False,True, True,True]
| otherwise = [False,True,False,True] | otherwise = [False,True,False,True]
shadowsAt i | i == 0 = ksAtI 1 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) | otherwise = ksAtI (i-1) ++ ksAtI (i+1)
makeBlockAt :: Point2 -> Int -> [Wall] makeBlockAt :: Point2 -> Int -> [Wall]
makeBlockAt p i = zipWith3 (makePane i) (ksAtI i) (visibilityAt i) (linesAt p) makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
makePane i k' visStatus ps makePane i visStatus k' ps
= basePane {_wlID = k' = basePane {_wlID = k'
,_wlLine = ps ,_wlLine = ps
,_blIDs = ksAtI i ,_blIDs = ksAtI i
src/Dodge/WorldEvent.hs
+43 -16
View File
@@ -25,6 +25,7 @@ import Control.Monad.State
import System.Random import System.Random
import Data.Bifunctor
import Data.Maybe import Data.Maybe
import Data.Function import Data.Function
import Data.List import Data.List
@@ -205,7 +206,7 @@ createSpark time colid pos dir maycid w = over worldEvents
, _btPassThrough' = maycid , _btPassThrough' = maycid
, _btWidth' = 1 , _btWidth' = 1
, _btTimer' = time , _btTimer' = time
, _btHitEffect' = threeEff' sparkEff noEff noEff , _btHitEffect' = destroyOnImpact sparkEff noEff noEff
} }
x = fst $ randomR (0,20) $ _randGen w x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0) pos' = pos +.+ rotateV dir (x,0)
@@ -228,7 +229,7 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
, _btPassThrough' = maycid , _btPassThrough' = maycid
, _btWidth' = 1 , _btWidth' = 1
, _btTimer' = time , _btTimer' = time
, _btHitEffect' = threeEff' sparkEff noEff noEff , _btHitEffect' = destroyOnImpact sparkEff noEff noEff
} }
x = fst $ randomR (0,20) $ _randGen w x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0) pos' = pos +.+ rotateV dir (x,0)
@@ -243,22 +244,48 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
noEff _ _ _ = id noEff _ _ _ = id
threeEff' :: type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
( Particle' -> Point2 -> Creature -> World -> World ) -> type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
( Particle' -> Point2 -> Wall -> World -> World ) -> type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
( Particle' -> Point2 -> ForceField -> World -> World ) ->
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle') Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
threeEff' crEff wlEff ffEff pt hitThings w = case hitThings of destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> error "threeEff called without hitting anything" [] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, updatePt p) ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, updatePt p) ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, updatePt p) ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
where updatePt hitp = Just $ pt & btTrail' .~ (hitp : trl) where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl) & ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3 & btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt trl = _btTrail' pt
col = _btColor' pt col = _btColor' pt
wth = _btWidth' 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 :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel levelInt maycid size time w makeFlameletTimed pos vel levelInt maycid size time w
@@ -273,7 +300,7 @@ makeFlameletTimed pos vel levelInt maycid size time w
, _btPassThrough' = maycid , _btPassThrough' = maycid
, _btWidth' = size , _btWidth' = size
, _btTimer' = time , _btTimer' = time
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
} }
(rot ,g) = randomR (0,3) $ _randGen w (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 , _btPassThrough' = maycid
, _btWidth' = size , _btWidth' = size
, _btTimer' = 20 , _btTimer' = 20
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
} }
(rot ,g) = randomR (0.5,1.5) $ _randGen w (rot ,g) = randomR (0.5,1.5) $ _randGen w
moveFlamelet :: Int -> Float -> World -> Particle' -> (World, Maybe Particle') 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 ptPict' (bulLine col wth (p:p:ps))
$ set btTimer' (t-1) bt $ set btTimer' (t-1) bt
) )
| otherwise = case thingsHitExceptCr mcr p (p +.+ vel) w of | otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
[] -> (w, Just $ set btPassThrough' Nothing -- case thingsHitExceptCr mcr p (p +.+ vel) w of
$ set btTrail' (p +.+ vel :p:ps) -- [] -> (w, Just $ set btPassThrough' Nothing
$ set ptPict' (bulLine col wth (p +.+ vel:p:ps)) -- $ set btTrail' (p +.+ vel :p:ps)
$ set btTimer' (t-1) bt -- $ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
) -- $ set btTimer' (t-1) bt
hits -> hiteff bt hits w -- )
-- hits -> hiteff bt hits w
where mcr = _btPassThrough' bt where mcr = _btPassThrough' bt
col = _btColor' bt col = _btColor' bt
(p:ps) = _btTrail' 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 renderFoldable pdata $ picToLTree (Just 2) pic
depthMask $= Disabled
renderWalls pdata windowPoints pmat renderWalls pdata windowPoints pmat
depthMask $= Enabled
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata) resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
endTicks <- SDL.ticks endTicks <- SDL.ticks