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

Move stride/footforward datatypes

Browse Source
This commit is contained in:
justin
2026-04-03 11:21:09 +01:00
parent d65a4529be
commit b7b42f50a5
12 changed files with 238 additions and 248 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+1 -1
View File
@@ -99,7 +99,7 @@ startCr =
& crInv .~ mempty
& crFaction .~ PlayerFaction
-- & crMvType .~ MvWalking yourDefaultSpeed
& crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3 AvPosture
& crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3 AvPosture LeftForward 0
-- | Items you start with.
startInvList :: [Item]
src/Dodge/Creature/HandPos.hs
+8 -25
View File
@@ -49,23 +49,14 @@ strideLength cr = case cr ^. crType of
_ -> 30
handWalkingPos :: FootForward -> Float -> Creature -> Point3
handWalkingPos b off cr = case cr ^. crStance . carriage of
Walking sa ff ->
handWalkingPos b off cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just sa,Just ff) ->
let slen = strideLength cr
f i
| ff == b = 8 * zeroOneSmooth ((slen - i) / slen)
| otherwise = 8 * zeroOneSmooth (i / slen)
in V3 (f sa) off 12
Falling sa ff ->
let slen = strideLength cr
f i
| ff == b = 8 * zeroOneSmooth ((slen - i) / slen)
| otherwise = 8 * zeroOneSmooth (i / slen)
in V3 (f sa) off 20
Floating -> V3 0 off 12
Flying {} -> V3 0 off 12
Boosting _ -> V3 0 off 12
OnGround -> V3 0 off 12
_ -> V3 0 off 12
zeroOneSmooth :: Float -> Float
zeroOneSmooth x = (1 - cos (pi * x)) / 2
@@ -137,14 +128,8 @@ leftHandPQ cr
| otherwise = (handWalkingPos RightForward 8 cr, Q.qid)
twoHandOffY :: Creature -> Float
twoHandOffY cr = zeroOneSmooth $ case cr ^. crStance . carriage of
Walking sa ff ->
let slen = strideLength cr
f i
| ff == RightForward = (slen - i) / slen
| otherwise = i / slen
in f sa
Falling sa ff ->
twoHandOffY cr = zeroOneSmooth $ case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just sa,Just ff) ->
let slen = strideLength cr
f i
| ff == RightForward = (slen - i) / slen
@@ -175,11 +160,9 @@ legPQ' g cr =
(0, Q.qz (_crMvDir cr - _crDir cr))
(V3 x (g off) 0, Q.qid)
where
x = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> -f sa
Just (Walking sa RightForward) -> f sa
Just (Falling sa LeftForward) -> -f sa
Just (Falling sa RightForward) -> f sa
x = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just sa,Just LeftForward) -> -f sa
(Just sa,Just RightForward) -> f sa
_ -> 0
off = -5
sLen = strideLength cr
src/Dodge/Creature/Picture.hs
+6 -6
View File
@@ -91,9 +91,9 @@ chaseUpperBody cr = colorSH (_skinUpper cskin)
_ -> 0
sLen = strideLength cr
tbob = 5 * (1 - oneSmooth (abs llegpos))
llegpos = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> f sa
Just (Walking sa RightForward) -> -f sa
llegpos = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just sa, Just LeftForward) -> f sa
(Just sa, Just RightForward) -> -f sa
_ -> 0
--tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
f i = (sLen - 2*i) / sLen
@@ -104,9 +104,9 @@ oneSmooth x = sin (pi * x * 0.5)
feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> sh (f sa)
Just (Walking sa RightForward) -> sh (-f sa)
feet cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just sa,Just LeftForward) -> sh (f sa)
(Just sa,Just RightForward) -> sh (-f sa)
_ -> sh 0
where
sh x = translateSHxy x off aFoot <> translateSHxy (- x) (- off) aFoot
src/Dodge/Creature/State/WalkCycle.hs
+9 -8
View File
@@ -18,14 +18,15 @@ updateCarriage cid w = fromMaybe w $ do
updateCarriage' :: Int -> Creature -> World -> Carriage -> World
updateCarriage' cid cr w = \case
Walking x ff | x >= strideLength cr -> w
Walking -> case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just x,Just ff) | x >= strideLength cr -> w
& soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos . _xy)
(chooseFootSound ff)
Nothing
& over (cWorld . lWorld . creatures . ix cid . crStance . carriage) resetStride
Walking {} -> w
& over (cWorld . lWorld . creatures . ix cid . crType) resetStride
_ -> w
Floating -> w
Flying {_zSpeed = dz, _flyInertia = x} ->
w & cWorld . lWorld . creatures . ix cid . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop ^. _xy)
@@ -33,7 +34,7 @@ updateCarriage' cid cr w = \case
& cWorld . lWorld . creatures . ix cid . 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 {} ->
let v = 0.9 *^ (cr ^. crOldPos - oop & _z -~ 0.5)
ep = cr ^. crPos + v
in if ep ^. _z < 0 && not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms))
@@ -47,10 +48,10 @@ updateCarriage' cid cr w = \case
| otherwise = v
resetStride :: Carriage -> Carriage
resetStride = \case
Walking _ ff -> Walking 0 (normalGait ff)
x -> x
resetStride :: CreatureType -> CreatureType
resetStride ct = case ct ^? footForward of
Just _ -> ct & strideAmount .~ 0 & footForward %~ normalGait
_ -> ct
normalGait :: FootForward -> FootForward
normalGait = \case
src/Dodge/Creature/Update.hs
+3 -3
View File
@@ -101,7 +101,7 @@ checkDeath' cr w = case cr ^. crHP of
toDeathCarriage :: Carriage -> Carriage
toDeathCarriage = \case
Flying {} -> Falling 0 RightForward
Flying {} -> Falling
x -> x
-- could look at the amount of damage here (given by maxDamage) too
@@ -165,8 +165,8 @@ chasmTestLiving cr w
startFalling :: Creature -> Creature
startFalling cr = case cr ^. crStance . carriage of
Walking a b -> cr & crStance . carriage .~ Falling a b
_ -> cr & crStance . carriage .~ Falling 0 RightForward
Walking -> cr & crStance . carriage .~ Falling
_ -> cr & crStance . carriage .~ Falling
chasmTestCorpse :: Creature -> World -> World
chasmTestCorpse cr w
src/Dodge/Data/Creature/Misc.hs
+7 -1
View File
@@ -6,6 +6,7 @@ module Dodge.Data.Creature.Misc (
module Dodge.Data.CamouflageStatus,
) where
import Dodge.Data.Creature.Stance
import Color
import Control.Lens
import Data.Aeson
@@ -50,8 +51,13 @@ data CreatureType
, _avIntelligence :: Int
, _avMoveSpeed :: Float
, _avPosture :: AvatarPosture
, _footForward :: FootForward
, _strideAmount :: Float
}
| ChaseCrit {_meleeCooldown :: Int
, _footForward :: FootForward
, _strideAmount :: Float
}
| ChaseCrit {_meleeCooldown :: Int}
| HoverCrit {_meleeCooldown :: Int}
| SwarmCrit
| AutoCrit
src/Dodge/Data/Creature/Stance.hs
+2 -2
View File
@@ -19,11 +19,11 @@ data Stance = Stance
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Carriage
= Walking {_strideAmount :: Float, _footForward :: FootForward}
= Walking
| Floating
| Flying {_zSpeed :: Float, _flyInertia :: Float}
| Boosting Point2
| Falling {_fallFlail :: Float, _fallFoot :: FootForward}
| Falling
| OnGround
deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Default/Creature.hs
+2 -2
View File
@@ -22,7 +22,7 @@ defaultCreature =
, _crMvAim = 0
-- , _crTwist = 0
, _crID = 1
, _crType = ChaseCrit {_meleeCooldown = 0}
, _crType = ChaseCrit 0 LeftForward 0
-- , _crRad = 10
, _crHP = HP 100
-- , _crMaxHP = 150
@@ -39,7 +39,7 @@ defaultCreature =
-- , _crHotkeys = M.empty
, _crStance =
Stance
{ _carriage = Walking 0 LeftForward
{ _carriage = Walking
, _posture = AtEase
}
, _crVocalization = VocReady
src/Dodge/Item/HeldOffset.hs
+3 -5
View File
@@ -78,11 +78,9 @@ shoulderHeight :: Float
shoulderHeight = 18
strideRot :: Creature -> Float
strideRot cr = case cr ^? crStance . carriage of
Just (Walking x LeftForward) -> f x
Just (Walking x RightForward) -> - f x
Just (Falling x LeftForward) -> f x
Just (Falling x RightForward) -> - f x
strideRot cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just x, Just LeftForward) -> f x
(Just x, Just RightForward) -> - f x
_ -> 0
where
f i = 0.1 * (sLen - i) / sLen
src/Dodge/TestString.hs
+3 -3
View File
@@ -35,12 +35,12 @@ import Data.Monoid
import RandomHelp
testStringInit :: Universe -> [String]
testStringInit u = u ^.. uvWorld . cWorld . lWorld . creatures . ix 2 . crPos . _z . to show
testStringInit u = u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crPos . _z . to show
<> [show v]
where
v = x - y
x = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 2 . crOldPos
y = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 2 . crOldOldPos
x = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldPos
y = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldOldPos
-- u = [show p, show op, show oop, show (op - oop), show . norm $ op - oop, show d]
-- where
-- f = fromMaybe 0
src/Dodge/Update.hs
+1 -1
View File
@@ -372,7 +372,7 @@ updateCreatureStrides :: World -> World
updateCreatureStrides = cWorld . lWorld . creatures . each %~ updateCreatureStride
updateCreatureStride :: Creature -> Creature
updateCreatureStride cr = cr & crStance . carriage . strideAmount +~ d
updateCreatureStride cr = cr & crType . strideAmount +~ d
where
s = fromMaybe 0 $ crMvType cr ^? mvSpeed
-- d = min s . norm $ cr ^. crPos - cr ^. crOldPos