Cleanup LabelDoubleTree -> LDTree

src/Dodge/Creature/Impulse/UseItem.hs

@@ -80,7 +80,7 @@ structureUseAtLoc = \case
     MapperSF -> True
     _ -> False
 
-activateDetonator :: LabelDoubleTree ItemLink CItem -> World -> World
+activateDetonator :: LDTree ItemLink CItem -> World -> World
 activateDetonator det = fromMaybe id $ do
     pjid <- det ^? ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0
     return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0

src/Dodge/Creature/State.hs

@@ -279,7 +279,7 @@ updateHeldRootItem cr = fromMaybe id $ do
     itmtree <- invRootTrees (_crInv cr) ^? ix invid
     return $ updateAttachedItems itmtree cr
 
-updateAttachedItems :: LabelDoubleTree ItemLink CItem -> Creature -> World -> World
+updateAttachedItems :: LDTree ItemLink CItem -> Creature -> World -> World
 updateAttachedItems itmtree cr =
     cldtPropagateFold
         chainLinkOrientation
@@ -326,7 +326,7 @@ drawARHUD (LocLDT con _) w = fromMaybe w $ do
 
 shineTargetLaser ::
     Creature ->
-    LabelDoubleTree ItemLink CItem ->
+    LDTree ItemLink CItem ->
     (Point3, Q.Quaternion Float) ->
     World ->
     World
@@ -367,7 +367,7 @@ shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ N
 
 shineTorch ::
     Creature ->
-    LabelDoubleTree ItemLink CItem ->
+    LDTree ItemLink CItem ->
     (Point3, Q.Quaternion Float) ->
     World ->
     World

src/Dodge/Data/ComposedItem.hs

@@ -6,7 +6,6 @@
 module Dodge.Data.ComposedItem where
 
 import Dodge.Data.AmmoType
-import Dodge.Data.DoubleTree
 import Control.Lens
 import Dodge.Data.Item
 
@@ -63,23 +62,6 @@ data ItemStructuralFunction
     | MapperSF
     deriving (Eq, Ord, Show, Read)
 
-type CItem = (Item, ItemStructuralFunction, LinkTest)
+type CItem = (Item, ItemStructuralFunction)
-
--- this should possibly use a full item structure tree rather than a
--- CItem as arguments
-data LinkTest = LTest
-    { _tryLeftLink :: LabelDoubleTree ItemLink CItem -> Maybe LinkUpdate
-    , _tryRightLink :: LabelDoubleTree ItemLink CItem -> Maybe LinkUpdate
-    }
-
-data LinkUpdate = LUpdate
-    { _luLinkType :: ItemLink
-    , _luParentUpdate :: CItem -> CItem
-    , _luChildUpdate :: CItem -> CItem
-    }
 
 makeLenses ''ItemLink
-makeLenses ''LinkTest
-makeLenses ''LinkUpdate
---deriveJSON defaultOptions ''ItemStructuralFunction
---deriveJSON defaultOptions ''ComposeLinkType

src/Dodge/Data/DoubleTree.hs

@@ -30,17 +30,10 @@ data LabelDoubleTreeNodeType a
 data DoubleTree a = DT {_dtValue :: a, _dtLeft :: [DoubleTree a], _dtRight :: [DoubleTree a]}
     deriving (Eq, Ord, Show, Read)
 
