Work on refactoring positioning relative to creature body

2025-08-27 12:11:01 +01:00
parent 2e6b7a1b41
commit 9d2a2e6730
8 changed files with 168 additions and 148 deletions
@@ -13,9 +13,10 @@ module Dodge.Creature.HandPos (
    translateToRightHand,
    backPQ,
    headPQ,
+    translateToES,
 ) where

--import Dodge.Data.Equipment.Misc
+import Dodge.Data.Equipment.Misc
 import qualified Data.IntMap.Strict as IM
 import qualified Quaternion as Q
 import Control.Lens
@@ -24,8 +25,24 @@ import Dodge.Data.Creature
 import Geometry
 import ShapePicture

-translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
-translatePointToRightHand m cr p =  fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
+translateToES :: Creature -> EquipSite -> Point3 -> Point3
+translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p,Q.qID))
+
+equipSitePQ :: EquipSite -> Creature -> Point3Q
+equipSitePQ = \case
+    OnLeftWrist -> leftWristPQ
+    OnRightWrist -> rightWristPQ
+    OnHead -> headPQ
+    OnChest -> chestPQ
+    OnBack -> backPQ
+    OnLegs -> legsPQ
+
+legsPQ :: a
+legsPQ = undefined
+
+
+translatePointToRightHand :: Creature -> Point3 -> Point3
+translatePointToRightHand cr p =  fst (rightHandPQ cr `Q.comp` (p,Q.qID))

 --equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
 --equipSitePQ = \case
@@ -35,11 +52,11 @@ translatePointToRightHand m cr p =  fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
 --    OnChest -> chestPQ
 --    _ -> undefined

-rightHandPQ :: IM.IntMap Item -> Creature -> Point3Q
-rightHandPQ m cr
-    | oneH m cr = (V3 11 (-3) 20, Q.qID)
-    | twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
-    | twoFlat m cr = (V3 4 (-8) 10, Q.qID)
+rightHandPQ :: Creature -> Point3Q
+rightHandPQ cr
+    | oneH cr = (V3 11 (-3) 20, Q.qID)
+    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
+    | twoFlat cr = (V3 4 (-8) 10, Q.qID)
    | otherwise = case cr ^? crStance . carriage of
        Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
        Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
@@ -50,18 +67,21 @@ rightHandPQ m cr
    f i = negate 2 + negate 6 * (sLen - i) / sLen
    g i = negate 2 + negate 6 * i / sLen

-translateToRightHand :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToRightHand m = overPosSP . translatePointToRightHand m
+translateToRightHand :: Creature -> SPic -> SPic
+translateToRightHand = overPosSP . translatePointToRightHand

-translateToRightWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToRightWrist m cr =  overPosSP
-    (\p -> fst $ rightHandPQ m cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
+translateToRightWrist :: Creature -> SPic -> SPic
+translateToRightWrist cr =  overPosSP
+    (\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))

-leftHandPQ :: IM.IntMap Item -> Creature -> Point3Q
-leftHandPQ m cr
-    | oneH m cr = (V3 0 off 10, Q.qz 0.4)
-    | twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
-    | twoFlat m cr = (V3 4 8 10, Q.qID)
+rightWristPQ :: Creature -> Point3Q
+rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qID)
+
+leftHandPQ :: Creature -> Point3Q
+leftHandPQ cr
+    | oneH cr = (V3 0 off 10, Q.qz 0.4)
+    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
+    | twoFlat cr = (V3 4 8 10, Q.qID)
    | otherwise = case cr ^? crStance . carriage of
        Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
        Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
@@ -72,15 +92,17 @@ leftHandPQ m cr
    f i = negate 2 + negate 6 * (sLen - i) / sLen
    g i = negate 2 + negate 6 * i / sLen

-translatePointToLeftHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
-translatePointToLeftHand m cr p = fst (leftHandPQ m cr `Q.comp` (p,Q.qID))
+translatePointToLeftHand :: Creature -> Point3 -> Point3
+translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))

 translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToLeftHand m = overPosSP . translatePointToLeftHand m
+translateToLeftHand m = overPosSP . translatePointToLeftHand

-translateToLeftWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToLeftWrist m cr = overPosSP 
-    (\p -> fst $ leftHandPQ m cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
+translateToLeftWrist :: Creature -> SPic -> SPic
+translateToLeftWrist cr = overPosSP 
+    (\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
+
+leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)

 leftLegPQ :: Creature -> Point3Q
 leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -114,25 +136,25 @@ translateToRightLeg :: Creature -> SPic -> SPic
 translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))

 translateToHead :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToHead m cr = overPosSP (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID)))
+translateToHead m cr = overPosSP (\p -> fst (headPQ cr `Q.comp` (p,Q.qID)))

-headPQ :: IM.IntMap Item -> Creature -> Point3Q
-headPQ m cr
-    | twists m cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
-    | oneH m cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
+headPQ :: Creature -> Point3Q
+headPQ cr
+    | twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
+    | oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
    | otherwise = (V3 2.5 0 20, Q.qID)

 translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
-translatePointToHead m cr p = fst (headPQ m cr `Q.comp` (p,Q.qID))
+translatePointToHead m cr p = fst (headPQ cr `Q.comp` (p,Q.qID))

-chestPQ :: IM.IntMap Item -> Creature -> Point3Q
-chestPQ m cr = backPQ m cr `Q.comp` (0,Q.qz pi)
+chestPQ :: Creature -> Point3Q
+chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)

 translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToChest m cr = overPosSP (\p -> fst $ chestPQ m cr `Q.comp` (p,Q.qID))
+translateToChest m cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))

-backPQ :: IM.IntMap Item -> Creature -> Point3Q
-backPQ m cr
-    | oneH m cr = (V3 0 0 10, Q.qz 0.5)
-    | twists m cr = (V3 0 3 10, Q.qz (-1.5))
+backPQ :: Creature -> Point3Q
+backPQ cr
+    | oneH cr = (V3 0 0 10, Q.qz 0.5)
+    | twists cr = (V3 0 3 10, Q.qz (-1.5))
    | otherwise = (V3 0 0 10, Q.qz 0)
@@ -72,7 +72,7 @@ arms :: IM.IntMap Item -> Creature -> Shape
 {-# INLINE arms #-}
 arms m cr =
    (^. _1) $
-        translateToRightHand m cr aHand
+        translateToRightHand cr aHand
            <> translateToLeftHand m cr aHand
  where
    aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
@@ -91,16 +91,16 @@ deadRot cr = overPosSH (Q.rotateToZ d)

 scalp :: IM.IntMap Item -> Creature -> Shape
 {-# INLINE scalp #-}
-scalp m cr = overPosSH (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID))) fhead
+scalp m cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
 --    | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
 --    | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
 --    | otherwise = translateSHxy 2.5 0 fhead
  where
    fhead = colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5

