100 lines
3.1 KiB
Haskell
100 lines
3.1 KiB
Haskell
module Dodge.Block.Debris where
|
|
import Dodge.Prop.Moving
|
|
import Dodge.WorldEvent.Sound
|
|
import Dodge.SoundLogic
|
|
--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 Data.List (zip4)
|
|
|
|
makeBlockDebris :: Block -> World -> World
|
|
makeBlockDebris bl = makeDebris (_blMaterial bl) (_blPos bl)
|
|
|
|
makeDebris :: BlockMaterial -> Point2 -> World -> World
|
|
makeDebris = makeDebrisDirected 1 2 (2*pi) 0
|
|
makeDebrisDirected :: Float -> Float
|
|
-> Float -> Float -> BlockMaterial -> Point2 -> World -> World
|
|
makeDebrisDirected mindist maxdist arcrad dir bm p w = w
|
|
& flip (foldr (plNew props pjID)) thedebris
|
|
& randGen .~ newg
|
|
& matDesSound bm p
|
|
where
|
|
someDebris = case bm of
|
|
StoneBlock -> stoneDebris
|
|
GlassBlock -> glassDebris
|
|
CrystalBlock -> crystalDebris
|
|
DirtBlock -> dirtDebris
|
|
WoodBlock -> stoneDebris
|
|
MetalBlock -> stoneDebris
|
|
(thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
|
|
f h = do
|
|
v <- rotateV (dir - arcrad/2) <$> randInArcStrip mindist maxdist arcrad
|
|
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
|
|
return $ someDebris
|
|
& prPos .~ p
|
|
& pjVel .~ v
|
|
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
|
|
& pjQuat .~ q
|
|
& pjVelZ .~ 0
|
|
& pjPosZ .~ h
|
|
|
|
stoneDebris :: Prop
|
|
stoneDebris = PropZ
|
|
{_prPos = 0
|
|
,_pjStartPos = 0
|
|
,_pjVel = 0
|
|
,_prDraw = \pr -> drawMovingShape pr (debrisShape 4 pr)
|
|
,_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)
|
|
|
|
glassDebris :: Prop
|
|
glassDebris = PropZ
|
|
{_prPos = 0
|
|
,_pjStartPos = 0
|
|
,_pjVel = 0
|
|
,_prDraw = \pr -> drawMovingShape pr (debrisShape 2 pr)
|
|
,_pjID = 0
|
|
,_pjUpdate = fallSmallBounce
|
|
,_pjPosZ = 10
|
|
,_pjVelZ = 5
|
|
,_pjTimer = 20
|
|
,_pjQuat = Q.axisAngle (V3 1 0 0) 0
|
|
,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
|
|
,_pjColor = withAlpha 0.5 cyan
|
|
}
|
|
crystalDebris :: Prop
|
|
crystalDebris = glassDebris
|
|
& pjColor .~ withAlpha 0.5 aquamarine
|
|
debrisShape :: Float -> Prop -> Shape
|
|
debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly 8 $ square size
|
|
|
|
matDesSound :: BlockMaterial -> Point2 -> World -> World
|
|
matDesSound mat = case mat of
|
|
GlassBlock -> mkSoundBreakGlass
|
|
CrystalBlock -> mkSoundBreakGlass -- this should be more crunchy
|
|
StoneBlock -> mkSoundSplinterBlock
|
|
DirtBlock -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
|
|
WoodBlock -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
|
|
MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
|