---data FLatLabelDoubleTreeNode b a = FLDT
+data LDTree b a = LDT -- LabelDoubleTree
---    {_fldtValue :: a
---    ,_fldtType ::
---    ,_fldtIndentation :: Int
---    ,_fldtID :: Int
---    ,_fldtChildren =
-
-data LabelDoubleTree b a = LDT
     { _ldtValue :: a
-    , _ldtLeft :: [(b, LabelDoubleTree b a)]
+    , _ldtLeft :: [(b, LDTree b a)]
-    , _ldtRight :: [(b, LabelDoubleTree b a)]
+    , _ldtRight :: [(b, LDTree b a)]
     }
     deriving (Eq, Ord, Show, Read)
 
@@ -49,24 +42,24 @@ data ContextLDT b a
     = TopLDT
     | LeftwardLDT
         { _cldtUp :: ContextLDT b a
-        , _cldtCloseLeft :: [(b, LabelDoubleTree b a)]
+        , _cldtCloseLeft :: [(b, LDTree b a)]
         , _cldtParent :: a
         , _cldtLink :: b
-        , _cldtCloseRight :: [(b, LabelDoubleTree b a)]
+        , _cldtCloseRight :: [(b, LDTree b a)]
-        , _cldtFarRight :: [(b, LabelDoubleTree b a)]
+        , _cldtFarRight :: [(b, LDTree b a)]
         }
     | RightwardLDT
         { _cldtUp :: ContextLDT b a
-        , _cldtFarLeft :: [(b, LabelDoubleTree b a)]
+        , _cldtFarLeft :: [(b, LDTree b a)]
-        , _cldtCloseLeft :: [(b, LabelDoubleTree b a)]
+        , _cldtCloseLeft :: [(b, LDTree b a)]
         , _cldtParent :: a
         , _cldtLink :: b
-        , _cldtCloseRight :: [(b, LabelDoubleTree b a)]
+        , _cldtCloseRight :: [(b, LDTree b a)]
         }
 
 data LocationLDT b a = LocLDT
     { _locLdtContext :: ContextLDT b a
-    , _locLDT :: LabelDoubleTree b a
+    , _locLDT :: LDTree b a
     }
 
 instance Functor DoubleTree where
@@ -75,10 +68,10 @@ instance Functor DoubleTree where
 instance Foldable DoubleTree where
     foldMap f (DT x l r) = foldMap (foldMap f) l <> f x <> foldMap (foldMap f) r
 
-instance Functor (LabelDoubleTree b) where
+instance Functor (LDTree b) where
     fmap f (LDT x l r) = LDT (f x) (fmap (second $ fmap f) l) (fmap (second $ fmap f) r)
 
-instance Bifunctor LabelDoubleTree where
+instance Bifunctor LDTree where
     second = fmap
     first f (LDT x l r) =
         LDT
@@ -87,7 +80,7 @@ instance Bifunctor LabelDoubleTree where
             (map (bimap f (first f)) r)
 
 makeLenses ''DoubleTree
-makeLenses ''LabelDoubleTree
+makeLenses ''LDTree
 makeLenses ''LocationLDT
 makeLenses ''ContextLDT
 --deriveJSON defaultOptions ''DoubleTree

src/Dodge/DoubleTree.hs

@@ -9,17 +9,17 @@ import Data.Monoid
 singleDT :: a -> DoubleTree a
 singleDT x = DT x [] []
 
-singleLDT :: a -> LabelDoubleTree b a
+singleLDT :: a -> LDTree b a
 singleLDT x = LDT x [] []
 
-ldtToDT :: LabelDoubleTree b a -> DoubleTree a
+ldtToDT :: LDTree b a -> DoubleTree a
 ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
 
 -- propagate two functions down the links of an LDT tree
 -- which function is chosen depends on whether it is a left or right branch
 ldtPropagate :: (c -> b -> c) -> (c -> b -> c) 
     -> c 
-    -> LabelDoubleTree b a -> LabelDoubleTree c a
+    -> LDTree b a -> LDTree c a
 ldtPropagate lf rf = ildtPropagate (const lf) (const rf)
 
 -- Propgates a value (of type c) down the branches of the LDT.
@@ -30,7 +30,7 @@ ldtPropagateFold :: (c -> a -> b -> a -> c)
     -> (c -> a -> b -> a -> c) 
     -> (c -> a -> d -> d)
     -> c 
-    -> LabelDoubleTree b a 
+    -> LDTree b a 
     -> d 
     -> d
 ldtPropagateFold lf rf up x (LDT v l r) = 
@@ -44,9 +44,9 @@ ldtPropagateFold lf rf up x (LDT v l r) =
 -- For each node-tree, the updated value is used to update a final value (of type d).
 ldtPropagateFoldTree :: (c -> a -> b -> a -> c) 
     -> (c -> a -> b -> a -> c) 
-    -> (c -> LabelDoubleTree b a -> d -> d)
+    -> (c -> LDTree b a -> d -> d)
     -> c 
-    -> LabelDoubleTree b a 
+    -> LDTree b a 
     -> d 
     -> d
 ldtPropagateFoldTree lf rf up x t@(LDT v l r) = 
@@ -56,12 +56,12 @@ ldtPropagateFoldTree lf rf up x t@(LDT v l r) =
 
 ildtPropagate :: (Int -> c -> b -> c) -> (Int -> c -> b -> c) 
     -> c 
-    -> LabelDoubleTree b a -> LabelDoubleTree c a
+    -> LDTree b a -> LDTree c a
 ildtPropagate lf rf x (LDT v l r) = LDT v (imap (go lf x) l) (imap (go rf x) r)
   where
     go f y i (z,t) = (f i y z, ildtPropagate lf rf (f i y z) t)
 
-ldtPropagateIndices :: LabelDoubleTree b a -> LabelDoubleTree b (a, [Either Int Int])
+ldtPropagateIndices :: LDTree b a -> LDTree b (a, [Either Int Int])
 ldtPropagateIndices (LDT x l r) = LDT (x,[]) (imap (f Left) l) (imap (f Right) r)
   where
     f e i (y,t) = (y, second (e i:) <$> ldtPropagateIndices t)
@@ -140,13 +140,13 @@ dtToAdjRootParentEither root par f (DT x l r) = do
   where 
     g = f . _dtValue
 
-ldtToIM :: (a -> Int) -> LabelDoubleTree b a -> IM.IntMap (LabelDoubleTree b a)
+ldtToIM :: (a -> Int) -> LDTree b a -> IM.IntMap (LDTree b a)
 ldtToIM f t@(LDT x l r) = IM.insert (f x) t $ IM.unions $ map (ldtToIM f . snd) $  l <> r
 
-ldtToIndentList :: LabelDoubleTree b a -> [(a,Int,LabelDoubleTreeNodeType b)]
+ldtToIndentList :: LDTree b a -> [(a,Int,LabelDoubleTreeNodeType b)]
 ldtToIndentList = ldtIL LDTRootNode
 
-ldtIL :: LabelDoubleTreeNodeType b -> LabelDoubleTree b a -> [(a,Int,LabelDoubleTreeNodeType b)]
+ldtIL :: LabelDoubleTreeNodeType b -> LDTree b a -> [(a,Int,LabelDoubleTreeNodeType b)]
 ldtIL nt (LDT x l r) = map doindent 
     (concat 
         (headMap 
@@ -180,11 +180,11 @@ prettyDT :: (a -> String) -> DoubleTree a -> [String]
 prettyDT f (DT x l r) = concatMap (map ('/':) . prettyDT f) r 
     ++ (f x : concatMap (map ('\\':) . prettyDT f) l)
 
-prettyLDT :: (a -> String) -> LabelDoubleTree b a -> [String]
+prettyLDT :: (a -> String) -> LDTree b a -> [String]
 prettyLDT f (LDT x l r) = concatMap (map ('/':) . prettyLDT f . snd) r 
     ++ (f x : concatMap (map ('\\':) . prettyLDT f . snd) l)
 
-ldtToLoc :: LabelDoubleTree b a -> LocationLDT b a
+ldtToLoc :: LDTree b a -> LocationLDT b a
 ldtToLoc = LocLDT TopLDT
 
 -- should probably do tests for these

src/Dodge/HeldUse.hs

@@ -60,23 +60,23 @@ gadgetEffect pt loc
         useInventoryPath pt i x loc
     | otherwise = const id
 
-heldEffect :: PressType -> LabelDoubleTree ItemLink Item -> Creature -> World -> World
+heldEffect :: PressType -> LDTree ItemLink Item -> Creature -> World -> World
 heldEffect = useTimeCheck . hammerCheck heldEffectMuzzles
 
-heldEffectNoHammerCheck :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
+heldEffectNoHammerCheck :: LDTree ItemLink Item -> Creature -> World -> World
 heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles
 
 type ChainEffect =
-    (LabelDoubleTree ItemLink Item -> Creature -> World -> World) ->
+    (LDTree ItemLink Item -> Creature -> World -> World) ->
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Creature ->
     World ->
     World
 
 hammerCheck ::
-    (LabelDoubleTree ItemLink Item -> Creature -> World -> World) ->
+    (LDTree ItemLink Item -> Creature -> World -> World) ->
     PressType ->
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Creature ->
     World ->
     World
@@ -142,7 +142,7 @@ useTimeCheck f item cr w = case useDelay $ item ^. ldtValue of
     -- will have problems elsewhere also
     itRef = item ^?! ldtValue . itLocation . ilInvID
 
-heldEffectMuzzles :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
+heldEffectMuzzles :: LDTree ItemLink Item -> Creature -> World -> World
 heldEffectMuzzles t cr w =
     setusetime . doHeldUseEffect t cr
         . uncurry (applyCME (_ldtValue t) cr)
@@ -336,7 +336,7 @@ vgunMuzzles i =
             --            <*> ZipList [0 .. i -1]
         )
 
-doHeldUseEffect :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
+doHeldUseEffect :: LDTree ItemLink Item -> Creature -> World -> World
 doHeldUseEffect t cr w = case t ^. ldtValue . itType of
     HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
         Just [_] -> fromMaybe w $ do
@@ -677,9 +677,9 @@ heldTorqueAmount = \case
 
 -- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
 loadMuzzle ::
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Muzzle ->
-    (LabelDoubleTree ItemLink Item, Maybe (Muzzle, Int, LabelDoubleTree ItemLink Item))
+    (LDTree ItemLink Item, Maybe (Muzzle, Int, LDTree ItemLink Item))
 loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
     --    guard $ mz ^? mzFrame == t ^? ldtValue . itUse . heldFrame
     let as = _mzAmmoSlot mz
@@ -697,7 +697,7 @@ loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
         , Just (mz, usedammo, mag)
         )
 
-makeMuzzleFlare :: Muzzle -> LabelDoubleTree ItemLink Item -> Creature -> World -> World
+makeMuzzleFlare :: Muzzle -> LDTree ItemLink Item -> Creature -> World -> World
 makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
     NoFlare -> id
     BasicFlare -> basicMuzFlare pos dir
@@ -746,13 +746,13 @@ flareCircleAt col alphax tranv =
             )
 
 -- previous phaseV parameters: 0.2, 1, 5
