Files
loop/src/Dodge/Creature/HandPos.hs
T

129 lines
4.0 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.HandPos (
equipSitePQ,
translatePointToLeftHand,
translatePointToRightHand,
translateToLeftLeg,
translateToRightLeg,
translateToLeftHand,
translateToRightHand,
backPQ,
headPQ,
translateToES,
rightHandPQ,
) where
import Control.Lens
import Dodge.Creature.Test
import Dodge.Data.Creature
import Dodge.Data.Equipment.Misc
import Geometry
import qualified Quaternion as Q
import ShapePicture
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
OnLeftLeg -> legPQ LeftForward
OnRightLeg -> legPQ RightForward
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p, Q.qID))
handWalkingPos :: FootForward -> Float -> Creature -> Point3
handWalkingPos b off cr = case cr ^. crStance . carriage of
Walking sa ff ->
let slen = cr ^. crStance . strideLength
f i
| ff == b = 8 * (slen - i) / slen
| otherwise = 8 * i / slen
in V3 (f sa) off 12
Falling sa ff ->
let slen = cr ^. crStance . strideLength
f i
| ff == b = 8 * (slen - i) / slen
| otherwise = 8 * i / slen
in V3 (f sa) off 20
Floating -> V3 0 off 12
Flying -> V3 0 off 12
Boosting _ -> V3 0 off 12
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) 12, Q.qID)
| otherwise = (handWalkingPos LeftForward (-8) cr, Q.qID)
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = overPosSP . translatePointToRightHand
rightWristPQ :: Creature -> Point3Q
rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qID)
leftHandPQ :: Creature -> Point3Q
leftHandPQ cr
| oneH cr = (V3 0 8 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 12, Q.qID)
| otherwise = (handWalkingPos RightForward 8 cr, Q.qID)
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p, Q.qID))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
leftWristPQ :: Creature -> Point3Q
leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)
translateToLeftLeg :: Creature -> SPic -> SPic
translateToLeftLeg cr = overPosSP (\p -> fst (legPQ LeftForward cr `Q.comp` (p, Q.qID)))
legPQ :: FootForward -> Creature -> Point3Q
legPQ ff = case ff of
LeftForward -> legPQ' id
RightForward -> legPQ' negate
legPQ' :: (Float -> Float) -> Creature -> Point3Q
legPQ' g cr =
Q.comp
(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
_ -> 0
off = -5
sLen = _strideLength $ _crStance cr
f i = g 8 * (sLen - i) / sLen
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (legPQ RightForward 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))
| otherwise = (V3 2.5 0 20, Q.qID)
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0, Q.qz pi)
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)