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

Improve gibs

Browse Source
This commit is contained in:
justin
2026-04-03 16:47:06 +01:00
parent e8069073b5
commit 2b2ac53466
3 changed files with 282 additions and 268 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Update.hs
+1 -1
View File
@@ -133,7 +133,7 @@ corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
. dodeathsound PoisonDeath . dodeathsound PoisonDeath
Just PhysicalDamage Just PhysicalDamage
| _crPain cr > 200 -> | _crPain cr > 200 ->
addCrGibs cr makeCrGibs cr
. sethp CrIsGibs . sethp CrIsGibs
. dodeathsound GibsDeath . dodeathsound GibsDeath
_ -> _ ->
src/Dodge/Prop/Gib.hs
+38 -28
View File
@@ -1,5 +1,7 @@
module Dodge.Prop.Gib (addCrGibs) where {-# LANGUAGE LambdaCase #-}
module Dodge.Prop.Gib (makeCrGibs) where
import Dodge.Creature.Material
import Linear import Linear
import Color import Color
import Control.Monad import Control.Monad
@@ -14,32 +16,33 @@ import LensHelp
import qualified Quaternion as Q import qualified Quaternion as Q
import RandomHelp import RandomHelp
addCrGibs :: Creature -> World -> World makeCrGibs :: Creature -> World -> World
addCrGibs cr = case damageDirection $ _crDamage cr of makeCrGibs cr = case damageDirection $ _crDamage cr of
Nothing -> Nothing ->
addGibAt (_skinHead skin) (cpos & _z +~ 25) addGibAt mat (_skinHead skin) (cpos & _z +~ 25)
. addGibsAtDir pi 0 3 7 (_skinLower skin) cpos . addGibsAtDir mat pi 0 3 7 (_skinLower skin) cpos
. addGibsAtDir pi 0 13 20 (_skinUpper skin) cpos . addGibsAtDir mat pi 0 13 20 (_skinUpper skin) cpos
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
Just d -> Just d ->
addGibsAtDir (pi / 4) d 3 7 (_skinLower skin) cpos addGibsAtDir mat (pi / 4) d 3 7 (_skinLower skin) cpos
. addGibsAtDir (pi / 4) d 13 20 (_skinUpper skin) cpos . addGibsAtDir mat (pi / 4) d 13 20 (_skinUpper skin) cpos
. addGibAtDir d (_skinHead skin) (cpos & _z +~ 25) . addGibAtDir mat d (_skinHead skin) (cpos & _z +~ 25)
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
. makeDustAt Flesh 50 cpos . makeDustAt mat 50 cpos
where where
mat = crMaterial $ cr ^. crType
skin = crShape $ _crType cr -- this should be cleaned up skin = crShape $ _crType cr -- this should be cleaned up
cpos = _crPos cr cpos = _crPos cr
-- this is ugly because it is mostly copy-paste from addGibsAt -- this is ugly because it is mostly copy-paste from addGibsAt
addGibsAtDir :: Float -> Float -> Float -> Float -> Color -> Point3 -> World -> World addGibsAtDir :: Material -> Float -> Float -> Float -> Float -> Color -> Point3 -> World -> World
addGibsAtDir spread dir minh maxh col p w = addGibsAtDir m spread dir minh maxh col p w =
foldl' (flip $ addGib4 p col) w (zip4 vels zspeeds quats hs) foldl' (flip $ addGib4 m p col) w (zip4 vels zspeeds quats hs)
& randGen .~ newg & randGen .~ newg
where where
(speeds, newg) = replicateM 4 (state (randomR (1, 4))) & runState $ _randGen w (speeds, newg) = replicateM 4 (state (randomR (1, 4))) & runState $ _randGen w
@@ -49,26 +52,27 @@ addGibsAtDir spread dir minh maxh col p w =
zspeeds = replicateM 4 (state (randomR (-8, 8))) & evalState $ _randGen w zspeeds = replicateM 4 (state (randomR (-8, 8))) & evalState $ _randGen w
quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
addGib4 :: Point3 -> Color -> (Point2, Float, QFloat, Float) -> World -> World -- this should be unified with addGibAtDir
addGib4 p col (v, zs, q, h) = addGib4 :: Material -> Point3 -> Color -> (Point2, Float, QFloat, Float) -> World -> World
addGib4 m p col (v, zs, q, h) =
cWorld . lWorld . debris cWorld . lWorld . debris
.:~ DebrisChunk .:~ DebrisChunk
{ _dbPos = p & _z +~ h { _dbPos = p & _z +~ h
, _dbType = Gib 3 col , _dbType = materialGib m col
, _dbVel = v `v2z` zs , _dbVel = v `v2z` zs
, _dbRot = q , _dbRot = q
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1) , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
} }
addGibAt :: Color -> Point3 -> World -> World addGibAt :: Material -> Color -> Point3 -> World -> World
--addGibAt h col p w = addGibAtDir d h col p (w & randGen .~ newg) --addGibAt h col p w = addGibAtDir d h col p (w & randGen .~ newg)
addGibAt col p w = addGibAtDir d col p (w & randGen .~ newg) addGibAt m col p w = addGibAtDir m d col p (w & randGen .~ newg)
where where
(d, newg) = randomR (0, 2 * pi) $ _randGen w (d, newg) = randomR (0, 2 * pi) $ _randGen w
addGibAtDir :: Float -> Color -> Point3 -> World -> World addGibAtDir :: Material -> Float -> Color -> Point3 -> World -> World
--addGibAtDir dir h col p w = --addGibAtDir dir h col p w =
addGibAtDir dir col p w = addGibAtDir m dir col p w =
w w
& cWorld . lWorld . debris .:~ gib & cWorld . lWorld . debris .:~ gib
& randGen .~ newg & randGen .~ newg
@@ -82,8 +86,14 @@ addGibAtDir dir col p w =
return $ return $
DebrisChunk DebrisChunk
{ _dbPos = p { _dbPos = p
, _dbType = Gib 3 col , _dbType = materialGib m col
, _dbVel = v `v2z` zs , _dbVel = v `v2z` zs
, _dbRot = q , _dbRot = q
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1) , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
} }
materialGib :: Material -> Color -> DebrisType
materialGib = \case
Flesh -> Gib 3
Metal -> MetalDebris
_ -> BlockDebris
tags
+243 -239
View File
File diff suppressed because it is too large Load Diff