Allow for assigning attach items orientations

src/Dodge/Item/Grammar.hs

@@ -1,5 +1,5 @@
 module Dodge.Item.Grammar (
-    invLDT,
+    invLDT',
     invTrees,
     invIndentIM,
     invAdj,
@@ -9,7 +9,7 @@ module Dodge.Item.Grammar (
 import qualified Linear.Quaternion as Q
 import Geometry.Data
 import Control.Applicative
---import TreeHelp
+import Data.Bifunctor
 
 import LensHelp
 import qualified Data.IntMap.Strict as IM
@@ -60,6 +60,53 @@ basePartiallyComposedItem itm = case itm ^. itType of
     nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
     isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
 
+basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
+basePartiallyComposedItem' itm = case itm ^. itType of
+    HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest 
+        (map (\(i,a) -> (AmmoMagSF a, ILink (AmmoInLink i a) (c (V3 5 2 0) lhs)))
+            (IM.toList $ itm ^. itUse . heldAmmoTypes))
+        [noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
+        )
+    AMMOMAG _ -> ammoComposedItem' itm
+    TARGETING {} -> (itm,WeaponTargetingSF, useBreakListsLinkTest [noa AugmentedHUDSF AugmentedHUDLink] [])
+    ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LTest (const Nothing) (const Nothing))
+    ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LTest (const Nothing) (const Nothing))
+    ATTACH AUGMENTEDHUD -> nolinks AugmentedHUDSF
+    BULLETMOD BulletModTrajectory {} -> nolinks $ AmmoTargetingSF BulletAmmo
+    BULLETMOD BulletModPayload {} -> nolinks $ AmmoPayloadSF BulletAmmo
+    BULLETMOD BulletModEffect {} -> nolinks $ AmmoEffectSF BulletAmmo
+    ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
+    ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
+    LEFT {} -> isolate
+    EQUIP {} -> isolate
+    CONSUMABLE {} -> isolate
+    CRAFT {} -> isolate
+--    _ -> 
+  where
+    noa x y = (x, ILink y (const (const Nothing)))
+    c x y _ _ = Just (x,y)
+    lhs = Q.axisAngle (V3 1 0 0) pi
+--    rhs = Q.axisAngle (V3 1 0 0) 0
+    nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
+    isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
+
+ammoComposedItem' :: Item -> PartiallyComposedItem ItemLink
+ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
+    atype <- itm ^? itUse . amagType
+    return (itm
+        , AmmoMagSF atype
+        , useBreakListsLinkTest 
+            [noa (AmmoModifierSF atype) AmmoModLink
+            ,noa (AmmoTargetingSF atype) AmmoTargetingLink
+            ,noa (AmmoPayloadSF atype) AmmoPayloadLink
+            ,noa (AmmoEffectSF atype) AmmoEffectLink
+            ,noa (RemoteScreenSF) RemoteScreenLink
+            ] 
+            []
+        )
+  where
+    noa x y = (x, ILink y (const (const Nothing)))
+
 ammoComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
 ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
     atype <- itm ^? itUse . amagType
@@ -119,12 +166,21 @@ invLDT =
     joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
         . fmap (singleLDT . basePartiallyComposedItem)
 
+invLDT'' :: IM.IntMap Item -> [LabelDoubleTree ItemLink (PartiallyComposedItem ItemLink)]
+invLDT'' = 
+    joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
+        . fmap (singleLDT . basePartiallyComposedItem')
+
+invLDT' :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType ComposedItem]
+--invLDT' = map (fmap (\(x,y,_) -> (x,y))) . invLDT
+invLDT' = map (first _iatType . second (\(x,y,_) -> (x,y))) . invLDT''
+
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
 -- consider explicitly reseting the inventory ids (but this probably really
 -- should be done upstream anyway in the actually creature inventory)
 invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree Item)
-invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT) . invLDT
+invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT) . invLDT''
 
 --invRootMap = foldMap (dtToRootIntMap g . ldtToDT) . invLDT
 --  where
@@ -136,7 +192,7 @@ invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _
 -- should be done upstream anyway in the actually creature inventory)
 invAdj :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
 invAdj im = do
-    l <- mapM g $ invLDT im
+    l <- mapM g $ invLDT'' im
     return $ IM.unions l
   where
     g = dtToLRAdjEither getid . ldtToDT
@@ -148,11 +204,11 @@ invAdj im = do
 
 invIndentIM :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType ComposeLinkType)
 invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 (^. _1)) 
-    . concatMap ldtToIndentList . invLDT
+    . concatMap ldtToIndentList . invLDT'
 
 -- returns an intmap with trees for all items, including non-roots
 invTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
-invTrees = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . invLDT
+invTrees = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . invLDT'
   where
     getindex :: Item -> Int
     getindex i =