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

Commit before apply different damage amounts to different materials

Browse Source
This commit is contained in:
justin
2025-10-24 09:28:09 +01:00
parent 8f17582889
commit b2265297b5
6 changed files with 71 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
+16 -19
View File
@@ -1,39 +1,36 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module Dodge.Block ( module Dodge.Block (destroyBlock) where
splinterBlock,
destroyBlock,
) where
import qualified Data.Set as S import qualified Data.Set as S
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
import Data.Foldable import Data.Foldable
import qualified Data.IntSet as IS --import qualified Data.IntSet as IS
import Data.Maybe import Data.Maybe
import Dodge.Base.Collide import Dodge.Base.Collide
import Dodge.Block.Debris import Dodge.Block.Debris
import Dodge.Data.World import Dodge.Data.World
import Dodge.Material.Sound --import Dodge.Material.Sound
import Dodge.Path import Dodge.Path
import Dodge.Wall.Delete import Dodge.Wall.Delete
import Dodge.Wall.Zone import Dodge.Wall.Zone
import Dodge.WorldEvent.Sound --import Dodge.WorldEvent.Sound
import Dodge.Zoning.Wall import Dodge.Zoning.Wall
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
splinterBlock :: Block -> World -> World --splinterBlock :: Block -> World -> World
splinterBlock bl w = --splinterBlock bl w =
foldl' unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl) -- foldl' unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
& soundOriginsIDsAt -- & soundOriginsIDsAt
[MaterialSound bm 0, MaterialSound bm 1, MaterialSound bm 2] -- [MaterialSound bm 0, MaterialSound bm 1, MaterialSound bm 2]
(weakenMatS bm) -- (weakenMatS bm)
(_blPos bl) -- (_blPos bl)
where -- where
bm = fromMaybe Stone $ do -- bm = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs -- wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
(wlid, _) <- IS.minView wlids -- (wlid, _) <- IS.minView wlids
w ^? cWorld . lWorld . walls . ix wlid . wlMaterial -- w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
unshadowBlock :: World -> Int -> World unshadowBlock :: World -> Int -> World
unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of
src/Dodge/Data/Block.hs
+2 -2
View File
@@ -21,13 +21,13 @@ data Block = Block
{ _blID :: Int { _blID :: Int
, _blWallIDs :: IS.IntSet , _blWallIDs :: IS.IntSet
, _blHP :: Int , _blHP :: Int
, _blShadows :: [Int] -- a list of blocks/walls? that are not shown when this block exists , _blShadows :: [Int] -- a list of walls that are not shown when this block exists
, _blFootprint :: [Point2] -- TODO check whether this should be clockwise/anticlockwise , _blFootprint :: [Point2] -- TODO check whether this should be clockwise/anticlockwise
, _blPos :: Point2 , _blPos :: Point2
, _blDir :: Float , _blDir :: Float
, _blHeight :: Float , _blHeight :: Float
, _blMaterial :: Material , _blMaterial :: Material
, _blDraw :: BlockDraw --Block -> SPic , _blDraw :: BlockDraw
, _blObstructs :: [(Int,Int)] , _blObstructs :: [(Int,Int)]
} }
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Item/Weapon/Shatter.hs
+34 -32
View File
@@ -1,38 +1,40 @@
module Dodge.Item.Weapon.Shatter (shootShatter) where module Dodge.Item.Weapon.Shatter (shootShatter) where
import Linear --import Linear
import Dodge.Base.Collide --import Dodge.Base.Collide
import Dodge.Block.Debris --import Dodge.Block.Debris
import Dodge.Data.World import Dodge.Data.World
import Dodge.Wall.Damage --import Dodge.Wall.Damage
import Geometry --import Geometry
import LensHelp --import LensHelp
shootShatter :: Item -> Creature -> World -> World shootShatter :: Item -> Creature -> World -> World
shootShatter _ cr w = shootShatter _ _ w = w
maybe w (uncurry $ shatterWall w sp ep) $ --shootShatter _ cr w =
sequence $ -- maybe w (uncurry $ shatterWall w sp ep) $
collidePointWallsFilter canshatter sp ep w -- sequence $
where -- collidePointWallsFilter canshatter sp ep w
canshatter wl = case _wlOpacity wl of -- where
Opaque {} -> True -- canshatter wl = case _wlOpacity wl of
SeeThrough -> True -- Opaque {} -> True
_ -> False -- SeeThrough -> True
sp = cr ^. crPos ._xy +.+ 10 *.* unitVectorAtAngle dir -- _ -> False
-- the 10 is arbtrary and should be changed to a muzzle position -- sp = cr ^. crPos ._xy +.+ 10 *.* unitVectorAtAngle dir
dir = _crDir cr -- -- the 10 is arbtrary and should be changed to a muzzle position
ep = sp +.+ 200 *.* unitVectorAtAngle dir -- dir = _crDir cr
-- ep = sp +.+ 200 *.* unitVectorAtAngle dir
shatterWall :: World -> Point2 -> Point2 -> Point2 -> Wall -> World --
shatterWall w sp ep p wl = --shatterWall :: World -> Point2 -> Point2 -> Point2 -> Wall -> World
w ----shatterWall w sp ep p wl =
-- & makeDebris (_wlMaterial wl) (_wlColor wl) p --shatterWall w sp ep p wl =
& makeDebris (_wlMaterial wl) p -- w
& makeDebrisDirected ---- & makeDebris (_wlMaterial wl) (_wlColor wl) p
(pi / 2) -- & makeDebris (_wlMaterial wl) p
(argV $ vNormal $ uncurry (-) $ _wlLine wl) -- & makeDebrisDirected
(_wlMaterial wl) -- (pi / 2)
-- (_wlColor wl) -- (argV $ vNormal $ uncurry (-) $ _wlLine wl)
p -- (_wlMaterial wl)
& damageWall (Shattering 1000 p (ep - sp)) wl ---- (_wlColor wl)
-- p
---- & damageWall (Shattering 1000 p (ep - sp)) wl
src/Dodge/Placement/PlaceSpot.hs
+17 -44
View File
@@ -6,15 +6,15 @@
-} -}
module Dodge.Placement.PlaceSpot (placeSpot) where module Dodge.Placement.PlaceSpot (placeSpot) where
import Dodge.Default.Wall
import qualified Data.Set as S
import Control.Monad.State import Control.Monad.State
import Data.Bifunctor import Data.Bifunctor
import Data.Foldable import Data.Foldable
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
import Data.Maybe import Data.Maybe
import qualified Data.Set as S
import Dodge.Base.NewID import Dodge.Base.NewID
import Dodge.Data.GenWorld import Dodge.Data.GenWorld
import Dodge.Default.Wall
import Dodge.Path import Dodge.Path
import Dodge.Placement.PlaceSpot.Block import Dodge.Placement.PlaceSpot.Block
import Dodge.Placement.PlaceSpot.TriggerDoor import Dodge.Placement.PlaceSpot.TriggerDoor
@@ -165,7 +165,7 @@ placeChasm gw rid ps shiftps =
& gwWorld %~ f & gwWorld %~ f
where where
f w = foldl' g w (loopPairs shiftps) f w = foldl' g w (loopPairs shiftps)
g w (x,y) = fst $ obstructPathsCrossing (S.singleton ChasmObstacle) x y w g w (x, y) = fst $ obstructPathsCrossing (S.singleton ChasmObstacle) x y w
--evaluateRandPS --evaluateRandPS
-- :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld) -- :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
@@ -211,51 +211,24 @@ plMachine ::
Float -> Float ->
GenWorld -> GenWorld ->
(Int, GenWorld) (Int, GenWorld)
plMachine wallpoly mc = \case plMachine wallpoly mc mitm p rot gw =
Nothing -> plMachine' wallpoly mc
Just itm -> plTurret wallpoly mc itm
plTurret ::
[Point2] ->
Machine ->
-- Wall ->
Item ->
Point2 ->
Float ->
GenWorld ->
(Int, GenWorld)
plTurret wallpoly mc itm p rot gw =
( mcid ( mcid
, gw & gwWorld . cWorld . lWorld . machines %~ addMc , gw & tolw . machines . at mcid ?~ themc
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wallpoly mcid wlid & tolw . walls %~ placeMachineWalls wallpoly mcid wlid
& gwWorld . cWorld . lWorld . items . at itid ?~ itm' & tolw %~ maybe id placeturretitm mitm
) )
where where
itm' = tolw = gwWorld . cWorld . lWorld
itm & itID .~ NInt itid mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
& itLocation .~ OnTurret mcid wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList $ take (length wallpoly) [wlid ..]
themc = mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
placeturretitm itm =
(items . at itid ?~ itm')
. (machines . ix mcid . mcType . mctTurret . tuWeapon .~ itid)
where
itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines itm' = itm & itID .~ NInt itid & itLocation .~ OnTurret mcid
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
addMc =
IM.insert
mcid
( mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
& mcType . mctTurret . tuWeapon .~ itid
)
plMachine' :: [Point2] -> Machine -> Point2 -> Float -> GenWorld -> (Int, GenWorld)
plMachine' wallpoly mc p rot gw =
( mcid
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wallpoly mcid wlid
)
where
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids})
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing) -- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls :: [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall placeMachineWalls :: [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
src/Dodge/Update.hs
+1 -3
View File
@@ -250,7 +250,6 @@ functionalUpdate =
. over uvWorld updateCreatureSoundPositions . over uvWorld updateCreatureSoundPositions
. colCrsWalls . colCrsWalls
. over uvWorld simpleCrSprings . over uvWorld simpleCrSprings
-- . over uvWorld (updateIMl' (_doors . _lWorld . _cWorld) updateDoor)
. over uvWorld updateDoors . over uvWorld updateDoors
. over uvWorld doWorldEvents . over uvWorld doWorldEvents
. over uvWorld updateDelayedEvents . over uvWorld updateDelayedEvents
@@ -290,8 +289,7 @@ functionalUpdate =
-- creatures should be updated early so that crOldPos is set before any position change -- creatures should be updated early so that crOldPos is set before any position change
. over (uvWorld . cWorld . lWorld . creatures) (fmap setOldPos) . over (uvWorld . cWorld . lWorld . creatures) (fmap setOldPos)
. over uvWorld updateCreatureGroups . over uvWorld updateCreatureGroups
. over uvWorld updateWallDamages . over uvWorld updateWallDamages -- can potentially be combined in some way with update doors so that only one pathing update needs to be done...
-- . over uvWorld updateSeenWalls
. over uvWorld checkTermDist . over uvWorld checkTermDist
. over uvWorld updateRBList . over uvWorld updateRBList
. over uvWorld updateCloseObjects . over uvWorld updateCloseObjects
src/Dodge/Wall/Damage.hs
+1 -4
View File
@@ -1,10 +1,7 @@
{- | Controls a walls response to external damage. {- | Controls a walls response to external damage.
- Indestructible walls may still produce sparks, dust etc - Indestructible walls may still produce sparks, dust etc
-} -}
module Dodge.Wall.Damage ( module Dodge.Wall.Damage (damageWall) where
-- damageBlocksBy,
damageWall,
) where
import Dodge.Material.Damage import Dodge.Material.Damage
import Dodge.Block import Dodge.Block