Cleanup

src/Dodge/Data/ComposedItem.hs

@@ -7,7 +7,7 @@ import Dodge.Data.Item
 import Linear
 import qualified Linear.Quaternion as Q
 
-data ItemStructuralFunction
+data ItemSF -- Structural Function
     = UnloadedWeaponSF
     | HeldPlatformSF
     | UnderBarrelSlotSF
@@ -38,6 +38,6 @@ data ItemStructuralFunction
     | LaserWeaponSF
     deriving (Eq, Ord, Show, Read)
 
-type CItem = (Item, ItemStructuralFunction)
+type CItem = (Item, ItemSF)
 
-type OItem = (Item, ItemStructuralFunction, (V3 Float,Q.Quaternion Float))
+type OItem = (Item, ItemSF, (V3 Float,Q.Quaternion Float))

src/Dodge/DoubleTree.hs

@@ -281,8 +281,8 @@ locUp (LocLDT c@RightwardLDT{} t) =
             (_cldtUp c)
             (LDT (_cldtParent c) (_cldtFarLeft c) (_cldtCloseLeft c ++ ((_cldtLink c, t) : _cldtCloseRight c)))
 
-locToTop :: LocationLDT b a -> LocationLDT b a
+--locToTop :: LocationLDT b a -> LocationLDT b a
-locToTop loc = maybe loc locToTop $ locUp loc
+--locToTop loc = maybe loc locToTop $ locUp loc
 
 locUp' :: LocationDT a -> Maybe (LocationDT a)
 locUp' (LocDT TopDT _) = Nothing
@@ -297,8 +297,8 @@ locUp' (LocDT c@RightwardDT{} t) =
             (_cdtUp c)
             (DT (_cdtParent c) (_cdtFarLeft c) (_cdtCloseLeft c ++ ( t : _cdtCloseRight c)))
 
-locToTop' :: LocationDT a -> LocationDT a
+locToTop :: LocationDT a -> LocationDT a
-locToTop' loc = maybe loc locToTop' $ locUp' loc
+locToTop loc = maybe loc locToTop $ locUp' loc
 
 --locToTop = fix $ \x -> fromMaybe x $ locUp x
 

src/Dodge/HeldUse.hs

@@ -750,7 +750,7 @@ basicMuzFlare pos dir =
         . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
         . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
 
-isAmmoIntLink :: Int -> ItemStructuralFunction -> Bool
+isAmmoIntLink :: Int -> ItemSF -> Bool
 isAmmoIntLink i (AmmoMagSF j _) = i == j
 isAmmoIntLink _ _ = False
 
@@ -796,10 +796,7 @@ useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
     mid = magtree ^? dtValue . _1 . itLocation . ilInvID
     itm = itmtree ^. dtValue . _1
 
-getAttachedSFLink ::
+getAttachedSFLink :: ItemSF -> DTree OItem -> Maybe (NewInt ItmInt)
-    ItemStructuralFunction ->
-    DTree OItem ->
-    Maybe (NewInt ItmInt)
 getAttachedSFLink sf = (^? dtRight . folding (find f) . dtValue . _1 . itID)
   where
     f :: DTree OItem -> Bool

src/Dodge/Item/Grammar.hs

@@ -33,26 +33,7 @@ import ListHelp
 tryAttachItems :: DTree CItem -> DTree CItem -> Maybe (DTree CItem)
 tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
 
