Start simplifying creature body parts/attachment positioning

src/Dodge/Creature/HandPos.hs

@@ -9,11 +9,14 @@ module Dodge.Creature.HandPos (
     translateToRightLeg,
     translateToHead,
     translateToChest,
-    translateToBack,
+--    translateToBack,
     translateToLeftHand,
     translateToRightHand,
+    backPQ,
+    headPQ,
 ) where
 
+import qualified Quaternion as Q
 import Control.Lens
 import Dodge.Creature.Test
 import Dodge.Data.Creature
@@ -21,96 +24,141 @@ import Geometry
 import ShapePicture
 
 translatePointToRightHand :: Creature -> Point3 -> Point3
-translatePointToRightHand cr = translatePointToRightHand' cr . mirrorV3xz
+translatePointToRightHand cr p =  fst (rightHandPQ cr `Q.comp` (p,Q.qID))
+    --translatePointToRightHand' cr . mirrorV3xz
 
-mirrorV3xz :: Point3 -> Point3
-mirrorV3xz (V3 x y z) = V3 x (- y) z
+--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)
+--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 * (sLen - i) / sLen
+
+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)
-        _ -> (+.+.+ V3 0 (- off) 10)
+        Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
+        Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
+        _ -> (V3 0 (- off) 10, Q.qID)
   where
     off = 8
     sLen = _strideLength $ _crStance cr
-    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
+    f i = negate 2 + negate 6 * (sLen - i) / sLen
+    g i = negate 2 + negate 6 * (i) / 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
+translateToRightHand = overPosSP . translatePointToRightHand
+--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)
+--        Just (Walking sa RightForward) -> waistSP . translateSPxy (- g sa) (- off)
+--        _ -> waistSP . translateSPxy 0 (- off)
+--  where
+--    off = 8
+--    sLen = _strideLength $ _crStance cr
+--    f i = negate 2 + negate 6 * (sLen - i) / sLen
+--    g i = negate 2 + negate 6 * (i) / sLen
 
 translateToRightWrist :: Creature -> SPic -> SPic