-getLaserPhaseV :: LabelDoubleTree ItemLink Item -> Float
+getLaserPhaseV :: LDTree ItemLink Item -> Float
 getLaserPhaseV = const 1
 
-getLaserDamage :: LabelDoubleTree ItemLink Item -> LaserType
+getLaserDamage :: LDTree ItemLink Item -> LaserType
 getLaserDamage = const (DamageLaser 11)
 
-getLaserColor :: LabelDoubleTree ItemLink Item -> Color
+getLaserColor :: LDTree ItemLink Item -> Color
 getLaserColor = const yellow
 
 basicMuzFlare :: Point2 -> Float -> World -> World
@@ -767,10 +767,10 @@ isAmmoIntLink i (AmmoInLink j _) = i == j
 isAmmoIntLink _ _ = False
 
 useLoadedAmmo ::
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Creature ->
     (Bool, World) ->
-    Maybe (Muzzle, Int, LabelDoubleTree ItemLink Item) ->
+    Maybe (Muzzle, Int, LDTree ItemLink Item) ->
     (Bool, World)
 useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
 useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
@@ -808,7 +808,7 @@ useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
 
 getAttachedSFLink ::
     ItemStructuralFunction ->
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Maybe (NewInt ItmInt)
 getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)
 
@@ -869,7 +869,7 @@ tractorBeamAt pos outpos dir power =
     d = unitVectorAtAngle dir * power
 
 creatureShootLaser ::
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Creature ->
     Muzzle ->
     World ->
