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

Make block damages slightly more logical

Browse Source
This commit is contained in:
justin
2022-06-19 16:11:54 +01:00
parent a7e6d6f3cc
commit 4924aa0a57
9 changed files with 148 additions and 117 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
+5
View File
@@ -44,6 +44,11 @@ matSplintSound mat = case mat of
Wood -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
Metal -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
checkBlockHP :: Block -> World -> World
checkBlockHP bl
| _blHP bl < 1 = destroyBlock bl
| otherwise = id
destroyBlock :: Block -> World -> World
destroyBlock bl w = w
& flip (foldr unshadowBlock) (_blShadows bl)
src/Dodge/Data.hs
+2 -37
View File
@@ -9,6 +9,7 @@ circular imports are probably not a good idea.
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Wall
, module Dodge.Combine.Data
, module Dodge.Distortion.Data
, module Dodge.Data.DamageType
@@ -27,6 +28,7 @@ module Dodge.Data
, module Dodge.Data.Room
) where
import Dodge.Data.Room
import Dodge.Data.Wall
import Dodge.RoomCluster.Data
import Dodge.Data.ItemAmount
import Dodge.ShortShow
@@ -927,8 +929,6 @@ data Block = Block
, _blDraw :: Block -> SPic
, _blDeath :: Block -> World -> World
}
data Material = Wood | Dirt | Stone | Glass | Metal | Crystal
deriving (Eq,Ord,Show,Bounded,Enum)
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving (Eq,Ord,Show)
data TerminalInput = TerminalInput
@@ -1015,38 +1015,6 @@ data Door = Door
}
data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
deriving (Eq, Ord, Show)
data Wall = Wall
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlOpacity :: Opacity
, _wlPathable :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlReflect :: Bool
, _wlDraw :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
, _wlHeight :: Float
-- , _wlDamageEff :: Damage -> Wall -> World -> World
, _wlMaterial :: Material
}
data Opacity
= SeeThrough
| SeeAbove
| DrawnWall {_opDraw :: Wall -> SPic}
| Opaque
data WallStructure
= StandaloneWall
| DoorPart { _wsDoor :: Int }
| MachinePart { _wsMachine :: Int }
| BlockPart { _wsBlock :: Int }
| CreaturePart
{ _wlStCreature :: Int
-- , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World
}
data ActionPlan
= Inanimate
@@ -1509,9 +1477,6 @@ makeLenses ''TweakParam
makeLenses ''Prop
makeLenses ''Modification
makeLenses ''Particle
makeLenses ''Wall
makeLenses ''WallStructure
makeLenses ''Opacity
makeLenses ''PressPlate
makeLenses ''Button
makeLenses ''ActionPlan
src/Dodge/Data/Wall.hs
+41
View File
@@ -3,3 +3,44 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Wall where
import Geometry
import Color
import ShapePicture
import Control.Lens
data Wall = Wall
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlOpacity :: Opacity
, _wlPathable :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlReflect :: Bool
, _wlDraw :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
, _wlHeight :: Float
-- , _wlDamageEff :: Damage -> Wall -> World -> World
, _wlMaterial :: Material
}
data Opacity
= SeeThrough
| SeeAbove
| DrawnWall {_opDraw :: Wall -> SPic}
| Opaque
data WallStructure
= StandaloneWall
| DoorPart { _wsDoor :: Int }
| MachinePart { _wsMachine :: Int }
| BlockPart { _wsBlock :: Int }
| CreaturePart
{ _wlStCreature :: Int
-- , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World
}
data Material = Wood | Dirt | Stone | Glass | Metal | Crystal
deriving (Eq,Ord,Show,Bounded,Enum)
makeLenses ''Wall
makeLenses ''WallStructure
makeLenses ''Opacity
src/Dodge/Default/Wall.hs
-1
View File
@@ -2,7 +2,6 @@ module Dodge.Default.Wall
where
import Dodge.Data
import Dodge.Block.Debris -- this dependency is (directly) for dirtColor
import Dodge.Wall.DamageEffect
import Picture
import Geometry.Data
{- Indestructible wall. -}
src/Dodge/Item/Equipment.hs
+5 -5
View File
@@ -161,11 +161,11 @@ shieldWall crid = defaultWall
}
-- TODO the reflection should be controled by the particle
shieldWallDamage :: Damage -> Wall -> Int -> World -> World
shieldWallDamage dm _ crid w = case _dmType dm of
-- Lasering -> w
_ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
_ -> w
--shieldWallDamage :: Damage -> Wall -> Int -> World -> World
--shieldWallDamage dm _ crid w = case _dmType dm of
---- Lasering -> w
-- _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
-- _ -> w
createShieldWall :: Creature -> Int -> World -> World
createShieldWall cr invid w = case _ieMID $ _itEffect it of
src/Dodge/Update.hs
+2 -10
View File
@@ -6,7 +6,7 @@ module Dodge.Update ( updateUniverse ) where
import Dodge.Data
import Dodge.Menu
import Dodge.CullBox
import Dodge.Block
--import Dodge.Block
import Dodge.Distortion
import Dodge.SoundLogic
import Dodge.Wall.Delete
@@ -82,7 +82,7 @@ functionalUpdate cfig w = checkEndGame
-- creatures should be updated early so that crOldPos is set before any position change
. over creatures (fmap setOldPos)
. updateCreatureGroups
. updateBlocks
-- . updateBlocks
. updateWallDamages
. updateSeenWalls
-- . (youHammerPosition %~ moveHammerUp)
@@ -168,14 +168,6 @@ updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World
updateIMl' fim fup w = foldl' (flip fup) w (fim w)
updateBlocks :: World -> World
updateBlocks w = foldr f w $ _blocks w
where
f bl w' = case _blHP bl of
-- x | x < 1 -> splinterBlock bl w'
x | x < 1 -> destroyBlock bl w'
_ -> w'
-- | Note the explict use of record syntax. Using lens created a space leak.
resetWorldEvents :: World -> World
resetWorldEvents w = w {_worldEvents = id}
src/Dodge/Update/WallDamage.hs
+1 -1
View File
@@ -13,4 +13,4 @@ updateWallDamages w = w
where
f k dams w' = fromMaybe w' $ do
wl <- w' ^? walls . ix k
return $ foldr (flip damageWall wl) w' dams
return $ foldr (`damageWall` wl) w' dams
src/Dodge/Wall/Damage.hs
+12 -24
View File
@@ -6,35 +6,23 @@ module Dodge.Wall.Damage
, damageWall
) where
import Dodge.Data
import Dodge.Block
import LensHelp
import Dodge.Wall.DamageEffect
damageWall :: Damage -> Wall -> World -> World
damageWall dt wl = case _wlStructure wl of
MachinePart mcid -> defaultWallDamage dt wl . (machines . ix mcid . mcDamage .:~ dt)
BlockPart blid -> defaultWallDamage dt wl . (blocks . ix blid %~ damageBlockWith dt)
-- CreaturePart crid f -> f dt wl crid
_ -> defaultWallDamage dt wl
damageWall dt wl w = case _wlStructure wl of
MachinePart mcid -> fst . defaultWallDamage dt wl $ w
& machines . ix mcid . mcDamage .:~ dt
BlockPart blid -> let (w',x) = defaultWallDamage dt wl w
in w' & blocks . ix blid . blHP -~ x & maybeDestroyBlock blid
_ -> fst $ defaultWallDamage dt wl w
damageBlockWith :: Damage -> Block -> Block
damageBlockWith dm = case _dmType dm of
PIERCING -> blHP -~ dam
BLUNT -> blHP -~ dam
CUTTING -> blHP -~ dam
EXPLOSIVE -> blHP -~ dam
CONCUSSIVE -> blHP -~ dam
SHATTERING -> blHP -~ dam
CRUSHING -> blHP -~ (dam `div` 4)
LASERING -> id
SPARKING -> id
FLAMING -> id
ELECTRICAL -> id
TORQUEDAM -> id
PUSHDAM -> id
POISONDAM -> id
ENTERREMENT -> id
where
dam = _dmAmount dm
-- block destruction is convoluted...
maybeDestroyBlock :: Int -> World -> World
maybeDestroyBlock blid w = case w ^? blocks . ix blid of
Just bl | _blHP bl < 1 -> destroyBlock bl w
_ -> w
damageBlocksBy :: Int -> Wall -> World -> World
damageBlocksBy x wl = case wl ^? wlStructure . wsBlock of
src/Dodge/Wall/DamageEffect.hs
+80 -39
View File
@@ -8,62 +8,103 @@ import Dodge.Block
import Geometry
import LensHelp
import Data.Bifunctor
import Control.Monad.State
import Data.Maybe
--import Data.Maybe
defaultWallDamage :: Damage -> Wall -> World -> World
defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> wlDustAt wl outTo
SHATTERING -> muchWlDustAt wl outTo
CRUSHING -> id
EXPLOSIVE -> id
CUTTING -> id
SPARKING -> id
FLAMING -> id
ELECTRICAL -> id
CONCUSSIVE -> id
TORQUEDAM -> id
PUSHDAM -> id
POISONDAM -> id
ENTERREMENT -> id
defaultWallDamage :: Damage -> Wall -> World -> (World,Int)
defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial wl of
Stone -> stoneWallDamage dm wl
Glass -> windowWallDamage dm wl
Dirt -> dirtWallDamage dm wl
_ -> second (const 0) . stoneWallDamage dm wl
stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
stoneWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
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
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
windowWallDamage :: Damage -> Wall -> World -> World
windowWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> dosplint . wlDustAt wl outTo
SHATTERING -> dosplint . muchWlDustAt wl outTo
CRUSHING -> dosplint
EXPLOSIVE -> dosplint
CUTTING -> dosplint
SPARKING -> id
FLAMING -> id
ELECTRICAL -> id
CONCUSSIVE -> dosplint
TORQUEDAM -> id
PUSHDAM -> id
POISONDAM -> id
ENTERREMENT -> id
windowWallDamage :: Damage -> Wall -> World -> (World,Int)
windowWallDamage dm wl w = w & case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
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
where
dosplint w = fromMaybe w $ do
mbl = do
blid <- wl ^? wlStructure . wsBlock
bl <- w ^? blocks . ix blid
return $ splinterBlock bl w
& blocks . ix blid . blHP %~ min 1
w ^? blocks . ix blid
d :: Int
d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
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
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
where
a x f w = (f w,x)
d = _dmAmount dm
sp = _dmFrom dm
p = _dmAt dm
outTo = p +.+ squashNormalizeV (sp -.- p)
wallDamageEffect :: Damage -> Wall -> World -> World
wallDamageEffect dm wl w = case _dmEffect dm of