Hack together correct positioning of grenades from attached items

src/Dodge/Item/Grammar.hs

@@ -1,12 +1,16 @@
 module Dodge.Item.Grammar (
     invLDT,
+    invLDT',
     invAdj,
     invRootMap,
     invRootTrees,
+    invRootTrees',
     baseCI,
     allInvLocs,
+    allInvLocs',
 ) where
 
+import Dodge.Item.Orientation
 import Dodge.ItemUseCondition
 import Dodge.Data.UseCondition
 import Dodge.Item.MagAmmoType
@@ -218,6 +222,9 @@ invLDT =
     joinItemsInList tryAttachItems . IM.elems
         . fmap (singleLDT . baseCI)
 
+invLDT' :: IM.IntMap Item -> [LDTree ItemLink OItem]
+invLDT' = fmap propagateOrientation . invLDT
+
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
 -- consider explicitly reseting the inventory ids (but this probably really
@@ -243,15 +250,42 @@ invAdj = IM.unions . map g . invLDT
             $ itm ^? itLocation . ilInvID
 
 -- returns an intmap with trees for (only!) root items, indexed by inventory position
-invRootTrees :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
-invRootTrees = IM.fromDistinctAscList . reverse . map getid . invLDT
+invRootTrees :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink OItem)
+invRootTrees = fmap propagateOrientation . IM.fromDistinctAscList . reverse . map getid . invLDT
+  where
+    getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
+    getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
+
+invRootTrees' :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
+invRootTrees' = IM.fromDistinctAscList . reverse . map getid . invLDT
   where
     getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
     getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
 
 -- returns an intmap with indents and locations for all items
-allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink CItem)
+allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink OItem)
 allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
+  where
+    f t = cldtPropagateFold h h g 0 t id
+    h x _ _ _ = x + 1
+    g ::
+        Int ->
+        LocationLDT ItemLink OItem ->
+        ( IM.IntMap (Int, LocationLDT ItemLink OItem) ->
+          IM.IntMap (Int, LocationLDT ItemLink OItem)
+        ) ->
+        IM.IntMap (Int, LocationLDT ItemLink OItem) ->
+        IM.IntMap (Int, LocationLDT ItemLink OItem)
+    g x ldt =
+        (.)
+            ( IM.insert
+                (ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
+                (x, ldt)
+            )
+
+-- returns an intmap with indents and locations for all items
+allInvLocs' :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink CItem)
+allInvLocs' inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees' inv)) mempty
   where
     f t = cldtPropagateFold h h g 0 t id
     h x _ _ _ = x + 1

src/Dodge/Item/HeldOffset.hs

@@ -5,6 +5,7 @@ module Dodge.Item.HeldOffset (
     heldItemOffset,
     heldItemRelativeOrient,
     heldItemOrient2D,
+    heldItemOrient2D',
     itemRelativeOrient,
 ) where
 
@@ -36,6 +37,11 @@ heldItemOrient2D itm cr p a = (V2 x y, argV . Q.qToV2 $ q )
   where
     (V3 x y _,q) = heldItemRelativeOrient itm cr (p `v2z` 0, Q.axisAngle (V3 0 0 1) a)
 
+heldItemOrient2D' :: OItem -> Creature -> Point2 -> Float -> (Point2, Float)
+heldItemOrient2D' (itm,_,(p1,q1)) cr p a = (V2 x y, argV . Q.qToV2 $ q )
+  where
+    (V3 x y _,q) = heldItemRelativeOrient itm cr (p1 + Q.rotate q1 (p `v2z` 0), q1 * Q.axisAngle (V3 0 0 1) a)
+
 heldItemRelativeOrient 
     :: Item -> Creature -> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float)
 heldItemRelativeOrient itm cr (p,q)

src/Dodge/Item/Orientation.hs

@@ -18,8 +18,10 @@ orientChild itm = case _itType itm of
     HELD TORCH -> (V3 0 5 0, Q.qID)
     --HELD LASER -> (V3 15 (-5) 0, Q.qID)
     HELD LASER -> (V3 15 (-5) 0, Q.qID)
-    ATTACH UNDERBARRELSLOT -> (V3 10 (-8) 0, Q.qID)
+    ATTACH UNDERBARRELSLOT -> (V3 10 (-8) 0, r)
     _ -> (0, Q.qID)
+  where
+    r = Q.axisAngle (V3 0 0 1) (-pi/4)
 
 orientByLink :: Item -> ItemLink -> (Point3, Q.Quaternion Float)
 orientByLink itm lt = case (_itType itm, lt) of
@@ -58,8 +60,7 @@ orientLocation x loc (p1, q1) = (p + Q.rotate q p1, q * q1)
   where
     (p, q) = orientLocation' x loc
 
-propagateOrientation :: LDTree ItemLink CItem 
-    -> LDTree ItemLink OItem
+propagateOrientation :: LDTree ItemLink CItem -> LDTree ItemLink OItem
 propagateOrientation = ldtStartPropagate g f
   where
     g (x,y) = (x,y,(V3 0 0 0,Q.qID))