Remove separate wall color, should be handled by material type
This commit is contained in:
+22
-11
@@ -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 =
|
||||
|
||||
Reference in New Issue
Block a user