@@ -925,7 +925,7 @@ removeAmmoFromMag x mid cr = fromMaybe id $ do
             . _Just
             -~ x
 
-getBulletType :: LabelDoubleTree ItemLink Item -> Maybe Bullet
+getBulletType :: LDTree ItemLink Item -> Maybe Bullet
 getBulletType magtree =
     --magtree ^? ldtValue . itConsumables . magParams . ampBullet
     (magtree ^? ldtValue >>= magAmmoParams >>= (^? ampBullet))
@@ -979,9 +979,9 @@ magAmmoParams itm = case itm ^. itType of
 --        _ -> 0
 
 shootBullet ::
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Creature ->
-    (Muzzle, Int, LabelDoubleTree ItemLink Item) ->
+    (Muzzle, Int, LDTree ItemLink Item) ->
     World ->
     World
 shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
@@ -1265,10 +1265,7 @@ shootTeslaArc itm cr mz w =
     pos = _crPos cr + rotateV (_crDir cr) moff
     dir = _crDir cr + mrot
 
-determineProjectileTracking ::
+determineProjectileTracking :: LDTree ItemLink Item -> LDTree ItemLink Item -> RocketHoming
-    LabelDoubleTree ItemLink Item ->
-    LabelDoubleTree ItemLink Item ->
-    RocketHoming
 determineProjectileTracking magtree itmtree =
     fromMaybe NoHoming $
         finddronecontrols <|> findexternaltracking
@@ -1283,8 +1280,8 @@ determineProjectileTracking magtree itmtree =
         return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
 
 createProjectileR ::
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Muzzle ->
     Creature ->
     World ->
@@ -1302,7 +1299,7 @@ createProjectileR itmtree magtree =
         | isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke
         | otherwise = Nothing
 
-getPJStabiliser :: LabelDoubleTree ItemLink Item -> Maybe PJStabiliser
+getPJStabiliser :: LDTree ItemLink Item -> Maybe PJStabiliser
 getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
     Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of
         Just GIMBAL -> Just StabOrthReduce
@@ -1310,7 +1307,7 @@ getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
         _ -> Nothing
     _ -> Nothing
 
-getGrenadeHitEffect :: LabelDoubleTree ItemLink Item -> GrenadeHitEffect
+getGrenadeHitEffect :: LDTree ItemLink Item -> GrenadeHitEffect
 getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of
     Just ldt' -> case ldt' ^? ldtValue . itType of
         Just STICKYMOD -> GStick
@@ -1319,7 +1316,7 @@ getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of
 
 createProjectile ::
     ProjectileType ->
-    LabelDoubleTree ItemLink Item ->
+    LDTree ItemLink Item ->
     Maybe PJStabiliser ->
     Muzzle ->
     Creature ->

src/Dodge/Item/AimStance.hs

@@ -10,7 +10,7 @@ import Dodge.Data.AimStance
 --aStance :: LocationLDT ItemLink CItem -> AimStance
 --aStance loc = case loc ^. locLDT . ldtValue . _1 . itType of
 --
-aimStance :: LabelDoubleTree ItemLink CItem -> AimStance
+aimStance :: LDTree ItemLink CItem -> AimStance
 aimStance ldt = itemBaseStance $ ldt ^. ldtValue . _1
 
 

src/Dodge/Item/Draw.hs

@@ -15,7 +15,7 @@ import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import ShapePicture
 
-itemEquipPict :: Creature -> LabelDoubleTree ItemLink CItem -> SPic
+itemEquipPict :: Creature -> LDTree ItemLink CItem -> SPic
 itemEquipPict cr itmtree
     | Just i <- itm ^? itLocation . ilInvID
     , Just esite <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just

src/Dodge/Item/Draw/SPic.hs

@@ -21,12 +21,10 @@ import Picture
 import Shape
 import ShapePicture
 
-itemTreeSPic :: LabelDoubleTree ItemLink CItem -> SPic
+itemTreeSPic :: LDTree ItemLink CItem -> SPic
-itemTreeSPic (LDT (itm,_,_) l r) =
+itemTreeSPic (LDT (itm,_) l r) = itemSPic itm <> foldMap (itemRotTreeSPic itm) (l <> r)
-    itemSPic itm
-        <> foldMap (itemRotTreeSPic itm) (l <> r)
 
-itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink CItem) -> SPic
+itemRotTreeSPic :: Item -> (ItemLink, LDTree ItemLink CItem) -> SPic
 itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
   where
     (p, q) = orientAttachment par il itm

src/Dodge/Item/Grammar.hs

@@ -27,35 +27,10 @@ import Dodge.DoubleTree
 import LensHelp
 import ListHelp
 
-tryAttachItems ::
+tryAttachItems :: LDTree ItemLink CItem -> LDTree ItemLink CItem -> 
-    LabelDoubleTree ItemLink CItem ->
+    Maybe (LDTree ItemLink CItem)
-    LabelDoubleTree ItemLink CItem ->
-    Maybe (LabelDoubleTree ItemLink CItem)
 tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
 
-useBreakL ::
-    [(ItemStructuralFunction, ItemLink)] ->
-    [(ItemStructuralFunction, ItemLink)] ->
-    LinkTest
-useBreakL llist rlist = LTest ltest rtest
-  where
-    ltest ldt = do
-        let xs =
-                dropWhile
-                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
-                    llist
-        (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakL (tail xs) rlist)) 
-            (_2 .~ sf)
-    rtest ldt = do
-        let xs =
-                dropWhile
-                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
-                    rlist
-        (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakL llist (tail xs))) 
-            (_2 .~ sf)
-
 itemToBreakLists ::
     Item ->
     ItemStructuralFunction ->
@@ -173,9 +148,7 @@ itemToFunction itm = case itm ^. itType of
     CLICKER{} -> GadgetPlatformSF
     _ -> NoSF
 
-structureToPotentialFunction ::
+structureToPotentialFunction :: LDTree ItemLink CItem -> S.Set ItemStructuralFunction
-    LabelDoubleTree ItemLink CItem ->
-    S.Set ItemStructuralFunction
 structureToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
     STICKYMOD -> S.singleton GrenadeHitEffectSF
     ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
@@ -184,52 +157,9 @@ structureToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
     _ -> S.singleton (ldt ^. ldtValue . _2)
 
 baseCI :: Item -> CItem
-baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)
+baseCI itm = (itm, itemToFunction itm)
 
-itemBaseConnections :: Item -> LinkTest
+type LDTComb a b = LDTree b a -> LDTree b a -> Maybe (LDTree b a)
-itemBaseConnections itm = case _itType itm of
-    HELD LASER -> laserLinkTest itm
-    CRAFT SPRING -> springLinkTest
-    _ -> uncurry useBreakL $ itemToBreakLists itm (itemToFunction itm)
-
-laserLinkTest :: Item -> LinkTest
-laserLinkTest itm = LTest (llleft itm) (llright itm)
-
-llleft :: Item -> LabelDoubleTree ItemLink CItem -> Maybe LinkUpdate
-llleft itm =
-    _tryLeftLink
-        . uncurry useBreakL
-        $ itemToBreakLists itm WeaponTargetingSF
-
-llright :: Item -> LabelDoubleTree ItemLink CItem -> Maybe LinkUpdate
-llright itm pci = case pci ^. ldtValue . _1 . itType of
-    CRAFT TRANSFORMER -> Just (toLasgunUpdate itm)
-    _ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists itm WeaponTargetingSF) pci
-
-toLasgunUpdate :: Item -> LinkUpdate
-toLasgunUpdate itm =
-    LUpdate
-        FunctionChangeLink
-        (\(par, _, _) -> (par, HeldPlatformSF, uncurry useBreakL $ itemToBreakLists itm HeldPlatformSF))
-        (\(chi, _, up) -> (chi, FunctionChangeSF, up))
-
-springLinkTest :: LinkTest
-springLinkTest = LTest (const Nothing) $
-    \ci -> case ci ^. ldtValue . _1 . itType of
-        CRAFT HARDWARE ->
-            Just
-                ( LUpdate
-                    (FunctionChangeLink)
-                    (\(par, _, up) -> (par, MakeAutoSF, up))
-                    (\(chi, _, up) -> (chi, FunctionChangeSF, up))
-                )
-        _ -> Nothing
-
---itemLinkTestLeft :: Item -> PartiallyCItem -> Maybe LinkUpdate
---itemLinkTestLeft itm = _tryLeftLink $
---    uncurry useBreakL $ itemToBreakLists itm
-
-type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
 
 leftIsParentCombine :: LDTComb CItem ItemLink
 leftIsParentCombine ltree rtree = do
@@ -239,13 +169,6 @@ leftIsParentCombine ltree rtree = do
     return $
         ltree & ldtRight .:~ (linktype, rtree & ldtValue . _2 .~ sf)
 
-leftIsParentCombine' :: LDTComb CItem ItemLink
-leftIsParentCombine' ltree rtree = do
-    lu <- (ltree ^. ldtValue . _3 . tryRightLink) rtree --(rtree ^. ldtValue)
-    return $
-        ltree & ldtValue %~ (lu ^. luParentUpdate)
-            & ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
-
 rightIsParentCombine :: LDTComb CItem ItemLink
 rightIsParentCombine ltree rtree = do
     let l = leftChildList rtree
@@ -254,31 +177,24 @@ rightIsParentCombine ltree rtree = do
     return $
         rtree & ldtLeft .:~ (linktype, ltree & ldtValue . _2 .~ sf)
 
-leftChildList :: LabelDoubleTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
+leftChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
 leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _1)
   where
     l = fst $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
     f x y = tail $ dropWhile ((/=y) . snd) x
 
-rightChildList :: LabelDoubleTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
+rightChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
 rightChildList t = foldl' f l (reverse $ t ^.. ldtRight . each . _1)
   where
     l = snd $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
     f x y = tail $ dropWhile ((/=y) . snd) x
 
-rightIsParentCombine' :: LDTComb CItem ItemLink
-rightIsParentCombine' ltree rtree = do
-    lu <- (rtree ^. ldtValue . _3 . tryLeftLink) ltree -- (ltree ^. ldtValue)
-    return $
-        rtree & ldtValue %~ (lu ^. luParentUpdate)
-            & ldtLeft .:~ (lu ^. luLinkType, ltree & ldtValue %~ (lu ^. luChildUpdate))
-
 leftRightCombine ::
     LDTComb a b ->
     LDTComb a b ->
