justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on what happens when creatures fall down chasms

Browse Source
This commit is contained in:
justin
2025-08-05 21:39:44 +01:00
parent df443744db
commit f69956750a
9 changed files with 112 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Prop/Gib.hs
+18 -19
View File
@@ -1,15 +1,13 @@
module Dodge.Prop.Gib (
addCrGibs,
) where
module Dodge.Prop.Gib (addCrGibs) where
import Dodge.WorldEvent.Cloud
import Dodge.Creature.Shape
import Color
import Control.Monad
import Data.Foldable
import Data.List (zip4)
import Dodge.Creature.Shape
import Dodge.Damage
import Dodge.Data.World
import Dodge.WorldEvent.Cloud
import Geometry
import LensHelp
import qualified Quaternion as Q
@@ -18,16 +16,16 @@ import RandomHelp
addCrGibs :: Creature -> World -> World
addCrGibs cr = case damageDirection $ _crDamage cr of
Nothing ->
addGibAt 25 (_skinHead skin) cpos
addGibAt 25 (_skinHead skin) cpos
. addGibsAtDir pi 0 3 7 (_skinLower skin) cpos
. addGibsAtDir pi 0 13 20 (_skinUpper skin) cpos
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
Just d -> (testFloat +~ 1)
. addGibsAtDir (pi/4) d 3 7 (_skinLower skin) cpos
. addGibsAtDir (pi/4) d 13 20 (_skinUpper skin) cpos
Just d ->
addGibsAtDir (pi / 4) d 3 7 (_skinLower skin) cpos
. addGibsAtDir (pi / 4) d 13 20 (_skinUpper skin) cpos
. addGibAtDir d 25 (_skinHead skin) cpos
. makeDustAt Flesh 50 (addZ 20 cpos)
. makeDustAt Flesh 50 (addZ 20 cpos)
@@ -48,11 +46,11 @@ addGibsAtDir spread dir minh maxh col p w =
dirs = unitVectorAtAngle <$> (randsSpread (dir - spread, dir + spread) 4 & evalState $ _randGen w)
vels = zipWith (*.*) speeds dirs
zspeeds = replicateM 4 (state (randomR (-8, 8))) & evalState $ _randGen w
quats :: [Q.Quaternion Float]
quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
addGib4 :: Point2 -> Color -> (Point2, Float, QFloat, Float) -> World -> World
addGib4 p col (v, zs, q, h) = cWorld . lWorld . debris
addGib4 p col (v, zs, q, h) =
cWorld . lWorld . debris
.:~ DebrisChunk
{ _dbPos = p `v2z` h
, _dbType = Gib 3 col
@@ -60,7 +58,7 @@ addGib4 p col (v, zs, q, h) = cWorld . lWorld . debris
, _dbRot = q
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
}
addGibAt :: Float -> Color -> Point2 -> World -> World
addGibAt h col p w = addGibAtDir d h col p (w & randGen .~ newg)
where
@@ -78,10 +76,11 @@ addGibAtDir dir h col p w =
zs <- state $ randomR (-4, 4)
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
let v = s *.* unitVectorAtAngle dir
return $ DebrisChunk
{ _dbPos = p `v2z` h
, _dbType = Gib 3 col
, _dbVel = v `v2z` zs
, _dbRot = q
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
}
return $
DebrisChunk
{ _dbPos = p `v2z` h
, _dbType = Gib 3 col
, _dbVel = v `v2z` zs
, _dbRot = q
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
}