diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index d85509e61..3812e76dc 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/Shatter.hs b/src/Dodge/Item/Weapon/Shatter.hs index a2d7eacef..15383638b 100644 --- a/src/Dodge/Item/Weapon/Shatter.hs +++ b/src/Dodge/Item/Weapon/Shatter.hs @@ -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