-translateToRightWrist = translateToRightWrist' -- . mirrorSPxz
+translateToRightWrist cr =  overPosSP
+    (\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
+--    --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
+--        Just (Walking sa RightForward) -> waistSP . translateSPxy (- g 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 * (sLen - i) / sLen
+--    g i = negate 2 + negate 6 * (i) / sLen
 
-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
+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 LeftForward) -> waistSP . translateSPxy (- f sa) (- off) . offTrans
-        _ -> waistSP . translateSPxy 0 (- off) . offTrans
+        Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
+        Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
+        _ -> (V3 0 off 10, Q.qID)
   where
-    offTrans = translateSP (V3 0 4 (-4))
     off = 8
     sLen = _strideLength $ _crStance cr
-    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
+    f i = negate 2 + negate 6 * (sLen - i) / sLen
+    g i = negate 2 + negate 6 * ( i) / 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
+translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
+--    | 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 * (sLen - i) / 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
+translateToLeftHand = overPosSP . translatePointToLeftHand
+--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
+--        Just (Walking sa LeftForward) -> waistSP . translateSPxy (- g sa) off
+--        _ -> waistSP . translateSPxy 0 off
+--  where
+--    off = 8
+--    sLen = _strideLength $ _crStance cr
+--    f i = negate 2 + negate 6 * (sLen - i) / sLen
+--    g i = negate 2 + negate 6 * (i) / 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
+translateToLeftWrist cr = overPosSP 
+    (\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
+--    | 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
+--        Just (Walking sa LeftForward) -> waistSP . translateSPxy (- g 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 * (sLen - i) / sLen
+--    g i = negate 2 + negate 6 * (i) / sLen
 
 translateToLeftLeg :: Creature -> SPic -> SPic
 translateToLeftLeg cr =
@@ -121,7 +169,7 @@ translateToLeftLeg cr =
   where
     off = 5
     sLen = _strideLength $ _crStance cr
-    f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
+    f i = 8 * (sLen - i) / sLen
 
 translateToRightLeg :: Creature -> SPic -> SPic
 translateToRightLeg cr =
@@ -132,27 +180,33 @@ translateToRightLeg cr =
   where
     off = 5
     sLen = _strideLength $ _crStance cr
-    f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
+    f i = 8 * (sLen - i) / 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
+translateToHead cr = overPosSP (\p -> fst $ (headPQ cr `Q.comp` (p,Q.qID)))
+--    | 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
+
+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 :: 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)
+translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
+--    | 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
@@ -161,14 +215,20 @@ translateToChest cr
     | 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
+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)
 
-shoulderSP :: SPic -> SPic
-shoulderSP = translateSPz 20
+--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
 
-waistSP :: SPic -> SPic
-waistSP = translateSPz 10
+--shoulderSP :: SPic -> SPic
+--shoulderSP = translateSPz 20
+--
+--waistSP :: SPic -> SPic
+--waistSP = translateSPz 10

src/Dodge/Creature/Impulse/Movement.hs

@@ -46,7 +46,7 @@ advanceStepCounter speed = crStance . carriage %~ f
   where
     f car = case car of
         Standing -> f (Walking 0 RightForward)
-        Walking i ff -> Walking (i + ceiling speed) ff
+        Walking i ff -> Walking (i + speed) ff
         _ -> car
 
 creatureTurnTo :: Point2 -> Creature -> Creature

src/Dodge/Creature/Picture.hs

@@ -9,11 +9,11 @@ module Dodge.Creature.Picture (
     deadFeet,
 ) where
 
+import Dodge.Creature.HandPos
 import Control.Lens
-import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
 import Dodge.Creature.Radius
 import Dodge.Creature.Shape
-import Dodge.Creature.Test
+--import Dodge.Creature.Test
 import Dodge.Damage
 import Dodge.Data.Creature
 import Dodge.Item.Draw
@@ -37,7 +37,7 @@ basicCrShape cr
     | otherwise =
         scaleSH (V3 crsize crsize crsize) $
             mconcat
-                [ colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
+                [ colorSH (_skinHead cskin) $ scalp cr
                 , colorSH (_skinUpper cskin) $ upperBody cr
                 , rotmdir $ colorSH (_skinLower cskin) $ feet cr
                 ]
@@ -60,7 +60,8 @@ feet cr = case cr ^? crStance . carriage of
     aFoot = upperPrismPolyST 10 $ polyCirc 3 4
     off = 5
     sLen = _strideLength $ _crStance cr
-    f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
+    --f i = 6 * (sLen - i) / sLen
+    f i = 8 * (sLen - 2*i) / sLen
 
 deadFeet :: Creature -> Shape
 {-# INLINE deadFeet #-}
@@ -89,34 +90,30 @@ deadRot cr = overPosSH (Q.rotateToZ d)
 
 scalp :: Creature -> Shape
 {-# INLINE scalp #-}
-scalp cr
-    | 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
+scalp 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 :: Creature -> Shape
 {-# INLINE torso #-}
-torso cr
-    | oneH cr =
-        rotateSH 0.5 $
-            mconcat
-                [ translateSHxy 0 3 . rotateSH (negate 0.2) $ aShoulder
-                , translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
-                ]
-    | twists cr =
-        translateSHxy 0 5 . rotateSH (-1) $
-            mconcat
-                [ rotateSH (negate 0.2) . translateSHxy 2 3 . rotateSH (negate 0.4) $ aShoulder
-                , rotateSH (negate 0.2) . translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
-                ]
-    | otherwise =
+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
+----            mconcat
+----                [ rotateSH (negate 0.2) . translateSHxy 2 3 . rotateSH (negate 0.4) $ aShoulder
+----                , rotateSH (negate 0.2) . translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
+----                ]
+--    | otherwise = tsh
+  where
+    tsh = 
         mconcat
             [ translateSHxy 0 3 . rotateSH (negate 0.2) $ aShoulder
             , translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
             ]
-  where
     aShoulder = scaleSH (V3 10 10 1) baseShoulder
 
 deadUpperBody :: Creature -> Shape
@@ -124,7 +121,7 @@ deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}
-baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
+baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
 
 upperBody :: Creature -> Shape
 {-# INLINE upperBody #-}