Hack together general held item orientation

src/Dodge/Creature.hs

@@ -310,7 +310,16 @@ testInventory =
 
 stackedInventory :: [Item]
 stackedInventory =
-    [ torch
+    [ laser
+    , megaBattery
+    , burstRifle
+    , megaTinMag 1000
+    , underBarrelSlot
+    , laser
+    , megaBattery
+    , gLauncher
+    , megaShellMag
+    , torch
     , magShield MagnetRepulse
     , bangCone
     , megaTinMag 1000
@@ -319,11 +328,6 @@ stackedInventory =
     , makeTypeCraft TRANSFORMER
     , remoteScreen
     , megaShellMag
-    , burstRifle
-    , megaTinMag 1000
-    , underBarrelSlot
-    , gLauncher
-    , megaShellMag
     , laser
     , makeTypeCraft TRANSFORMER
     , teslaGun

src/Dodge/Creature/State.hs

@@ -311,7 +311,7 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) w =
     case (ci ^. _1 . itType, ci ^. _2) of
         (HELD TORCH, _) -> shineTorch cr itmtree m w
         --(HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m w
-        (HELD LASER, WeaponTargetingSF) -> shineTargetLaser' cr loc w
+        (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr loc w
         (TARGETING tt, _) -> updateItemTargeting tt cr itm w
         (ARHUD, _) -> drawARHUD loc w
         _ -> w
@@ -327,12 +327,8 @@ drawARHUD (LocLDT con _) w = fromMaybe w $ do
             <>~ fold
                 (drawTargetingAR itm w <|> drawMapperAR itm w)
 
-shineTargetLaser' ::
-    Creature ->
-    LocationLDT ItemLink CItem ->
-    World ->
-    World
-shineTargetLaser' cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
+shineTargetLaser :: Creature -> LocationLDT ItemLink CItem -> World -> World
+shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
     guard (crIsAiming cr)
     (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
     i <- mag ^. ldtValue . _1 . itConsumables
@@ -357,11 +353,12 @@ shineTargetLaser' cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $
                     }
   where
     itmtree = loc ^. locLDT
-    (p,q) = orientLocation $ fmap fst loc
+    (p,q) = heldItemRelativeOrient (locToTop loc ^. locLDT . ldtValue . _1) cr 
+        $ orientLocation (V3 0 0 0,Q.qID) (fmap fst loc) (V3 5 0 0,Q.qID)
     x = 1
     isammolink AmmoInLink{} = True
     isammolink _ = False
-    pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
+    pos = _crPos cr + xyV3 (rotate3 cdir p)
     cdir = _crDir cr
     itm = itmtree ^. ldtValue . _1
     pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting

src/Dodge/Data/DoubleTree.hs

@@ -114,7 +114,8 @@ instance Functor (LocationLDT b) where
 instance Functor (ContextLDT b) where
     fmap f = \case
         TopLDT -> TopLDT
-        LeftwardLDT u cl p l cr fr -> LeftwardLDT (fmap f u)
+        LeftwardLDT u cl p l cr fr -> LeftwardLDT 
+            (fmap f u)
             (fmap (fmap (fmap f)) cl)
             (f p)
             l

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