Use function on location to determine laser orientation

src/Dodge/Item/Orientation.hs

@@ -1,7 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Item.Orientation (
     orientAttachment,
+    orientLocation,
 ) where
 
+import Dodge.DoubleTree
+import Dodge.Data.DoubleTree
 import Dodge.Data.ComposedItem
 import Dodge.Data.Item
 import Geometry.Data
@@ -11,6 +15,7 @@ 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)
+    ATTACH UNDERBARRELSLOT -> (V3 10 (-8) 0, Q.qID)
     _ -> (0, Q.qID)
 
 orientByLink :: Item -> ItemLink -> (Point3, Q.Quaternion Float)
@@ -22,9 +27,18 @@ 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))
     _ -> (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)
+    (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)