---breakListAbove :: Item -> ItemStructuralFunction -> [(ItemStructuralFunction, ItemLink)]
+itemToBreakLists :: Item -> ItemSF -> ([ItemSF], [ItemSF])
---breakListAbove itm itmf = case (itm ^. itType, itmf) of 
---    (_, HeldPlatformSF) ->
---         [(WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
---            <> getAutoSpringLinks itm
---            <> extraWeaponLinks itm
---    (DETECTOR {}, _) -> 
---        [(ARHUDSF,SFLink ARHUDSF),(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
---    (CRAFT TRANSFORMER, _) ->  [(LaserWeaponSF,SFLink LaserWeaponSF)]
---    (MAPPER, _) -> [(ARHUDSF,SFLink ARHUDSF)]
---    (_, GadgetPlatformSF) ->
---        [(TriggerSF, TriggerLink), (WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
---    (_, RemoteScreenSF) ->
---        [(JoystickSF, JoystickLink)]
---    _ -> []
-
-itemToBreakLists ::
-    Item ->
-    ItemStructuralFunction ->
-    ([ItemStructuralFunction], [ItemStructuralFunction])
 itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
     (HELD TORCH, _) -> (getAmmoLinks itm, [])
     (ATTACH UNDERBARRELSLOT, _) -> ([UnderBarrelPlatformSF], [])
@@ -105,12 +86,12 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
         ([AmmoMagSF 0 ElectricalAmmo], [])
     _ -> ([], [])
 
-getAutoSpringLinks :: Item -> [ItemStructuralFunction]
+getAutoSpringLinks :: Item -> [ItemSF]
 getAutoSpringLinks itm = case baseItemTriggerType itm of
     HammerTrigger _ -> [MakeAutoSF]
     _ -> []
 
-extraWeaponLinks :: Item -> [ItemStructuralFunction]
+extraWeaponLinks :: Item -> [ItemSF]
 extraWeaponLinks itm = case itm ^. itType of
     HELD GLAUNCHER -> launcherlinks <> [GrenadeHitEffectSF]
     HELD RLAUNCHER -> launcherlinks
@@ -119,15 +100,15 @@ extraWeaponLinks itm = case itm ^. itType of
   where
     launcherlinks = [ProjectileStabiliserSF]
 
-extraWeaponLinksBelow :: Item -> [ItemStructuralFunction]
+extraWeaponLinksBelow :: Item -> [ItemSF]
 extraWeaponLinksBelow itm
     | TwoHandUnder <- itemBaseStance itm = [UnderBarrelSlotSF]
     | otherwise = []
 
-getAmmoLinks :: Item -> [ItemStructuralFunction]
+getAmmoLinks :: Item -> [ItemSF]
 getAmmoLinks itm = map (uncurry AmmoMagSF) (IM.toList $ itemAmmoSlots itm)
 
-itemToFunction :: Item -> ItemStructuralFunction
+itemToFunction :: Item -> ItemSF
 itemToFunction itm = case itm ^. itType of
     DETECTOR {} -> GadgetPlatformSF
     MAPPER -> MapperSF
@@ -161,7 +142,7 @@ itemToFunction itm = case itm ^. itType of
     CLICKER{} -> GadgetPlatformSF
     _ -> NoSF
 
-treeToPotentialFunction :: DTree CItem -> S.Set ItemStructuralFunction
+treeToPotentialFunction :: DTree CItem -> S.Set ItemSF
 treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
     STICKYMOD -> S.singleton GrenadeHitEffectSF
     ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
@@ -192,13 +173,13 @@ rightIsParentCombine ltree rtree = do
     sf <- safeHead xs
     return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
 
-leftChildList :: DTree CItem -> [ItemStructuralFunction]
+leftChildList :: DTree CItem -> [ItemSF]
 leftChildList t = foldl' f l (reverse $ t ^.. dtLeft . each . dtValue . _2)
   where
     l = fst $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)
     f x y = tail $ dropWhile (/=y) x
 
-rightChildList :: DTree CItem -> [ItemStructuralFunction]
+rightChildList :: DTree CItem -> [ItemSF]
 rightChildList t = foldl' f l (reverse $ t ^.. dtRight . each . dtValue . _2)
   where
     l = snd $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)

src/Dodge/Item/HeldOffset.hs

@@ -55,7 +55,7 @@ handOrient cr = case cr ^. crStance . posture of
 
 locOrient :: LocationDT OItem -> Creature -> Point3Q
 locOrient loc cr =
-    handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop' loc) cr
+    handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr
         `Q.comp` (loc ^. locDT . dtValue . _3)
 
 handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
@@ -63,7 +63,7 @@ handHandleOrient loc cr =
     handOrient cr (aimStance (loc' ^. locDT))
         `Q.comp` handleOrient loc'
   where
-    loc' = locToTop' loc
+    loc' = locToTop loc
 
 shoulderHeight :: Float
 shoulderHeight = 18

src/Dodge/Item/Orientation.hs

@@ -21,7 +21,7 @@ orientChild itm = case _itType itm of
     --r = Q.axisAngle (V3 0 0 1) (-pi/4)
     r = Q.qID
 
-orientByParentChSF :: Item -> ItemStructuralFunction -> Point3Q
+orientByParentChSF :: Item -> ItemSF -> Point3Q
 orientByParentChSF itm lt = case (_itType itm, lt) of
     (HELD FLAMETHROWER, AmmoMagSF{}) -> (V3 4 (-6) 0, Q.qID)
     (HELD _, AmmoMagSF{}) -> (V3 7 (-2) 0, Q.qID)

src/Dodge/Render/HUD.hs

@@ -4,8 +4,6 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
-import Dodge.Data.EquipType
-import Dodge.Item.Location
 import Control.Applicative
 import Control.Lens
 import Control.Monad
@@ -22,6 +20,7 @@ import Dodge.Data.CardinalPoint
 import Dodge.Data.Combine
 import Dodge.Data.Config
 import Dodge.Data.DoubleTree
+import Dodge.Data.EquipType
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.DoubleTree
@@ -31,6 +30,7 @@ import Dodge.Item.Display
 import Dodge.Item.Grammar
 import Dodge.Item.Info
 import Dodge.Item.InvSize
+import Dodge.Item.Location
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
 --import Dodge.Render.HUD.Carte
@@ -96,7 +96,7 @@ getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
 getRootItemBounds i inv = do
     let ia = invIndents inv -- why indents? why OItem?
     itm <- ia ^? ix i . _2
-    let root = locToTop' itm
+    let root = locToTop itm
     x <- locDTRightmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
     y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
     return (x, y)
@@ -172,8 +172,7 @@ drawMapperInventory itid w = fold $ do
     itm <- w ^? pointerToItemID itid
     ls <- itm ^? itUse . useMapperLines
     let _ = w ^. wCam . camRot
-    return . color red
+    return . color red $ foldMap (\(x, y) -> line [f x, f y]) ls
-        $ foldMap (\(x,y) -> line [f x,f y]) ls
   where
     f = worldPosToScreen (w ^. wCam)