diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs index b4143fcbd..8f0e3e2be 100644 --- a/src/Dodge/Creature/State/WalkCycle.hs +++ b/src/Dodge/Creature/State/WalkCycle.hs @@ -2,6 +2,7 @@ module Dodge.Creature.State.WalkCycle (updateCarriage) where +import qualified Quaternion as Q import Dodge.Creature.Radius import Geometry import Dodge.Update.Camera.Rotate @@ -32,7 +33,7 @@ updateCarriage' cid cr w = \case & tocr . crStance . carriage . zSpeed %~ if cr ^. crPos . _z < 17 then min 0.05 . (+0.001) else max (-0.05) . subtract 0.001 Boosting {} -> w - Falling {} -> + Falling {_fallRot = q} -> let v = 0.95 *^ (cr ^. crOldPos - oop & _z -~ 0.5) ep = cr ^. crPos + v in if ep ^. _z < 0 && cr ^. crOldPos . _z >= 0 && @@ -41,6 +42,8 @@ updateCarriage' cid cr w = \case then w & tocr . crPos .~ (ep & _z .~ 0) & cWorld . lWorld . creatures . ix cid . crStance . carriage .~ OnGround else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep + & cWorld . lWorld . creatures . ix cid . crStance . carriage . fallDir *~ q + OnGround {} -> w & tocr . crPos . _xy +~ 0.8 *^ (cr ^. crOldPos . _xy - oop ^. _xy) & chasmTestCliffPush groundCliffPush cr @@ -106,7 +109,10 @@ chasmTestCliffPush f' cr w & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100) & tocr . crPos . _xy +~ f' cr (xy:xys) -- (f cr (xy:xys)) *^ h xy xys & chasmRotate cr (uncurry (-) xy) - | any f (w ^. cWorld . chasms) = w & tocr . crStance . carriage .~ Falling -- %~ startFalling + | any f (w ^. cWorld . chasms) = w & tocr . crStance . carriage + .~ Falling + (Q.axisAngle (0 & _xy .~ vNormal (cr^.crOldOldPos._xy - cr^.crOldPos._xy)) 0.03) + Q.qid | otherwise = w where cxy = cr ^. crPos . _xy diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 548fbeee0..9406d8620 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} module Dodge.Creature.Update (updateCreature) where +import qualified Quaternion as Q import Dodge.Creature.Picture import Dodge.Base.You import Control.Monad @@ -127,9 +128,9 @@ startDeathTimer cr = cr toDeathCarriage :: Carriage -> Carriage toDeathCarriage = \case - Flying {} -> Falling + Flying {} -> Falling Q.qid Q.qid Walking -> OnGround - _ -> Falling + _ -> Falling Q.qid Q.qid -- could look at the amount of damage here (given by maxDamage) too corpseOrGib :: Creature -> World -> World diff --git a/src/Dodge/Data/Creature/Stance.hs b/src/Dodge/Data/Creature/Stance.hs index 20e07e15b..9a2001e62 100644 --- a/src/Dodge/Data/Creature/Stance.hs +++ b/src/Dodge/Data/Creature/Stance.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} @@ -11,6 +12,7 @@ import Data.Aeson import Data.Aeson.TH import Dodge.Data.AimStance import Geometry.Data +import Linear data Stance = Stance { _carriage :: Carriage @@ -23,7 +25,7 @@ data Carriage | Floating | Flying {_zSpeed :: Float, _flyInertia :: Float} | Boosting Point2 - | Falling + | Falling {_fallRot :: Quaternion Float, _fallDir :: Quaternion Float} | OnGround deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -36,6 +38,7 @@ data Posture = Aiming | AtEase makeLenses ''Stance makeLenses ''Carriage makeLenses ''Posture +deriveJSON defaultOptions ''Quaternion deriveJSON defaultOptions ''FootForward deriveJSON defaultOptions ''Posture deriveJSON defaultOptions ''Carriage diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 4d4ec2ce5..d11552349 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,6 +1,7 @@ --{-# LANGUAGE LambdaCase #-} module Dodge.Render.ShapePicture (worldSPic) where +import qualified Quaternion as Q import Dodge.Debug import Control.Lens import Data.Foldable @@ -109,7 +110,7 @@ drawPlasmaBall pb = $ circleSolidCol green white 5 drawCreature :: World -> IM.IntMap Item -> Creature -> SPic -drawCreature w m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $ +drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $ case cr ^. crType of _ | CrIsCorpse sp <- cr ^. crHP -> sp _ | null (cr ^? crHP . _HP) -> mempty @@ -121,6 +122,10 @@ drawCreature w m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $ AutoCrit -> basicCrPict m cr CrabCrit {} -> noPic $ drawCrabCrit w cr HoverCrit{} -> noPic $ drawHoverCrit cr + where + fallrot = case cr ^. crStance . carriage of + Falling {_fallDir = q} -> _1 . each . sfVs . each %~ Q.rotate q + _ -> id barrelShape :: SPic barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)