Improve possible manipulation of equipment

src/Dodge/Creature/HandPos.hs

@@ -1,9 +1,9 @@
 module Dodge.Creature.HandPos where
 import Dodge.Data
 import Dodge.Creature.Test
-import Shape
+--import Shape
 import ShapePicture
-import Geometry
+--import Geometry
 
 import Control.Lens
 import Data.Maybe
@@ -65,12 +65,23 @@ translateToRightLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStanc
     Just (Walking sa RightForward) -> translateSPf ( f sa) (-off)
     _ -> translateSPf 0 (-off)
   where
-    aFoot :: Shape
-    aFoot = upperPrismPoly 10 $ polyCirc 3 4
     off = 5
     sLen = _strideLength $ _crStance cr
     f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
+translateToHead :: Creature -> SPic -> SPic
+translateToHead cr
+    | twists cr = translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25 
+    | oneH   cr = translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0 
+    | otherwise = translateSPz 20 . translateSPf 2.5 0 
+
+translateToChest :: Creature -> SPic -> SPic
+translateToChest cr
+    | oneH cr   = rotateSP 0.5
+--    | twists cr = translateSPf 0 5 . rotateSP (-1)
+    | twists cr = rotateSP (-1)
+    | otherwise = id
+
 oneH :: Creature -> Bool
 oneH = crInStance OneHand
 

src/Dodge/Creature/Picture.hs

@@ -184,9 +184,9 @@ arms cr = fst $ translateToRightHand cr aHand
   where
     aHand :: SPic
     aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
-    off = 8
-    sLen = _strideLength $ _crStance cr
-    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
+--    off = 8
+--    sLen = _strideLength $ _crStance cr
+--    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
 scalp :: Creature -> Shape
 {-# INLINE scalp #-}
@@ -209,8 +209,8 @@ crInStance as cr = crIsAiming' cr -- || (_posture (_crStance cr) == Reloading &&
 oneH :: Creature -> Bool
 oneH = crInStance OneHand
 
-twoFlat :: Creature -> Bool
-twoFlat = crInStance TwoHandFlat
+--twoFlat :: Creature -> Bool
+--twoFlat = crInStance TwoHandFlat
 
 twists :: Creature -> Bool
 twists = crInStance TwoHandTwist
@@ -248,8 +248,8 @@ upperBody col cr = colorSH (light4 col) $ mconcat
 
 shoulderSH :: Shape -> Shape
 shoulderSH = translateSHz 20
-waistSH :: Shape -> Shape
-waistSH = translateSHz 10
+--waistSH :: Shape -> Shape
+--waistSH = translateSHz 10
 
 light4 :: Color -> Color
 light4 = light . light . light . light

src/Dodge/Creature/Property.hs

@@ -4,6 +4,7 @@ module Dodge.Creature.Property
     , crNearPoint
     ) where
 import Dodge.Data
+import Dodge.Creature.HandPos
 import Geometry
 
 import Data.Maybe
@@ -13,18 +14,21 @@ import Control.Lens
 -- previous frame
 -- Not sure if it is a good idea
 crIsArmouredFrom :: Point2 -> Creature -> Bool
-crIsArmouredFrom p cr 
-    = p /= _crOldPos cr 
-        -- && any (\it -> it ^? itType == Just FRONTARMOUR) (_crInv cr)
-        && hasFrontArmour cr
-        && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crOldPos cr) < pi/2
--- even though angleVV can generate NaN, the comparison seems to deal with it
+crIsArmouredFrom p cr = hasFrontArmour p cr
 
-hasFrontArmour :: Creature -> Bool
-hasFrontArmour cr = fromMaybe False $ do
+hasFrontArmour :: Point2 -> Creature -> Bool
+hasFrontArmour p cr = fromMaybe False $ do
     invid <- cr ^? crEquipment . ix OnChest
     ittype <- cr ^? crInv . ix invid . itType
     return $ FRONTARMOUR == ittype
+        && p /= _crOldPos cr 
+        && angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi/2
+-- even though angleVV can generate NaN, the comparison seems to deal with it
+  where
+    frontarmdirection
+        | crInStance OneHand cr = 0.5
+        | crInStance TwoHandTwist cr = negate 1
+        | otherwise = 0
 
 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool
 --crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr)