Work on refactoring positioning relative to creature body

This commit is contained in:
2025-08-27 12:11:01 +01:00
parent 2e6b7a1b41
commit 9d2a2e6730
8 changed files with 168 additions and 148 deletions
+59 -37
View File
@@ -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)