Remove separate wall color, should be handled by material type

This commit is contained in:
2025-10-23 21:27:14 +01:00
parent 819f0d37ea
commit 3c6d269d00
24 changed files with 136 additions and 123 deletions
+22 -11
View File
@@ -7,9 +7,9 @@ module Dodge.Block.Debris (
makeDebrisDirected,
) where
import Dodge.Material.Color
import qualified Data.IntMap.Strict as IM
import Dodge.ShiftPoint
import Color
import Data.Foldable
import qualified Data.IntSet as IS
import Data.Maybe
@@ -24,32 +24,41 @@ import RandomHelp
import Shape
makeDoorDebris :: Door -> World -> World
makeDoorDebris dr w = w & makeDebris mt col p
--makeDoorDebris dr w = w & makeDebris mt col p
makeDoorDebris dr w = w & makeDebris mt p
where
p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
--(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
mt = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
((wlid,_),_) <- IM.minViewWithKey wlids
wl <- w ^? cWorld . lWorld . walls . ix wlid
return (_wlMaterial wl, _wlColor wl)
--return (_wlMaterial wl, _wlColor wl)
return $ wl ^. wlMaterial
makeBlockDebris :: Block -> World -> World
makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
--makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
where
dsize = debrisSize mt
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
--(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
mt = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
(wlid, _) <- IS.minView wlids
wl <- w ^? cWorld . lWorld . walls . ix wlid
return (_wlMaterial wl, _wlColor wl)
--return (_wlMaterial wl, _wlColor wl)
return $ _wlMaterial wl
makeDebris :: Material -> Color -> Point2 -> World -> World
--makeDebris :: Material -> Color -> Point2 -> World -> World
makeDebris :: Material -> Point2 -> World -> World
makeDebris = makeDebrisDirected (2 * pi) 0
makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
--makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
--makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected arcrad dir bm p w =
w
-- & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
& cWorld . lWorld . debris <>~ thedebris
@@ -63,7 +72,8 @@ makeDebrisDirected arcrad dir bm col p w =
-- basedebris <- baseDebris bm
return $ DebrisChunk
{ _dbPos = p `v2z` h
, _dbType = BlockDebris col
-- , _dbType = BlockDebris col
, _dbType = BlockDebris (materialColor bm)
, _dbVel = v `v2z` 0
, _dbRot = Q.qID
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
@@ -87,6 +97,7 @@ debrisSize mt = case mt of
Metal -> 10
Electronics -> 10
Flesh -> 10
ForceField -> 10
--shardShape :: Float -> Shape
--shardShape size =