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/Placement/PlaceSpot.hs
+17 -44
View File
@@ -6,15 +6,15 @@
-}
module Dodge.Placement.PlaceSpot (placeSpot) where
import Dodge.Default.Wall
import qualified Data.Set as S
import Control.Monad.State
import Data.Bifunctor
import Data.Foldable
import qualified Data.IntSet as IS
import Data.Maybe
import qualified Data.Set as S
import Dodge.Base.NewID
import Dodge.Data.GenWorld
import Dodge.Default.Wall
import Dodge.Path
import Dodge.Placement.PlaceSpot.Block
import Dodge.Placement.PlaceSpot.TriggerDoor
@@ -134,7 +134,7 @@ placeSpotID rid ps pt w = case pt of
PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
PutDoor eo f l p1 p2 -> plDoor eo f l (pashift p1) (pashift p2) w
PutDoor eo f l p1 p2 -> plDoor eo f l (pashift p1) (pashift p2) w
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
PutSlideDr wl dr eo off a b ->
plSlideDoor wl dr eo off (doShift a) (doShift b) w
@@ -165,7 +165,7 @@ placeChasm gw rid ps shiftps =
& gwWorld %~ f
where
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
-- :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
@@ -211,51 +211,24 @@ plMachine ::
Float ->
GenWorld ->
(Int, GenWorld)
plMachine wallpoly mc = \case
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 =
plMachine wallpoly mc mitm p rot gw =
( mcid
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wallpoly mcid wlid
& gwWorld . cWorld . lWorld . items . at itid ?~ itm'
, gw & tolw . machines . at mcid ?~ themc
& tolw . walls %~ placeMachineWalls wallpoly mcid wlid
& tolw %~ maybe id placeturretitm mitm
)
where
itm' =
itm & itID .~ NInt itid
& itLocation .~ OnTurret mcid
itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
tolw = gwWorld . cWorld . lWorld
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}
& 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})
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
itm' = itm & itID .~ NInt itid & itLocation .~ OnTurret mcid
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls :: [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall