112 lines
3.5 KiB
Haskell
112 lines
3.5 KiB
Haskell
module Dodge.Block.Debris (
|
|
cubeShape,
|
|
-- dirtColor,
|
|
makeDoorDebris,
|
|
makeBlockDebris,
|
|
makeDebris,
|
|
makeDebrisDirected,
|
|
) where
|
|
|
|
import Dodge.Material.Color
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Dodge.ShiftPoint
|
|
import Data.Foldable
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Dodge.Data.World
|
|
import Dodge.Material.Sound
|
|
import Dodge.WorldEvent.Sound
|
|
import Geometry
|
|
import Grid
|
|
import LensHelp
|
|
import qualified Quaternion as Q
|
|
import RandomHelp
|
|
import Shape
|
|
|
|
makeDoorDebris :: Door -> World -> World
|
|
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 = fromMaybe Stone $ do
|
|
wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
|
|
((wlid,_),_) <- IM.minViewWithKey wlids
|
|
w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
|
|
|
|
makeBlockDebris :: Block -> World -> World
|
|
makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
|
|
where
|
|
dsize = debrisSize mt
|
|
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
|
|
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
|
|
|
|
--makeDebris :: Material -> Color -> Point2 -> World -> World
|
|
makeDebris :: Material -> Point2 -> World -> World
|
|
makeDebris = makeDebrisDirected (2 * pi) 0
|
|
|
|
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
|
|
& randGen .~ newg
|
|
& soundOriginsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
|
|
where
|
|
(thedebris, newg) = mapM f [35, 55, 75, 95] & runState $ _randGen w
|
|
f h = do
|
|
v <- rotateV (dir - arcrad / 2) <$> randInArcStrip 1 2 arcrad
|
|
spinspeed <- randomR (-0.2, -0.1) & state
|
|
-- basedebris <- baseDebris bm
|
|
return $ DebrisChunk
|
|
{ _dbPos = p `v2z` h
|
|
-- , _dbType = BlockDebris col
|
|
, _dbType = BlockDebris (materialColor bm)
|
|
, _dbVel = v `v2z` 0
|
|
, _dbRot = Q.qID
|
|
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
|
|
}
|
|
-- basedebris
|
|
-- & prColor .~ col
|
|
-- & prPos .~ p
|
|
-- & prVel .~ v
|
|
-- & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
|
|
-- & prQuat .~ Q.qID
|
|
-- & prVelZ .~ 0
|
|
-- & prPosZ .~ h
|
|
|
|
debrisSize :: Material -> Float
|
|
debrisSize mt = case mt of
|
|
Stone -> 20
|
|
Glass -> 10
|
|
Crystal -> 10
|
|
Dirt -> 20
|
|
Wood -> 10
|
|
Metal -> 10
|
|
Electronics -> 10
|
|
Flesh -> 10
|
|
ForceField -> 10
|
|
|
|
--shardShape :: Float -> Shape
|
|
--shardShape size =
|
|
-- translateSHz (- size) $
|
|
-- upperPrismPolySU
|
|
-- size
|
|
-- [ V2 size 0
|
|
-- , V2 (- size) 1
|
|
-- , V2 (- size) (-1)
|
|
-- ]
|
|
--
|
|
--jaggedShape :: State StdGen Shape
|
|
--jaggedShape = do
|
|
-- s <- randomR (4, 10) & state
|
|
-- return $ shardShape s
|
|
|
|
cubeShape :: Float -> Shape
|
|
cubeShape size = translateSHz (- size) $ upperPrismPolySU (2 * size) $ square size
|