Files
loop/src/Dodge/Creature/HandPos.hs
T
2023-05-28 15:09:42 +01:00

201 lines
7.5 KiB
Haskell

module Dodge.Creature.HandPos (
aimingWeaponZeroPos,
aimingMuzzlePos,
aimingMuzzleLength,
translatePointToLeftHand,
translatePointToRightHand,
translatePointToHead,
translateToLeftWrist,
translateToRightWrist,
translateToLeftLeg,
translateToRightLeg,
translateToHead,
translateToChest,
translateToBack,
translateToLeftHand,
translateToRightHand,
) where
import Control.Lens
import Data.Maybe
import Dodge.Creature.Test
import Dodge.Data.Creature
import Geometry
import Linear
import ShapePicture
-- the position of a weapon handle
aimingWeaponHandlePos :: Creature -> Item -> Point2
aimingWeaponHandlePos _ it = case it ^? itUse . heldAim . aimStance of
Just TwoHandUnder -> 0
Just TwoHandOver -> V2 (-7) 0
Just OneHand -> V2 10 (-2)
Just TwoHandFlat -> V2 10 0
Nothing -> 0
aimingWeaponZeroPos :: Creature -> Item -> Point2
aimingWeaponZeroPos cr it =
aimingWeaponHandlePos cr it
- fromMaybe 0 (it ^? itUse . heldAim . aimHandlePos)
aimingMuzzlePos :: Creature -> Item -> [Point2]
aimingMuzzlePos cr it = fmap ((+ zp) . _mzPos) (it ^.. itUse . heldAim . aimMuzzles . folded)
where
zp = aimingWeaponZeroPos cr it
aimingMuzzleLength :: Creature -> Item -> Float
aimingMuzzleLength cr it = head (aimingMuzzlePos cr it) ^. _x
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr = translatePointToRightHand' cr . mirrorV3xz
mirrorV3xz :: Point3 -> Point3
mirrorV3xz (V3 x y z) = V3 x (- y) z
translatePointToRightHand' :: Creature -> Point3 -> Point3
translatePointToRightHand' cr
| oneH cr = (+.+.+ V3 11 (-3) 20) . rotate3 0.4 -- . rotate3 (-0.5)-- . scaleSH (V3 1 1.5 1)
| twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 4 (-10) 0)
| twoFlat cr = (+.+.+ V3 4 (-8) 10)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> (+.+.+ V3 (- f sa) (- off) 10)
_ -> (+.+.+ V3 0 (- off) 10)
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = translateToRightHand' -- . mirrorSPxz
translateToRightHand' :: Creature -> SPic -> SPic
translateToRightHand' cr
| oneH cr = shoulderSP . translateSPxy 11 (-3) . rotateSP (-0.5) -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 4 (-10)
| twoFlat cr = waistSP . translateSPxy 4 (-8)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPxy (- f sa) (- off)
_ -> waistSP . translateSPxy 0 (- off)
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToRightWrist :: Creature -> SPic -> SPic
translateToRightWrist = translateToRightWrist' -- . mirrorSPxz
translateToRightWrist' :: Creature -> SPic -> SPic
translateToRightWrist' cr
| oneH cr = shoulderSP . translateSPxy 11 (-3) . rotateSP (-0.5) . offTrans -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 4 (-10) . offTrans
| twoFlat cr = waistSP . translateSPxy 4 (-8) . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPxy (- f sa) (- off) . offTrans
_ -> waistSP . translateSPxy 0 (- off) . offTrans
where
offTrans = translateSP (V3 0 4 (-4))
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr
| oneH cr = (+.+.+ V3 0 0 10) . rotate3 0.4 . (+.+.+ V3 0 off 0)
| twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 12 4 0) . rotate3 0.4
| twoFlat cr = (+.+.+ V3 4 8 10)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> (+.+.+ V3 (- f sa) off 10)
_ -> (+.+.+ V3 0 off 10)
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand cr
| oneH cr = waistSP . rotateSP 0.4 . translateSPxy 0 off
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 12 4
| twoFlat cr = waistSP . translateSPxy 4 8
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPxy (- f sa) off
_ -> waistSP . translateSPxy 0 off
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToLeftWrist :: Creature -> SPic -> SPic
translateToLeftWrist cr
| oneH cr = waistSP . rotateSP 0.4 . translateSPxy 0 off . offTrans
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 12 4 . offTrans
| twoFlat cr = waistSP . translateSPxy 4 8 . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPxy (- f sa) off . offTrans
_ -> waistSP . translateSPxy 0 off . offTrans
where
offTrans = translateSP (V3 0 4 (-4))
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToLeftLeg :: Creature -> SPic -> SPic
translateToLeftLeg cr =
rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPxy (f sa) off
Just (Walking sa RightForward) -> translateSPxy (- f sa) off
_ -> translateSPxy 0 off
where
off = 5
sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr =
rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPxy (- f sa) (- off)
Just (Walking sa RightForward) -> translateSPxy (f sa) (- off)
_ -> translateSPxy 0 (- off)
where
off = 5
sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToHead :: Creature -> SPic -> SPic
translateToHead cr
| twists cr =
translateSPz 20 . translateSPxy 0 5 . rotateSP (-1) . translateSPxy (negate 2.5) 0.25
. rotateSP 1
| oneH cr =
translateSPz 20 . rotateSP 0.5 . translateSPxy 2.5 0
. rotateSP (negate 0.5)
| otherwise = translateSPz 20 . translateSPxy 2.5 0
translatePointToHead :: Creature -> Point3 -> Point3
translatePointToHead cr
| twists cr =
(+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 (negate 2.5) 0.25 0)
. rotate3 1
| oneH cr =
(+.+.+ V3 0 0 20) . rotate3 0.5 . (+.+.+ V3 2.5 0 0)
. rotate3 (negate 0.5)
| otherwise = (+.+.+ V3 2.5 0 20)
translateToChest :: Creature -> SPic -> SPic
translateToChest cr
| oneH cr = rotateSP 0.5
-- | twists cr = translateSPxy 0 5 . rotateSP (-1)
| twists cr = rotateSP (-1)
| otherwise = id
translateToBack :: Creature -> Point3 -> SPic -> SPic
translateToBack cr p
| oneH cr = rotateSP 0.5 . translateSP p
| twists cr = rotateSP (-1.5) . translateSP (p - V3 5 0 0)
| otherwise = translateSP p
shoulderSP :: SPic -> SPic
shoulderSP = translateSPz 20
waistSP :: SPic -> SPic
waistSP = translateSPz 10