Major item refactor, still broken

This commit is contained in:
2025-08-24 19:34:09 +01:00
parent 22b4be440a
commit 94f6d5c630
62 changed files with 820 additions and 805 deletions
+51 -40
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.HandPos (
translatePointToLeftHand,
translatePointToRightHand,
@@ -14,6 +15,8 @@ module Dodge.Creature.HandPos (
headPQ,
) where
import Dodge.Data.Equipment.Misc
import qualified Data.IntMap.Strict as IM
import qualified Quaternion as Q
import Control.Lens
import Dodge.Creature.Test
@@ -21,14 +24,22 @@ import Dodge.Data.Creature
import Geometry
import ShapePicture
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p,Q.qID))
translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToRightHand m cr p = fst (rightHandPQ m cr `Q.comp` (p,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)
equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
equipSitePQ = \case
OnRightWrist -> rightHandPQ
OnLeftWrist -> leftHandPQ
OnBack -> backPQ
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)
| 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)
@@ -39,18 +50,18 @@ rightHandPQ cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = overPosSP . translatePointToRightHand
translateToRightHand :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToRightHand m = overPosSP . translatePointToRightHand m
translateToRightWrist :: Creature -> SPic -> SPic
translateToRightWrist cr = overPosSP
(\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
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))
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)
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)
| 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)
@@ -61,15 +72,15 @@ leftHandPQ cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
translatePointToLeftHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToLeftHand m cr p = fst (leftHandPQ m cr `Q.comp` (p,Q.qID))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToLeftHand m = overPosSP . translatePointToLeftHand m
translateToLeftWrist :: Creature -> SPic -> SPic
translateToLeftWrist cr = overPosSP
(\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
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))
leftLegPQ :: Creature -> Point3Q
leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -102,26 +113,26 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
translateToHead :: Creature -> SPic -> SPic
translateToHead cr = overPosSP (\p -> fst (headPQ 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)))
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))
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))
| otherwise = (V3 2.5 0 20, Q.qID)
translatePointToHead :: Creature -> Point3 -> Point3
translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToHead m cr p = fst (headPQ m cr `Q.comp` (p,Q.qID))
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
chestPQ :: IM.IntMap Item -> Creature -> Point3Q
chestPQ m cr = backPQ m cr `Q.comp` (0,Q.qz pi)
translateToChest :: Creature -> SPic -> SPic
translateToChest cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToChest m cr = overPosSP (\p -> fst $ chestPQ m cr `Q.comp` (p,Q.qID))
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))
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))
| otherwise = (V3 0 0 10, Q.qz 0)