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

Remove separate wall color, should be handled by material type

Browse Source
This commit is contained in:
justin
2025-10-23 21:27:14 +01:00
parent 819f0d37ea
commit 3c6d269d00
24 changed files with 136 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/PlaceSpot.hs
+6 -9
View File
@@ -7,7 +7,6 @@
module Dodge.Placement.PlaceSpot (placeSpot) where
import qualified Data.Set as S
import Color
import Control.Monad.State
import Data.Bifunctor
import Data.Foldable
@@ -135,7 +134,7 @@ placeSpotID rid ps pt w = case pt of
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 col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
PutDoor col eo f l p1 p2 -> plDoor col 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
@@ -229,7 +228,7 @@ plTurret ::
plTurret wallpoly mc wl itm p rot gw =
( mcid
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
& gwWorld . cWorld . lWorld . items . at itid ?~ itm'
)
where
@@ -237,7 +236,6 @@ plTurret wallpoly mc wl itm p rot gw =
itm & itID .~ NInt itid
& itLocation .~ OnTurret mcid
itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
col = _mcColor mc
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
@@ -252,10 +250,9 @@ plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> GenWorld -> (Int
plMachine' wallpoly mc wl p rot gw =
( mcid
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
)
where
col = _mcColor mc
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
@@ -263,13 +260,13 @@ plMachine' wallpoly mc wl p rot gw =
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls ::
Wall -> Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls wl col poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
Wall -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls wl poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
where
f (wid, l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
baseWall =
wl
& wlColor .~ col
-- & wlColor .~ col
& wlStructure . wsMachine .~ mcid
& wlTouchThrough .~ True