-    LabelDoubleTree b a ->
+    LDTree b a ->
-    LabelDoubleTree b a ->
+    LDTree b a ->
-    Maybe (LabelDoubleTree b a)
+    Maybe (LDTree b a)
 leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
   where
     checkdepth t t'@(LDT x ls rs) = fromMaybe (checktop t t') $ do
@@ -297,7 +213,7 @@ joinItemsInList f xs = snd $ h (xs, [])
         Just w -> h (w : ys, zs)
 
 -- this puts the first elements in the intmap at the end of the list
-invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink CItem]
+invLDT :: IM.IntMap Item -> [LDTree ItemLink CItem]
 invLDT =
     joinItemsInList tryAttachItems . IM.elems
         . fmap (singleLDT . baseCI)
@@ -321,18 +237,16 @@ invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
 invAdj = IM.unions . map g . invLDT
   where
     g = dtToLRAdj getid . ldtToDT
-    getid (itm, _, _) =
+    getid (itm, _) =
         fromMaybe
             (error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
             $ itm ^? itLocation . ilInvID
 
 -- returns an intmap with trees for (only!) root items, indexed by inventory position
-invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink CItem)
+invRootTrees :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
 invRootTrees = IM.fromDistinctAscList . reverse . map getid . invLDT
   where
-    getid ::
+    getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
-        LabelDoubleTree ItemLink CItem ->
-        (Int, LabelDoubleTree ItemLink CItem)
     getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
 
 -- returns an intmap with indents and locations for all items

tags

@@ -978,7 +978,7 @@ Kill	src/Dodge/Data/ActionPlan.hs	198;"	C
 LASER	src/Dodge/Data/Item/Combine.hs	168;"	C
 LDT	src/Dodge/Data/DoubleTree.hs	40;"	C
 LDTBottomNode	src/Dodge/Data/DoubleTree.hs	28;"	C
-LDTComb	src/Dodge/Item/Grammar.hs	230;"	t
+LDTComb	src/Dodge/Item/Grammar.hs	233;"	t
 LDTMidAboveNode	src/Dodge/Data/DoubleTree.hs	26;"	C
 LDTMidBelowNode	src/Dodge/Data/DoubleTree.hs	27;"	C
 LDTRootNode	src/Dodge/Data/DoubleTree.hs	24;"	C
@@ -3352,7 +3352,7 @@ airlockDoor	src/Dodge/Room/Airlock.hs	51;"	f
 airlockDoubleDoor	src/Dodge/Room/Airlock.hs	54;"	f
 airlockSimple	src/Dodge/Room/Airlock.hs	66;"	f
 airlockZ	src/Dodge/Room/Airlock.hs	91;"	f
-allInvLocs	src/Dodge/Item/Grammar.hs	323;"	f
+allInvLocs	src/Dodge/Item/Grammar.hs	326;"	f
 allVisibleWalls	src/Dodge/Base/Collide.hs	132;"	f
 alongSegBy	src/Geometry.hs	40;"	f
 alteRifle	src/Dodge/Item/Held/Cane.hs	22;"	f
@@ -3453,7 +3453,7 @@ barrel	src/Dodge/Creature/Inanimate.hs	17;"	f
 barrelShape	src/Dodge/Render/ShapePicture.hs	46;"	f
 baseAMRShape	src/Dodge/Item/Draw/SPic.hs	407;"	f
 baseBlockPane	src/Dodge/Placement/Instance/Wall.hs	86;"	f
-baseCI	src/Dodge/Item/Grammar.hs	184;"	f
+baseCI	src/Dodge/Item/Grammar.hs	186;"	f
 baseCaneShape	src/Dodge/Item/Draw/SPic.hs	313;"	f
 baseDebris	src/Dodge/Block/Debris.hs	122;"	f
 baseFloorTileSize	src/Tile.hs	45;"	f
@@ -4305,8 +4305,8 @@ extTrigLitPos	src/Dodge/Placement/Instance/Button.hs	84;"	f
 extendAway	src/Dodge/Placement/Instance/LightSource.hs	200;"	f
 extendConeToScreenEdge	src/Dodge/Debug/Picture.hs	82;"	f
 extraPics	src/Dodge/Render/ShapePicture.hs	73;"	f
-extraWeaponLinks	src/Dodge/Item/Grammar.hs	117;"	f
+extraWeaponLinks	src/Dodge/Item/Grammar.hs	119;"	f
-extraWeaponLinksBelow	src/Dodge/Item/Grammar.hs	126;"	f
+extraWeaponLinksBelow	src/Dodge/Item/Grammar.hs	128;"	f
 extractRoomPos	src/Dodge/RoomPos.hs	6;"	f
 faceEdges	src/Polyhedra.hs	65;"	f
 facesToVF	src/Polyhedra/Geodesic.hs	69;"	f
@@ -4425,11 +4425,11 @@ geometryTests	test/Spec.hs	17;"	f
 geometryUnitTests	test/Spec.hs	22;"	f
 geqConstr	src/SameConstr.hs	21;"	f
 getAimZoom	src/Dodge/Update/Camera.hs	135;"	f
