Add code for determining item orientation

src/Dodge/Item/HeldOffset.hs

@@ -5,8 +5,13 @@ module Dodge.Item.HeldOffset (
     heldItemOffset,
     heldItemRelativeOrient,
     heldItemOrient2D,
+    itemRelativeOrient,
 ) where
 
+import Dodge.Item.Orientation
+import Dodge.DoubleTree
+import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
 import Dodge.Creature.Radius
 import Dodge.Data.AimStance
 import Dodge.Item.AimStance
@@ -135,3 +140,9 @@ heldHandlePos = \case
     KEYCARD {} -> V2 3 0
     BLINKER -> V2 3 0
     BLINKERUNSAFE -> V2 3 0
+
+itemRelativeOrient :: LocationLDT ItemLink Item -> Creature
+    -> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float)
+itemRelativeOrient loc cr 
+    = heldItemRelativeOrient (locToTop loc ^. locLDT . ldtValue) cr 
+        . orientLocation (V3 0 0 0,Q.qID) loc

src/Dodge/Item/Orientation.hs

@@ -3,6 +3,7 @@
 module Dodge.Item.Orientation (
     orientAttachment,
     orientLocation,
+    propagateOrientation,
 ) where
 
 import Dodge.Data.ComposedItem
@@ -37,9 +38,10 @@ orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of
     (t1, q1) = orientByLink par lnk
     (t2, q2) = orientChild ch
 
-orientLocation' :: (Point3,Q.Quaternion Float) 
-    -> LocationLDT ItemLink Item 
-    -> (Point3, Q.Quaternion Float)
+orientLocation' ::
+    (Point3, Q.Quaternion Float) ->
+    LocationLDT ItemLink Item ->
+    (Point3, Q.Quaternion Float)
 orientLocation' x = \case
     (LocLDT TopLDT _) -> x
     (LocLDT c t) -> (p + Q.rotate q p1, q * q1)
@@ -47,10 +49,27 @@ orientLocation' x = \case
         (p, q) = orientLocation' x (LocLDT (_cldtUp c) (singleLDT (_cldtParent c)))
         (p1, q1) = orientAttachment (_cldtParent c) (_cldtLink c) (_ldtValue t)
 
-orientLocation :: 
-     (Point3, Q.Quaternion Float) ->
-        LocationLDT ItemLink Item 
-    -> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float)
+orientLocation ::
+    (Point3, Q.Quaternion Float) ->
+    LocationLDT ItemLink Item ->
+    (Point3, Q.Quaternion Float) ->
+    (Point3, Q.Quaternion Float)
 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 = ldtStartPropagate g f
+  where
+    g (x,y) = (x,y,(V3 0 0 0,Q.qID))
+    f (x,_,(p,q)) i (y,y1) = let (p1,q1) = orientAttachment x i y
+        in (y,y1,(p + Q.rotate q p1, q * q1))
+
+--propagateOrientation' :: LDTree ItemLink Item 
+--    -> LDTree ItemLink (Item, (Point3, Q.Quaternion Float))
+--propagateOrientation' = ldtStartPropagate g f
+--  where
+--    g x = (x,(V3 0 0 0,Q.qID))
+--    f (x,(p,q)) i y = let (p1,q1) = orientAttachment x i y
+--        in (y,(p + Q.rotate q p1, q * q1))