Hack together general held item orientation

src/Dodge/Item/Orientation.hs

@@ -1,19 +1,21 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Dodge.Item.Orientation (
     orientAttachment,
     orientLocation,
 ) where
 
-import Dodge.DoubleTree
-import Dodge.Data.DoubleTree
 import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
 import Dodge.Data.Item
+import Dodge.DoubleTree
 import Geometry.Data
 import qualified Quaternion as Q
 
 orientChild :: Item -> (Point3, Q.Quaternion Float)
 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)
     _ -> (0, Q.qID)
@@ -28,17 +30,27 @@ orientByLink itm lt = case (_itType itm, lt) of
 orientAttachment :: Item -> ItemLink -> Item -> (Point3, Q.Quaternion Float)
 orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of
     (ATTACH UNDERBARRELSLOT, _, _) -> (V3 (-5) (-8) 0, Q.qID)
---    (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2))
---    (HELD LAUNCHER, _, HELD TORCH) -> (V3 0 20 0, Q.axisAngle (V3 0 0 1) (pi/4))
+    --    (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2))
+    --    (HELD LAUNCHER, _, HELD TORCH) -> (V3 0 20 0, Q.axisAngle (V3 0 0 1) (pi/4))
     _ -> (t1 + Q.rotate q1 t2, q1 * q2)
   where
     (t1, q1) = orientByLink par lnk
     (t2, q2) = orientChild ch
 
-orientLocation :: LocationLDT ItemLink Item -> (Point3, Q.Quaternion Float)
-orientLocation = \case
-    (LocLDT TopLDT _) -> (0, Q.qID)
+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)
       where
-        (p,q) = orientLocation (LocLDT (_cldtUp c) (singleLDT (_cldtParent c)))
-        (p1,q1) = orientAttachment (_cldtParent c) (_cldtLink c) (_ldtValue t)
+        (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 x loc (p1, q1) = (p + Q.rotate q p1, q * q1)
+  where
+    (p, q) = orientLocation' x loc