-getAmmoLinks	src/Dodge/Item/Grammar.hs	133;"	f
+getAmmoLinks	src/Dodge/Item/Grammar.hs	135;"	f
 getArguments	src/Dodge/Update/Scroll.hs	178;"	f
 getArguments'	src/Dodge/Update/Scroll.hs	166;"	f
 getAttachedSFLink	src/Dodge/HeldUse.hs	809;"	f
-getAutoSpringLinks	src/Dodge/Item/Grammar.hs	112;"	f
+getAutoSpringLinks	src/Dodge/Item/Grammar.hs	114;"	f
 getAvailableListLines	src/Dodge/SelectionList.hs	10;"	f
 getBulHitDams	src/Dodge/Bullet.hs	171;"	f
 getBulletType	src/Dodge/HeldUse.hs	928;"	f
@@ -4646,16 +4646,16 @@ interweave	src/Justify.hs	17;"	f
 introScan	src/Dodge/Item/Scope.hs	57;"	f
 introScanValue	src/Dodge/Inventory/SelectionList.hs	79;"	f
 intsToPos	src/Dodge/Room/Modify/Girder.hs	160;"	f
-invAdj	src/Dodge/Item/Grammar.hs	304;"	f
+invAdj	src/Dodge/Item/Grammar.hs	307;"	f
 invCursorParams	src/Dodge/ListDisplayParams.hs	36;"	f
 invDP	src/Dodge/ListDisplayParams.hs	30;"	f
 invDimColor	src/Dodge/DisplayInventory.hs	192;"	f
 invHead	src/Dodge/Render/HUD.hs	405;"	f
 invItemLocUpdate	src/Dodge/Creature/State.hs	154;"	f
-invLDT	src/Dodge/Item/Grammar.hs	284;"	f
+invLDT	src/Dodge/Item/Grammar.hs	287;"	f
 invRootItemEffs	src/Dodge/Creature/State.hs	147;"	f
-invRootMap	src/Dodge/Item/Grammar.hs	293;"	f
+invRootMap	src/Dodge/Item/Grammar.hs	296;"	f
-invRootTrees	src/Dodge/Item/Grammar.hs	314;"	f
+invRootTrees	src/Dodge/Item/Grammar.hs	317;"	f
 invSelectionItem	src/Dodge/Inventory/SelectionList.hs	32;"	f
 invSetSelection	src/Dodge/Inventory.hs	185;"	f
 invSetSelectionPos	src/Dodge/Inventory.hs	193;"	f
@@ -4703,7 +4703,7 @@ itEffectOnPickup	src/Dodge/Item/BackgroundEffect.hs	64;"	f
 itInvHeight	src/Dodge/Item/InvSize.hs	11;"	f
 itUseCondition	src/Dodge/ItemUseCondition.hs	6;"	f
 itemAmmoSlots	src/Dodge/Item/AmmoSlots.hs	12;"	f
-itemBaseConnections	src/Dodge/Item/Grammar.hs	187;"	f
+itemBaseConnections	src/Dodge/Item/Grammar.hs	190;"	f
 itemBaseName	src/Dodge/Item/Display.hs	59;"	f
 itemBaseStance	src/Dodge/Item/AimStance.hs	17;"	f
 itemBlips	src/Dodge/RadarSweep.hs	93;"	f
@@ -4735,7 +4735,7 @@ itemScrollValue	src/Dodge/Inventory/SelectionList.hs	147;"	f
 itemSidePush	src/Dodge/HeldUse.hs	432;"	f
 itemString	src/Dodge/Item/Display.hs	55;"	f
 itemToBreakLists	src/Dodge/Item/Grammar.hs	59;"	f
-itemToFunction	src/Dodge/Item/Grammar.hs	139;"	f
+itemToFunction	src/Dodge/Item/Grammar.hs	141;"	f
 itemTreeSPic	src/Dodge/Item/Draw/SPic.hs	24;"	f
 itemTriggerType	src/Dodge/BaseTriggerType.hs	12;"	f
 itemWeight	src/Dodge/Creature/Statistics.hs	66;"	f
@@ -4747,7 +4747,7 @@ itmSpaceInfo	src/Dodge/Item/Info.hs	25;"	f
 itmUsageInfo	src/Dodge/Item/Info.hs	230;"	f
 jShape	src/Dodge/Placement/Instance/LightSource.hs	85;"	f
 jaggedShape	src/Dodge/Block/Debris.hs	191;"	f
-joinItemsInList	src/Dodge/Item/Grammar.hs	274;"	f
+joinItemsInList	src/Dodge/Item/Grammar.hs	277;"	f
 joystick	src/Dodge/Item/Scope.hs	149;"	f
 jps0'	src/Dodge/LevelGen/PlacementHelper.hs	60;"	f
 jps0PushPS	src/Dodge/LevelGen/PlacementHelper.hs	63;"	f
@@ -4781,7 +4781,7 @@ lasTunnel	src/Dodge/Room/LasTurret.hs	126;"	f
 lasTunnelRunPast	src/Dodge/Room/LasTurret.hs	167;"	f
 lasTurret	src/Dodge/Placement/Instance/Turret.hs	38;"	f
 laser	src/Dodge/Item/Held/BatteryGuns.hs	41;"	f
