Improve falling, hover corpse

This commit is contained in:
2026-04-05 09:31:25 +01:00
parent 3952b2b1b7
commit 73dfd1f319
4 changed files with 16 additions and 13 deletions
+3 -1
View File
@@ -11,7 +11,9 @@ import Shape
import ShapePicture import ShapePicture
makeCorpse :: Creature -> SPic makeCorpse :: Creature -> SPic
makeCorpse cr = makeCorpse cr = case cr ^. crType of
HoverCrit{} -> noPic $ drawHoverCrit cr
_ ->
noPic noPic
. scaleSH (V3 crsize crsize crsize) . scaleSH (V3 crsize crsize crsize)
$ mconcat $ mconcat
+1 -1
View File
@@ -39,7 +39,7 @@ updateCarriage' cid cr w = \case
Falling {} -> Falling {} ->
let v = 0.95 *^ (cr ^. crOldPos - oop & _z -~ 0.5) let v = 0.95 *^ (cr ^. crOldPos - oop & _z -~ 0.5)
ep = cr ^. crPos + v ep = cr ^. crPos + v
in if ep ^. _z < 0 && in if ep ^. _z < 0 && cr ^. crOldPos . _z >= 0 &&
(not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms)) (not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms))
|| any (uncurry $ crOnSeg cr) (w ^. cWorld . cliffs)) || any (uncurry $ crOnSeg cr) (w ^. cWorld . cliffs))
then w & tocr . crPos .~ (ep & _z .~ 0) then w & tocr . crPos .~ (ep & _z .~ 0)
+4 -4
View File
@@ -19,10 +19,10 @@ debrisSPic db = translateSP (_dbPos db & _z +~ 1) . overPosSP (Q.rotate (_dbRot
case db ^. dbType of case db ^. dbType of
Gib x col -> noPic $ drawGib x col Gib x col -> noPic $ drawGib x col
BlockDebris m -> noPic . colorSH m $ cubeShape 4 BlockDebris m -> noPic . colorSH m $ cubeShape 4
--MetalDebris c -> noPic . colorSH c $ upperPrismPolySU 1 $ [0, V2 5 0, V2 4 2] MetalDebris c -> noPic . colorSH c $ upperBox Small Undesired 1 jagshape
MetalDebris c -> noPic . colorSH c $ upperPrismPolySU 1 [0, V2 8 0, V2 6 3] GlassDebris -> noPic . colorSH azure $ upperPrismPoly Small Undesired 1 jagshape
--MetalDebris c -> noPic . colorSH c $ upperPrismPolySU 1 $ [0, V2 10 0, V2 8 4] where
GlassDebris -> noPic . colorSH azure $ upperPrismPoly Small Undesired 1 [0, V2 8 0, V2 6 3] jagshape = [0, V2 8 0, V2 6 3] & each -~ V2 4 1.5
propSPic :: Prop -> SPic propSPic :: Prop -> SPic
propSPic pr = propSPic pr =
+1
View File
@@ -39,6 +39,7 @@ tocrs = uvWorld . cWorld . lWorld . creatures
testStringInit :: Universe -> [String] testStringInit :: Universe -> [String]
testStringInit u = u ^.. tocrs . each . crStance . carriage . to show testStringInit u = u ^.. tocrs . each . crStance . carriage . to show
<> u ^.. tocrs . each . crPos . _z . to show
-- where -- where
-- tocr = uvWorld . cWorld . lWorld . creatures . ix 0 -- tocr = uvWorld . cWorld . lWorld . creatures . ix 0