Add visuals for wrist equipment

src/Dodge/Creature/HandPos.hs

@@ -1,6 +1,10 @@
 module Dodge.Creature.HandPos where
 import Dodge.Data
---import Geometry
+import Dodge.Creature.Test
+import Shape
+import ShapePicture
+import Geometry
+
 import Control.Lens
 import Data.Maybe
 
@@ -18,3 +22,47 @@ aimingWeaponZeroPos cr it = aimingWeaponHandlePos cr it
 aimingMuzzlePos :: Creature -> Item -> Float
 aimingMuzzlePos cr it = aimingWeaponZeroPos cr it 
     + fromMaybe 0 (it ^? itDimension . dimPortage . muzPos)
+
+translateToRightHand :: Creature -> SPic -> SPic
+translateToRightHand cr
+    | oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5)-- . scaleSH (V3 1 1.5 1)
+    | twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10)
+    | twoFlat cr = waistSP . translateSPf 4 (-8)
+    | otherwise = case cr ^? crStance . carriage of
+        Just (Walking sa LeftForward)  -> waistSP . translateSPf (-f sa) (-off)
+        _ -> waistSP . translateSPf 0 (-off)
+  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 . translateSPf 0 off
+    | twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4
+    | twoFlat cr = waistSP . translateSPf 4 8
+    | otherwise = case cr ^? crStance . carriage of
+        Just (Walking sa RightForward)  -> waistSP . translateSPf (-f sa) off
+        _ -> waistSP . translateSPf 0 off
+  where
+    off = 8
+    sLen = _strideLength $ _crStance cr
+    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
+
+oneH :: Creature -> Bool
+oneH = crInStance OneHand
+
+twoFlat :: Creature -> Bool
+twoFlat = crInStance TwoHandFlat
+
+twists :: Creature -> Bool
+twists = crInStance TwoHandTwist
+
+shoulderSP :: SPic -> SPic
+shoulderSP = translateSPz 20
+waistSP :: SPic -> SPic
+waistSP = translateSPz 10
+
+crInStance :: AimStance -> Creature -> Bool
+crInStance as cr = crIsAiming' cr -- || (_posture (_crStance cr) == Reloading && hasAmmo cr)
+    && cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance == Just as

src/Dodge/Creature/Picture.hs

@@ -18,6 +18,7 @@ import Dodge.Creature.Test
 --import Dodge.Creature.AlertLevel.Data
 --import Dodge.Picture.Layer
 import Dodge.Clock
+import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
 --import Dodge.Debug.Picture
 import Picture
 import Geometry
@@ -166,21 +167,23 @@ feet cr = case cr ^? crStance . carriage of
 
 arms :: Creature -> Shape
 {-# INLINE arms #-}
-arms cr 
+arms cr = fst $ translateToRightHand cr aHand
-    | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
+    <> translateToLeftHand cr aHand
-    | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat 
+--arms cr 
-        [ translateSHf 12 4    aHand
+--    | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
-        , translateSHf 4 (-10) aHand
+--    | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat 
-        ]
+--        [ translateSHf 12 4    aHand
-    | twoFlat cr = waistSH $ translateSHf 4 8 aHand
+--        , translateSHf 4 (-10) aHand
-        <> translateSHf 4 (-8) aHand
+--        ]
-    | otherwise = case cr ^? crStance . carriage of
+--    | twoFlat cr = waistSH $ translateSHf 4 8 aHand
-        Just (Walking sa LeftForward)  -> waistSH $ translateSHf (-f sa) (-off) aHand
+--        <> translateSHf 4 (-8) aHand
-        Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off    aHand
+--    | otherwise = case cr ^? crStance . carriage of
-        _ -> emptySH 
+--        Just (Walking sa LeftForward)  -> waistSH $ translateSHf (-f sa) (-off) aHand
+--        Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off    aHand
+--        _ -> emptySH 
   where
-    aHand :: Shape
+    aHand :: SPic
-    aHand = translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
+    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
@@ -237,6 +240,7 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10
 
 upperBody :: Color -> Creature -> Shape
 {-# INLINE upperBody #-}
+--upperBody col cr = colorSH (light4 col) $ mconcat
 upperBody col cr = colorSH (light4 col) $ mconcat
     [ arms cr
     , shoulderSH $ torso cr

src/Dodge/Data.hs

@@ -377,7 +377,6 @@ data ItemUse
         { _lUse         :: Creature -> Int -> World -> World 
         , _useDelay     :: UseDelay
         , _useHammer    :: HammerType
-        , _eqSite       :: EquipSite
         }
     | ConsumeUse 
         { _cUse :: Item -> Creature -> World -> World

src/Dodge/Default/Weapon.hs

@@ -65,7 +65,6 @@ defaultlUse = LeftUse
     { _lUse = \_ _ -> id
     , _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
     , _useHammer  = NoHammer
-    , _eqSite = GoesOnWrist
     }
 
 luseInstantNoH :: (Creature -> Int -> World -> World) -> ItemUse
@@ -73,7 +72,6 @@ luseInstantNoH f = LeftUse
     { _lUse = f
     , _useDelay = NoDelay
     , _useHammer  = NoHammer
-    , _eqSite = GoesOnWrist
     }
 defaultAimParams :: AimParams
 defaultAimParams = AimParams

src/Dodge/Item/Equipment.hs

@@ -5,6 +5,7 @@ import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Default
 import Dodge.Default.Wall
 import Dodge.Creature.Test
+import Dodge.Creature.HandPos
 import Dodge.Wall
 import Dodge.Magnet
 import Picture
@@ -66,9 +67,15 @@ frontArmour = defaultEquipment
     , _itID = Nothing
     }
 pictureOnEquip :: SPic -> Creature -> Item -> SPic
-pictureOnEquip sp cr itm = case _itInvPos itm of
+pictureOnEquip sp cr itm = fromMaybe mempty $ do
-    Just i | isJust (cr ^? crInvEquipped . ix i) -> sp
+    i <- _itInvPos itm
-    _ -> mempty
+    epos <- cr^? crInvEquipped . ix i
+    return $ equipPosition epos cr sp
+equipPosition :: EquipPosition -> Creature -> SPic -> SPic
+equipPosition epos cr sh = case epos of
+    OnLeftWrist -> translateToLeftHand cr sh
+    OnRightWrist -> translateToRightHand cr $ mirrorSPxz sh
+    _ -> sh
 
 flatShield :: Item
 flatShield = defaultEquipment

src/Dodge/Item/Weapon/Radar.hs

@@ -3,6 +3,7 @@ import Dodge.Data
 --import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.Item.Draw
+import Dodge.Item.Equipment
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
@@ -12,6 +13,7 @@ import Dodge.Default.Weapon
 import Geometry
 import Picture
 import Shape
+import ShapePicture
 
 import Control.Lens
 
@@ -68,7 +70,11 @@ autoRadar :: Item
 autoRadar = defaultEquipment
     { _itType = RADAR
     , _itName = "AUTORADAR"
-    , _itEquipPict = \_ _ -> (,) emptySH blank
+    , _itEquipPict = pictureOnEquip $ noPic (colorSH yellow $ translateSH (V3 0 4 (-4)) $ upperPrismPoly 3 
+            $ rectWH 2 2)
     , _itEffect = autoRadarEffect
     , _itID = Nothing
     } & itUse . eqSite .~ GoesOnWrist
+
+shapeForWrist :: Shape -> Creature -> Item -> SPic
+shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))

src/Picture.hs

@@ -39,6 +39,8 @@ module Picture
     , setDepth
     , addDepth
     , setLayer
+    , mirroryz
+    , mirrorxz
     )
   where
 import Geometry
@@ -358,3 +360,13 @@ charToTuple x c =
     ]
   where 
     offset = fromIntegral (fromEnum c) - 32
+
+mirrorxz :: Picture -> Picture
+mirrorxz = map (overPos flipy)
+  where
+    flipy (V3 x y z) = V3 x (negate y) z
+
+mirroryz :: Picture -> Picture
+mirroryz = map (overPos flipx)
+  where
+    flipx (V3 x y z) = V3 (negate x) y z

src/ShapePicture.hs

@@ -9,6 +9,8 @@ module ShapePicture
     , noShape
     , _spShape
     , _spPicture
+    , mirrorSPyz
+    , mirrorSPxz
     ) where
 import Shape
 import Picture
@@ -41,3 +43,13 @@ translateSPz z  = bimap (translateSH (V3 0 0 z)) (translate3 (V3 0 0 z))
 
 rotateSP :: Float -> SPic -> SPic
 rotateSP a = bimap (rotateSH a) (rotate a)
+
+mirrorSPxz :: SPic -> SPic
+mirrorSPxz = bimap (reverse . overPosSH flipy) (mirrorxz)
+  where
+    flipy (V3 x y z) = V3 x (negate y) z
+
+mirrorSPyz :: SPic -> SPic
+mirrorSPyz = bimap (reverse . overPosSH flipx) (mirroryz)
+  where
+    flipx (V3 x y z) = V3 (negate x) y z