Tweak turrets

src/Dodge/Item/Draw.hs

@@ -6,9 +6,10 @@ module Dodge.Item.Draw (
 ) where
 
 import Control.Lens
+import Data.Maybe
+import Dodge.Creature.HandPos
 import Dodge.Data.Creature
 import Dodge.Item.Draw.SPic
-import Dodge.Item.Equipment.Shape
 import Dodge.Item.HeldOffset
 import ShapePicture
 
@@ -18,3 +19,21 @@ itemEquipPict cr it = case it ^. itUse of
     ituse -> case ituse ^? equipEffect of
         Just _ -> pictureOnEquip (itemSPic it) cr it
         Nothing -> mempty
+
+pictureOnEquip :: SPic -> Creature -> Item -> SPic
+pictureOnEquip sp cr itm = fromMaybe mempty $ do
+    i <- itm ^? itLocation . ipInvID
+    epos <- cr ^? crInvEquipped . ix i
+    return $ equipPosition epos cr sp
+
+equipPosition :: EquipPosition -> Creature -> SPic -> SPic
+equipPosition epos cr sh = case epos of
+    OnLeftWrist -> translateToLeftWrist cr sh
+    OnRightWrist -> translateToRightWrist cr sh
+    OnLegs ->
+        translateToLeftLeg cr sh
+            <> translateToRightLeg cr (mirrorSPxz sh)
+    OnHead -> translateToHead cr sh
+    OnChest -> translateToChest cr sh
+    OnBack -> translateToBack cr sh
+    OnSpecial -> sh

src/Dodge/Item/Equipment/Shape.hs

@@ -1,25 +0,0 @@
-module Dodge.Item.Equipment.Shape where
-
-import Data.Maybe
-import Dodge.Creature.HandPos
-import Dodge.Data.Creature
-import LensHelp
-import ShapePicture
-
-pictureOnEquip :: SPic -> Creature -> Item -> SPic
-pictureOnEquip sp cr itm = fromMaybe mempty $ do
-    i <- itm ^? itLocation . ipInvID
-    epos <- cr ^? crInvEquipped . ix i
-    return $ equipPosition epos cr sp
-
-equipPosition :: EquipPosition -> Creature -> SPic -> SPic
-equipPosition epos cr sh = case epos of
-    OnLeftWrist -> translateToLeftWrist cr sh
-    OnRightWrist -> translateToRightWrist cr sh
-    OnLegs ->
-        translateToLeftLeg cr sh
-            <> translateToRightLeg cr (mirrorSPxz sh)
-    OnHead -> translateToHead cr sh
-    OnChest -> translateToChest cr sh
-    OnBack -> translateToBack cr sh
-    OnSpecial -> sh

src/Dodge/Item/HeldOffset.hs

@@ -3,35 +3,42 @@ module Dodge.Item.HeldOffset where
 import Data.Maybe
 import Dodge.Creature.HandPos
 import Dodge.Data.Creature
+import Dodge.Data.Machine
 import Geometry
 import LensHelp
 
+turretItemOffset :: Item -> Turret -> Machine -> Point3 -> Point3
+turretItemOffset it tu mc =
+    rotate3 (_tuDir tu - _mcDir mc) . (+.+.+ V3 0 0 shoulderHeight)
+        . transToHandle it
+
+transToHandle :: Item -> Point3 -> Point3
+transToHandle itm = fromMaybe id $ do
+    x <- itm ^? itUse . heldAim . aimHandlePos
+    return (-.-.- V3 x 0 0)
+
 heldItemOffset :: Item -> Creature -> Point3 -> Point3
 heldItemOffset itm cr
     | isSelected && _posture (_crStance cr) == Aiming =
-        (+.+.+ V3 (aimingWeaponZeroPos cr itm) 0 shoulderD)
+        (+.+.+ V3 (aimingWeaponZeroPos cr itm) 0 shoulderHeight)
     | isSelected && isTwoHandFlat =
         (+.+.+ V3 (_crRad cr) 0 handD)
             . rotate3 (twoFlatHRot cr)
-            . transToHandle
+            . transToHandle itm
     | isSelected && isOneHand =
         (+.+.+ V3 0 0 handD)
             . (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0)
             . (+.+.+ V3 (-2) 0 0)
-            . transToHandle
+            . transToHandle itm
     | isSelected =
         (+.+.+ V3 0 0 handD)
             . (+.+.+ V3 (_crRad cr) 0 0)
             . rotate3 (strideRot cr + 1.2)
             . (+.+.+ V3 (-5) 0 0)
             --        . (+.+.+ V3 (-5) 0 0)
-            . transToHandle
+            . transToHandle itm
     | otherwise = id
   where
-    transToHandle = fromMaybe id $ do
-        x <- itm ^? itUse . heldAim . aimHandlePos
-        return (-.-.- V3 x 0 0)
-    shoulderD = 18
     handD = 15
     isSelected = _itIsHeld itm
     handPos = case cr ^? crStance . carriage of
@@ -46,6 +53,9 @@ heldItemOffset itm cr
     f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
     sLen = _strideLength $ _crStance cr
 
+shoulderHeight :: Float
+shoulderHeight = 18
+
 strideRot :: Creature -> Float
 strideRot cr = case cr ^? crStance . carriage of
     Just (Walking x LeftForward) -> f x