Draw cursor when targeting with HUD

src/Dodge/Item/Grammar.hs

@@ -1,5 +1,6 @@
 module Dodge.Item.Grammar (
     invLDT',
+    invLDT'',
     invTrees,
     invIndentIM,
     invAdj,
@@ -21,9 +22,7 @@ import Dodge.DoubleTree
 import ListHelp
 
 
-useBreakListsLinkTest :: [(ItemStructuralFunction,a)]
-    -> [(ItemStructuralFunction,a)]
-    -> LinkTest a
+useBreakListsLinkTest :: [(ItemStructuralFunction,a)] -> [(ItemStructuralFunction,a)] -> LinkTest a
 useBreakListsLinkTest llist rlist = LTest ltest rtest
   where
     ltest (_,sf,_) = do
@@ -35,35 +34,13 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
         (_,linktype) <- safeHead xs
         return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
 
-basePartiallyComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
-basePartiallyComposedItem itm = case itm ^. itType of
-    HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest 
-        (map (\(i,a) -> (AmmoMagSF a,AmmoInLink i a)) (IM.toList $ itm ^. itUse . heldAmmoTypes))
-        [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
-        )
-    AMMOMAG _ -> ammoComposedItem itm
-    TARGETING {} -> (itm,WeaponTargetingSF, useBreakListsLinkTest [(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
-    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)))
+        (map (\(i,a) -> (AmmoMagSF a, ILink (AmmoInLink i a) (c (V3 7 (-2) 0) rhs
+            )
+            ))
             (IM.toList $ itm ^. itUse . heldAmmoTypes))
         [noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
         )
@@ -85,8 +62,7 @@ basePartiallyComposedItem' itm = case itm ^. itType of
   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
+    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))
 
@@ -107,21 +83,6 @@ ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
   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
-    return (itm
-        , AmmoMagSF atype
-        , useBreakListsLinkTest 
-            [(AmmoModifierSF atype, AmmoModLink)
-            ,(AmmoTargetingSF atype, AmmoTargetingLink)
-            ,(AmmoPayloadSF atype, AmmoPayloadLink)
-            ,(AmmoEffectSF atype, AmmoEffectLink)
-            ,(RemoteScreenSF, RemoteScreenLink)
-            ] 
-            []
-        )
-
 type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
 
 leftIsParentCombine :: LDTComb (PartiallyComposedItem a) a
@@ -161,18 +122,12 @@ joinItemsInList f xs = snd $ h (xs, [])
         Nothing -> h (ys, y : z : zs)
         Just w -> h (w : ys, zs)
 
-invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType)]
-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
@@ -206,7 +161,7 @@ invIndentIM :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType C
 invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 (^. _1)) 
     . concatMap ldtToIndentList . invLDT'
 
--- returns an intmap with trees for all items, including non-roots
+-- returns an intmap with trees for all root items
 invTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
 invTrees = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . invLDT'
   where