This commit is contained in:
2022-06-16 12:33:00 +01:00
parent aa29e5ddf2
commit 4d6e547b74
2 changed files with 10 additions and 26 deletions
+8 -24
View File
@@ -16,40 +16,24 @@ import qualified Quaternion as Q
--import Data.List (zip4)
makeBlockDebris :: Block -> World -> World
makeBlockDebris bl = makeDebris (_blMaterial bl) (_blPos bl)
makeBlockDebris bl = makeDebris (greyN 0.5) (_blMaterial bl) (_blPos bl)
makeDebris :: BlockMaterial -> Point2 -> World -> World
makeDebris bm p w = w
makeDebris :: Color -> BlockMaterial -> Point2 -> World -> World
makeDebris = makeDebrisDirected (2*pi) 0
makeDebrisDirected :: Float -> Float -> Color -> BlockMaterial -> Point2 -> World -> World
makeDebrisDirected arcrad dir col bm p w = w
& flip (foldr (plNew props pjID)) thedebris
& randGen .~ newg
& matDesSound bm p
where
(thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
f h = do
v <- randInCirc 2
v <- rotateV (dir - arcrad/2) <$> randInArcStrip 2 3 arcrad
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
return $ someDebris
& prPos .~ p
& pjColor .~ greyN 0.5
& pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
& pjQuat .~ q
& pjVelZ .~ 0
& pjPosZ .~ h
makeDebrisDirected :: BlockMaterial -> Point2 -> Float -> World -> World
makeDebrisDirected bm p dir w = w
& flip (foldr (plNew props pjID)) thedebris
& randGen .~ newg
& matDesSound bm p
where
(thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
f h = do
v <- rotateV (dir - pi/4) <$> randInArcStrip 2 3 (pi/2)
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
return $ someDebris
& prPos .~ p
& pjColor .~ greyN 0.5
& pjColor .~ col
& pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
& pjQuat .~ q
+2 -2
View File
@@ -60,6 +60,6 @@ shootShatter it cr w = maybe w (uncurry $ shatterWall w sp ep) $ collidePointWal
shatterWall :: World -> Point2 -> Point2 -> Point2 -> Wall -> World
shatterWall w sp ep p wl = w
& makeDebris StoneBlock p
& makeDebrisDirected StoneBlock p (argV $ vNormal $ uncurry (-.-) $ _wlLine wl)
& makeDebris (_wlColor wl) StoneBlock p
& makeDebrisDirected (pi/2) (argV $ vNormal $ uncurry (-.-) $ _wlLine wl) (_wlColor wl) StoneBlock p
& damageWall (Damage SHATTERING 1000 sp p ep NoDamageEffect) wl