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

Fix glass debris bug

Browse Source
This commit is contained in:
justin
2022-06-19 16:42:41 +01:00
parent 4924aa0a57
commit 9e311cccf4
4 changed files with 76 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
+1 -1
View File
@@ -52,10 +52,10 @@ checkBlockHP bl
destroyBlock :: Block -> World -> World destroyBlock :: Block -> World -> World
destroyBlock bl w = w destroyBlock bl w = w
& flip (foldr unshadowBlock) (_blShadows bl) & flip (foldr unshadowBlock) (_blShadows bl)
& _blDeath bl bl
& deleteWallIDs wlids & deleteWallIDs wlids
& blocks %~ IM.delete (_blID bl) & blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos -- & matDesSound (_blMaterial bl) pos
& _blDeath bl bl
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps) & flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
where where
wlids = _blWallIDs bl wlids = _blWallIDs bl
src/Dodge/Block/Debris.hs
+10 -2
View File
@@ -79,7 +79,7 @@ glassDebris = PropZ
{_prPos = 0 {_prPos = 0
,_pjStartPos = 0 ,_pjStartPos = 0
,_pjVel = 0 ,_pjVel = 0
,_prDraw = \pr -> drawMovingShape pr (debrisShape 2 pr) ,_prDraw = \pr -> drawMovingShape pr (shardShape 4 pr)
,_pjID = 0 ,_pjID = 0
,_pjUpdate = fallSmallBounce ,_pjUpdate = fallSmallBounce
,_pjPosZ = 10 ,_pjPosZ = 10
@@ -92,8 +92,16 @@ glassDebris = PropZ
crystalDebris :: Prop crystalDebris :: Prop
crystalDebris = glassDebris crystalDebris = glassDebris
& pjColor .~ withAlpha 0.5 aquamarine & pjColor .~ withAlpha 0.5 aquamarine
shardShape :: Float -> Prop -> Shape
shardShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly size $
[V2 size 0
,V2 (-size) 1
,V2 (-size) (-1)
]
debrisShape :: Float -> Prop -> Shape debrisShape :: Float -> Prop -> Shape
debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly 8 $ square size debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly (2*size) $ square size
matDesSound :: Material -> Point2 -> World -> World matDesSound :: Material -> Point2 -> World -> World
matDesSound mat = case mat of matDesSound mat = case mat of
src/Dodge/Room/Room.hs
+2 -7
View File
@@ -27,7 +27,7 @@ import Dodge.Placement.Instance
--import Dodge.LevelGen.Data --import Dodge.LevelGen.Data
import Dodge.Room.Procedural import Dodge.Room.Procedural
import Dodge.Room.Corridor import Dodge.Room.Corridor
import Dodge.Room.Tanks --import Dodge.Room.Tanks
import Dodge.Room.Link import Dodge.Room.Link
import Dodge.Room.Door import Dodge.Room.Door
import Dodge.Room.Airlock import Dodge.Room.Airlock
@@ -40,18 +40,13 @@ import qualified Data.Set as S
roomC :: RandomGen g => Float -> Float -> State g Room roomC :: RandomGen g => Float -> Float -> State g Room
roomC w h = do roomC w h = do
wallf <- takeOne [ crystalLine , windowLine ] wallf <- takeOne [ crystalLine , windowLine ]
ntanks <- takeOne [0,0,0,0,0,1,1,1,1,2,3,4]
thetank <- randomTank <&> plSpot .~ rprBool (\rp _ ->
_rpPlacementUse rp == 0
&& rpIsOffPath rp
&& (xV2 (_rpPos rp) > w / 2 + 5 || xV2 (_rpPos rp) < w / 2 - 5 ))
maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0] maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
maybeaddgird =<< shuffleLinks (roomRectAutoLinks w h maybeaddgird =<< shuffleLinks (roomRectAutoLinks w h
& rmLinks %~ & rmLinks %~
( setInLinks (\rl -> S.fromList [FromEdge East 0,OnEdge South] `S.isSubsetOf` _rlType rl) ( setInLinks (\rl -> S.fromList [FromEdge East 0,OnEdge South] `S.isSubsetOf` _rlType rl)
. setOutLinks (\rl -> OnEdge West `S.member` _rlType rl) . setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
) )
& rmPmnts .++~ (wallf (V2 (w/2) 0) (V2 (w/2) (h-60)) : replicate ntanks thetank) & rmPmnts .:~ wallf (V2 (w/2) 0) (V2 (w/2) (h-60))
& rmRandPSs .~ [farside] & rmRandPSs .~ [farside]
) )
where where
src/Dodge/Wall/DamageEffect.hs
+63 -40
View File
@@ -8,7 +8,6 @@ import Dodge.Block
import Geometry import Geometry
import LensHelp import LensHelp
import Data.Bifunctor
import Control.Monad.State import Control.Monad.State
--import Data.Maybe --import Data.Maybe
@@ -17,7 +16,9 @@ defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial w
Stone -> stoneWallDamage dm wl Stone -> stoneWallDamage dm wl
Glass -> windowWallDamage dm wl Glass -> windowWallDamage dm wl
Dirt -> dirtWallDamage dm wl Dirt -> dirtWallDamage dm wl
_ -> second (const 0) . stoneWallDamage dm wl Crystal -> crystalWallDamage dm wl
Metal -> stoneWallDamage dm wl
Wood -> stoneWallDamage dm wl
stoneWallDamage :: Damage -> Wall -> World -> (World,Int) stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
stoneWallDamage dm wl = case _dmType dm of stoneWallDamage dm wl = case _dmType dm of
@@ -25,17 +26,17 @@ stoneWallDamage dm wl = case _dmType dm of
PIERCING -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo PIERCING -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ wlDustAt wl outTo BLUNT -> a d $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a d $ id CRUSHING -> a d id
EXPLOSIVE -> a d $ id EXPLOSIVE -> a d id
CUTTING -> a d $ id CUTTING -> a d id
SPARKING -> a 0 $ id SPARKING -> a 0 id
FLAMING -> a 0 $ id FLAMING -> a 0 id
ELECTRICAL -> a 0 $ id ELECTRICAL -> a 0 id
CONCUSSIVE -> a d $ id CONCUSSIVE -> a d id
TORQUEDAM -> a 0 $ id TORQUEDAM -> a 0 id
PUSHDAM -> a 0 $ id PUSHDAM -> a 0 id
POISONDAM -> a 0 $ id POISONDAM -> a 0 id
ENTERREMENT -> a 0 $ id ENTERREMENT -> a 0 id
where where
a x f w = (f w,x) a x f w = (f w,x)
d = _dmAmount dm d = _dmAmount dm
@@ -51,17 +52,17 @@ windowWallDamage dm wl w = w & case _dmType dm of
PIERCING -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo PIERCING -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ dosplint . wlDustAt wl outTo BLUNT -> a d $ dosplint . wlDustAt wl outTo
SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo
CRUSHING -> a d $ dosplint CRUSHING -> a d dosplint
EXPLOSIVE -> a d $ dosplint EXPLOSIVE -> a d dosplint
CUTTING -> a d $ dosplint CUTTING -> a d dosplint
SPARKING -> a 0 $ id SPARKING -> a 0 id
FLAMING -> a 0 $ id FLAMING -> a 0 id
ELECTRICAL -> a 0 $ id ELECTRICAL -> a 0 id
CONCUSSIVE -> a 0 $ dosplint CONCUSSIVE -> a 0 dosplint
TORQUEDAM -> a 0 $ id TORQUEDAM -> a 0 id
PUSHDAM -> a 0 $ id PUSHDAM -> a 0 id
POISONDAM -> a 0 $ id POISONDAM -> a 0 id
ENTERREMENT -> a 0 $ id ENTERREMENT -> a 0 id
where where
mbl = do mbl = do
blid <- wl ^? wlStructure . wsBlock blid <- wl ^? wlStructure . wsBlock
@@ -71,34 +72,56 @@ windowWallDamage dm wl w = w & case _dmType dm of
a :: Int -> (World -> World) -> World -> (World,Int) a :: Int -> (World -> World) -> World -> (World,Int)
a x f w' = (f w',x) a x f w' = (f w',x)
dosplint = maybe id splinterBlock mbl dosplint = maybe id splinterBlock mbl
-- fromMaybe w $ do
-- blid <- wl ^? wlStructure . wsBlock
-- bl <- w ^? blocks . ix blid
-- return $ splinterBlock bl w
-- & blocks . ix blid . blHP %~ min 1
sp = _dmFrom dm sp = _dmFrom dm
p = _dmAt dm p = _dmAt dm
outTo = p +.+ squashNormalizeV (sp -.- p) outTo = p +.+ squashNormalizeV (sp -.- p)
pSparkCol = V4 5 1 0.5 2 pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1 lSparkCol = V4 20 (-5) 0 1
crystalWallDamage :: Damage -> Wall -> World -> (World,Int)
crystalWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a 0 $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a 0 $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a 0 id
EXPLOSIVE -> a 0 id
CUTTING -> a 0 id
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a 0 id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
ENTERREMENT -> a 0 id
where
a x f w = (f w,x)
d = _dmAmount dm
sp = _dmFrom dm
p = _dmAt dm
outTo = p +.+ squashNormalizeV (sp -.- p)
pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1
dirtWallDamage :: Damage -> Wall -> World -> (World,Int) dirtWallDamage :: Damage -> Wall -> World -> (World,Int)
dirtWallDamage dm wl = case _dmType dm of dirtWallDamage dm wl = case _dmType dm of
LASERING -> a d $ wlDustAt wl outTo LASERING -> a d $ wlDustAt wl outTo
PIERCING -> a d $ wlDustAt wl outTo PIERCING -> a d $ wlDustAt wl outTo
BLUNT -> a d $ wlDustAt wl outTo BLUNT -> a d $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a d $ id CRUSHING -> a d $ wlDustAt wl outTo
EXPLOSIVE -> a d $ id EXPLOSIVE -> a d $ muchWlDustAt wl outTo
CUTTING -> a d $ id CUTTING -> a d $ muchWlDustAt wl outTo
SPARKING -> a 0 $ id SPARKING -> a 0 id
FLAMING -> a 0 $ id FLAMING -> a 0 id
ELECTRICAL -> a 0 $ id ELECTRICAL -> a 0 id
CONCUSSIVE -> a d $ id CONCUSSIVE -> a d id
TORQUEDAM -> a 0 $ id TORQUEDAM -> a 0 id
PUSHDAM -> a 0 $ id PUSHDAM -> a 0 id
POISONDAM -> a 0 $ id POISONDAM -> a 0 id
ENTERREMENT -> a 0 $ id ENTERREMENT -> a 0 id
where where
a x f w = (f w,x) a x f w = (f w,x)
d = _dmAmount dm d = _dmAmount dm