From 9e311cccf4a50b43f2b96b8d33547ce8df143320 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 19 Jun 2022 16:42:41 +0100 Subject: [PATCH] Fix glass debris bug --- src/Dodge/Block.hs | 2 +- src/Dodge/Block/Debris.hs | 12 +++- src/Dodge/Room/Room.hs | 9 +-- src/Dodge/Wall/DamageEffect.hs | 103 ++++++++++++++++++++------------- 4 files changed, 76 insertions(+), 50 deletions(-) diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index 06986caed..b82b6d8ac 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -52,10 +52,10 @@ checkBlockHP bl destroyBlock :: Block -> World -> World destroyBlock bl w = w & flip (foldr unshadowBlock) (_blShadows bl) + & _blDeath bl bl & deleteWallIDs wlids & blocks %~ IM.delete (_blID bl) -- & matDesSound (_blMaterial bl) pos - & _blDeath bl bl & flip (foldr (wlDustAt awl)) (map (pos +.+) ps) where wlids = _blWallIDs bl diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index 5665025ee..892a2cefb 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -79,7 +79,7 @@ glassDebris = PropZ {_prPos = 0 ,_pjStartPos = 0 ,_pjVel = 0 - ,_prDraw = \pr -> drawMovingShape pr (debrisShape 2 pr) + ,_prDraw = \pr -> drawMovingShape pr (shardShape 4 pr) ,_pjID = 0 ,_pjUpdate = fallSmallBounce ,_pjPosZ = 10 @@ -92,8 +92,16 @@ glassDebris = PropZ crystalDebris :: Prop crystalDebris = glassDebris & 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 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 mat = case mat of diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index ff7e3bc08..2d5b81974 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -27,7 +27,7 @@ import Dodge.Placement.Instance --import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Room.Corridor -import Dodge.Room.Tanks +--import Dodge.Room.Tanks import Dodge.Room.Link import Dodge.Room.Door import Dodge.Room.Airlock @@ -40,18 +40,13 @@ import qualified Data.Set as S roomC :: RandomGen g => Float -> Float -> State g Room roomC w h = do 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 =<< shuffleLinks (roomRectAutoLinks w h & rmLinks %~ ( setInLinks (\rl -> S.fromList [FromEdge East 0,OnEdge South] `S.isSubsetOf` _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] ) where diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index 9401cd25c..ce8affd2b 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -8,7 +8,6 @@ import Dodge.Block import Geometry import LensHelp -import Data.Bifunctor import Control.Monad.State --import Data.Maybe @@ -17,7 +16,9 @@ defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial w Stone -> stoneWallDamage dm wl Glass -> windowWallDamage 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 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 BLUNT -> a d $ wlDustAt wl outTo SHATTERING -> a d $ muchWlDustAt wl outTo - CRUSHING -> a d $ id - EXPLOSIVE -> a d $ id - CUTTING -> a d $ id - SPARKING -> a 0 $ id - FLAMING -> a 0 $ id - ELECTRICAL -> a 0 $ id - CONCUSSIVE -> a d $ id - TORQUEDAM -> a 0 $ id - PUSHDAM -> a 0 $ id - POISONDAM -> a 0 $ id - ENTERREMENT -> a 0 $ id + CRUSHING -> a d id + EXPLOSIVE -> a d id + CUTTING -> a d id + SPARKING -> a 0 id + FLAMING -> a 0 id + ELECTRICAL -> a 0 id + CONCUSSIVE -> a d 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 @@ -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 BLUNT -> a d $ dosplint . wlDustAt wl outTo SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo - CRUSHING -> a d $ dosplint - EXPLOSIVE -> a d $ dosplint - CUTTING -> a d $ dosplint - SPARKING -> a 0 $ id - FLAMING -> a 0 $ id - ELECTRICAL -> a 0 $ id - CONCUSSIVE -> a 0 $ dosplint - TORQUEDAM -> a 0 $ id - PUSHDAM -> a 0 $ id - POISONDAM -> a 0 $ id - ENTERREMENT -> a 0 $ id + CRUSHING -> a d dosplint + EXPLOSIVE -> a d dosplint + CUTTING -> a d dosplint + SPARKING -> a 0 id + FLAMING -> a 0 id + ELECTRICAL -> a 0 id + CONCUSSIVE -> a 0 dosplint + TORQUEDAM -> a 0 id + PUSHDAM -> a 0 id + POISONDAM -> a 0 id + ENTERREMENT -> a 0 id where mbl = do 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 x f w' = (f w',x) 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 p = _dmAt dm outTo = p +.+ squashNormalizeV (sp -.- p) pSparkCol = V4 5 1 0.5 2 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 dm wl = case _dmType dm of LASERING -> a d $ wlDustAt wl outTo PIERCING -> a d $ wlDustAt wl outTo BLUNT -> a d $ wlDustAt wl outTo SHATTERING -> a d $ muchWlDustAt wl outTo - CRUSHING -> a d $ id - EXPLOSIVE -> a d $ id - CUTTING -> a d $ id - SPARKING -> a 0 $ id - FLAMING -> a 0 $ id - ELECTRICAL -> a 0 $ id - CONCUSSIVE -> a d $ id - TORQUEDAM -> a 0 $ id - PUSHDAM -> a 0 $ id - POISONDAM -> a 0 $ id - ENTERREMENT -> a 0 $ id + CRUSHING -> a d $ wlDustAt wl outTo + EXPLOSIVE -> a d $ muchWlDustAt wl outTo + CUTTING -> a d $ muchWlDustAt wl outTo + SPARKING -> a 0 id + FLAMING -> a 0 id + ELECTRICAL -> a 0 id + CONCUSSIVE -> a d 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