132 lines
3.7 KiB
Haskell
132 lines
3.7 KiB
Haskell
module Dodge.Block.Debris where
|
|
import Dodge.Material
|
|
import Dodge.Prop.Moving
|
|
import Dodge.WorldEvent.Sound
|
|
--import Dodge.Zone
|
|
import Dodge.Base
|
|
import Dodge.Data
|
|
--import Dodge.Damage
|
|
--import ShapePicture
|
|
import Shape
|
|
import Geometry
|
|
import Color
|
|
import LensHelp
|
|
import RandomHelp
|
|
import qualified Quaternion as Q
|
|
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Data.Foldable
|
|
|
|
makeDoorDebris :: Door -> World -> World
|
|
makeDoorDebris dr w = w & makeDebris mt col p
|
|
where
|
|
p = uncurry midPoint (_drPos dr)
|
|
(mt,col) = fromMaybe (Stone,greyN 0.5) $ do
|
|
wlids <- w ^? doors . ix (_drID dr) . drWallIDs
|
|
(wlid,_) <- IS.minView wlids
|
|
wl <- w ^? walls . ix wlid
|
|
return (_wlMaterial wl,_wlColor wl)
|
|
|
|
makeBlockDebris :: Block -> World -> World
|
|
makeBlockDebris bl w = w & makeDebris mt col (_blPos bl)
|
|
where
|
|
(mt,col) = fromMaybe (Stone,greyN 0.5) $ do
|
|
wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
|
|
(wlid,_) <- IS.minView wlids
|
|
wl <- w ^? walls . ix wlid
|
|
return (_wlMaterial wl,_wlColor wl)
|
|
|
|
makeDebris :: Material -> Color -> Point2 -> World -> World
|
|
makeDebris = makeDebrisDirected 1 2 (2*pi) 0
|
|
makeDebrisDirected :: Float
|
|
-> Float
|
|
-> Float
|
|
-> Float
|
|
-> Material
|
|
-> Color
|
|
-> Point2
|
|
-> World -> World
|
|
makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
|
|
& flip (foldl' (flip $ plNew props pjID)) thedebris
|
|
& randGen .~ newg
|
|
& originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
|
|
where
|
|
(thedebris,newg) = mapM f [35,55..95] & runState $ _randGen w
|
|
f h = do
|
|
v <- rotateV (dir - arcrad/2) <$> randInArcStrip mindist maxdist arcrad
|
|
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
|
|
spinspeed <- randomR (-0.2,-0.1) & state
|
|
basedebris <- baseDebris bm
|
|
return $ basedebris
|
|
& pjColor .~ col
|
|
& prPos .~ p
|
|
& pjVel .~ v
|
|
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
|
|
& pjQuat .~ q
|
|
& pjVelZ .~ 0
|
|
& pjPosZ .~ h
|
|
|
|
baseDebris :: Material -> State StdGen Prop
|
|
baseDebris mt = case mt of
|
|
Stone -> return stoneDebris
|
|
Glass -> return glassDebris
|
|
Crystal -> return crystalDebris
|
|
Dirt -> return dirtDebris
|
|
Wood -> return stoneDebris
|
|
Metal -> do
|
|
sh <- jaggedShape
|
|
return $ metalDebris
|
|
& prDraw .~ (`drawMovingShapeCol` sh)
|
|
|
|
stoneDebris :: Prop
|
|
stoneDebris = PropZ
|
|
{_prPos = 0
|
|
,_pjStartPos = 0
|
|
,_pjVel = 0
|
|
,_prDraw = \pr -> drawMovingShapeCol pr (cubeShape 4)
|
|
,_pjID = 0
|
|
,_pjUpdate = fallSmallBounceDamage
|
|
,_pjPosZ = 10
|
|
,_pjVelZ = 5
|
|
,_pjTimer = 20
|
|
,_pjQuat = Q.axisAngle (V3 1 0 0) 0
|
|
,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
|
|
,_pjColor = greyN 0.5
|
|
}
|
|
dirtDebris :: Prop
|
|
dirtDebris = stoneDebris
|
|
& pjColor .~ dirtColor
|
|
& pjUpdate .~ fallSmallBounce
|
|
dirtColor :: Color
|
|
dirtColor = V4 (150/256) ( 75/256) 0 ( 250/256)
|
|
|
|
metalDebris :: Prop
|
|
metalDebris = stoneDebris
|
|
& prDraw .~ (\pr -> drawMovingShapeCol pr (shardShape 4))
|
|
& pjUpdate .~ fallSmallBounce
|
|
|
|
glassDebris :: Prop
|
|
glassDebris = stoneDebris
|
|
& prDraw .~ (\pr -> drawMovingShapeCol pr (shardShape 4))
|
|
& pjUpdate .~ fallSmallBounce
|
|
& pjColor .~ withAlpha 0.5 cyan
|
|
crystalDebris :: Prop
|
|
crystalDebris = glassDebris
|
|
& pjColor .~ withAlpha 0.5 aquamarine
|
|
|
|
shardShape :: Float -> Shape
|
|
shardShape size = translateSHz (-size) $ upperPrismPoly 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) $ upperPrismPoly (2*size) $ square size
|