-laserLinkTest	src/Dodge/Item/Grammar.hs	193;"	f
+laserLinkTest	src/Dodge/Item/Grammar.hs	196;"	f
 lastMap	src/Dodge/DoubleTree.hs	174;"	f
 launcherCrit	src/Dodge/Creature/LauncherCrit.hs	12;"	f
 layoutLevelFromSeed	src/Dodge/LevelGen.hs	47;"	f
@@ -4796,11 +4796,10 @@ ldtToIM	src/Dodge/DoubleTree.hs	143;"	f
 ldtToIndentList	src/Dodge/DoubleTree.hs	146;"	f
 ldtToLoc	src/Dodge/DoubleTree.hs	187;"	f
 left	src/DoubleStack.hs	16;"	f
-leftChildList	src/Dodge/Item/Grammar.hs	250;"	f
+leftChildList	src/Dodge/Item/Grammar.hs	251;"	f
 leftIsParentCombine	src/Dodge/Item/Grammar.hs	235;"	f
-leftIsParentCombine'	src/Dodge/Item/Grammar.hs	232;"	f
 leftPad	src/Padding.hs	15;"	f
-leftRightCombine	src/Dodge/Item/Grammar.hs	260;"	f
+leftRightCombine	src/Dodge/Item/Grammar.hs	263;"	f
 legsSPic	src/Dodge/Item/Draw/SPic.hs	477;"	f
 liShape	src/Dodge/Placement/Instance/LightSource.hs	98;"	f
 light	src/Color.hs	104;"	f
@@ -4828,8 +4827,8 @@ listCursorChooseBorderScale	src/Dodge/Render/List.hs	135;"	f
 listGuard	src/Dodge/Creature/ReaderUpdate.hs	190;"	f
 listSelectionColorPicture	src/Dodge/DisplayInventory.hs	308;"	f
 litCorridor90	src/Dodge/Room/RoadBlock.hs	26;"	f
-llleft	src/Dodge/Item/Grammar.hs	196;"	f
+llleft	src/Dodge/Item/Grammar.hs	199;"	f
-llright	src/Dodge/Item/Grammar.hs	202;"	f
+llright	src/Dodge/Item/Grammar.hs	205;"	f
 lmt	src/MatrixHelper.hs	43;"	f
 lnkBothAnd	src/Dodge/Room/Procedural.hs	121;"	f
 lnkMidPosInvSelsCol	src/Dodge/Render/HUD.hs	394;"	f
@@ -5537,8 +5536,8 @@ rezText'	src/Dodge/Story.hs	17;"	f
 rhombus	src/Polyhedra.hs	72;"	f
 rifle	src/Dodge/Item/Held/Cane.hs	19;"	f
 right	src/DoubleStack.hs	16;"	f
-rightIsParentCombine	src/Dodge/Item/Grammar.hs	242;"	f
+rightChildList	src/Dodge/Item/Grammar.hs	257;"	f
-rightIsParentCombine'	src/Dodge/Item/Grammar.hs	253;"	f
+rightIsParentCombine	src/Dodge/Item/Grammar.hs	243;"	f
 rightPad	src/Padding.hs	19;"	f
 rightPadNoSquash	src/Padding.hs	23;"	f
 rlPosDir	src/Dodge/RoomLink.hs	94;"	f
@@ -5886,7 +5885,7 @@ spreadCenter	src/Dodge/Base.hs	187;"	f
 spreadFromCenter	src/Dodge/Base.hs	176;"	f
 spreadGunCrit	src/Dodge/Creature/SpreadGunCrit.hs	12;"	f
 spreadOut	src/Dodge/Creature/Boid.hs	158;"	f
-springLinkTest	src/Dodge/Item/Grammar.hs	214;"	f
+springLinkTest	src/Dodge/Item/Grammar.hs	217;"	f
 sps	src/Dodge/LevelGen/PlacementHelper.hs	30;"	f
 sps0	src/Dodge/LevelGen/PlacementHelper.hs	42;"	f
 square	src/Geometry/Polygon.hs	46;"	f
@@ -5943,7 +5942,7 @@ strideRot	src/Dodge/Item/HeldOffset.hs	78;"	f
 stringToList	src/Picture/Base.hs	313;"	f
 stringToListGrad	src/Picture/Text.hs	12;"	f
 stripZ	src/Geometry/Vector3D.hs	97;"	f
-structureToPotentialFunction	src/Dodge/Item/Grammar.hs	174;"	f
+structureToPotentialFunction	src/Dodge/Item/Grammar.hs	176;"	f
 structureUseAtLoc	src/Dodge/Creature/Impulse/UseItem.hs	75;"	f
 subInvX	src/Dodge/ListDisplayParams.hs	48;"	f
 subMap	src/TreeHelp.hs	118;"	f
@@ -6056,7 +6055,7 @@ toClosestMultiple	src/HelpNum.hs	3;"	f
 toColor8	src/Color.hs	148;"	f
 toFloatVAs	src/Shader/Compile.hs	211;"	f
 toLabel	src/Dodge/Cleat.hs	16;"	f
-toLasgunUpdate	src/Dodge/Item/Grammar.hs	207;"	f
+toLasgunUpdate	src/Dodge/Item/Grammar.hs	210;"	f
 toMultiset	src/Multiset.hs	64;"	f
 toOnward	src/Dodge/Tree/Compose.hs	101;"	f
 toTopLeft	src/Dodge/Render/List.hs	219;"	f