-torso :: IM.IntMap Item -> Creature -> Shape
+torso :: Creature -> Shape
 {-# INLINE torso #-}
-torso m cr = overPosSH (\p -> fst (backPQ m cr `Q.comp` (p,Q.qID))) tsh
+torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
 --    | oneH cr = rotateSH 0.5 tsh
 --    | twists cr =
 --        translateSHxy 0 3 . rotateSH (-1.3) $ tsh
@@ -126,7 +126,7 @@ baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI

 upperBody :: IM.IntMap Item -> Creature -> Shape
 {-# INLINE upperBody #-}
-upperBody m cr = arms m cr <> shoulderSH (torso m cr)
+upperBody m cr = arms m cr <> shoulderSH (torso cr)

 shoulderSH :: Shape -> Shape
 shoulderSH = translateSHz 20
@@ -92,24 +92,17 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
 --crCanShoot :: Creature -> Bool
 --crCanShoot cr = crIsAiming cr && crWeaponReady cr

-crInAimStance :: AimStance -> IM.IntMap Item -> Creature -> Bool
-crInAimStance as m cr = crIsAiming cr && mitstance == Just as
-  where
-    mitstance = do
-        i <- cr ^? crManipulation . manObject . imRootSelectedItem
-        --itm <- invRootTrees' (cr ^. crInv) ^? ix i
-        itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix (_unNInt i)
-        return $ itemAimStance itm
-        --cr ^? crInv . ix i . itUse . heldAim . aimStance
+crInAimStance :: AimStance -> Creature -> Bool
+crInAimStance as cr = cr ^? crStance . posture . aimStance == Just as

-oneH :: IM.IntMap Item -> Creature -> Bool
+oneH :: Creature -> Bool
 oneH = crInAimStance OneHand

-twoFlat :: IM.IntMap Item -> Creature -> Bool
+twoFlat :: Creature -> Bool
 twoFlat = crInAimStance TwoHandFlat

-twists :: IM.IntMap Item -> Creature -> Bool
-twists m cr = crInAimStance TwoHandUnder m cr || crInAimStance TwoHandOver m cr
+twists :: Creature -> Bool
+twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr

 -- the use of crOldPos is because the damage position is calculated on the
 -- previous frame
@@ -124,11 +117,10 @@ crIsArmouredFrom m p cr = fromMaybe False $ do
            && angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi / 2
  where
    -- even though angleVV can generate NaN, the comparison seems to deal with it
-
    frontarmdirection
-        | crInAimStance OneHand m cr = 0.5
-        | crInAimStance TwoHandUnder m cr = negate 1
-        | crInAimStance TwoHandOver m cr = negate 1
+        | crInAimStance OneHand cr = 0.5
+        | crInAimStance TwoHandUnder cr = negate 1
+        | crInAimStance TwoHandOver cr = negate 1
        | otherwise = 0

 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool
@@ -54,9 +54,9 @@ setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
    invid = _ilInvID (_itLocation itm)
    handtrans = case cr ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
-        Just OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
-        _ -> translatePointToRightHand m
+        Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
+        _ -> translatePointToRightHand
    g
-        | twists m cr = (+.+.+ V3 (-5) 10 0)
+        | twists cr = (+.+.+ V3 (-5) 10 0)
        | otherwise = id
    f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
@@ -39,10 +39,10 @@ setWristShieldPos itm cr x w = moveWallIDUnsafe i wlline w
    i = _itParamID $ _itParams itm
    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
    handtrans = case x of
-        OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
-        _ -> translatePointToRightHand m
+        OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
+        _ -> translatePointToRightHand
    g
-        | twists m cr = (+.+.+ V3 (-5) 10 0)
+        | twists cr = (+.+.+ V3 (-5) 10 0)
        | otherwise = id
    f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr

@@ -40,13 +40,13 @@ equipAttachPos = \case

 equipPosition :: EquipSite -> IM.IntMap Item -> Creature -> Point3 -> SPic -> SPic
 equipPosition epos m cr p sh = case epos of
-    OnLeftWrist -> translateToLeftWrist m cr sh
-    OnRightWrist -> translateToRightWrist m cr sh
+    OnLeftWrist -> translateToLeftWrist cr sh
+    OnRightWrist -> translateToRightWrist cr sh
    OnLegs ->
        translateToLeftLeg cr sh
            <> translateToRightLeg cr sh-- (mirrorSPxz sh)
    OnHead -> translateToHead m cr sh
    OnChest -> translateToChest m cr sh
    --OnBack -> translateToBack cr p sh
-    OnBack -> overPosSP (\x -> fst $ backPQ m cr `Q.comp` (p + x,Q.qID)) sh
+    OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID)) sh
 --    OnSpecial -> sh