From a054d433b3ef403ec27f1ec261641c9481ae08ba Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 12 Jul 2025 21:52:12 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Data/ComposedItem.hs | 6 +++--- src/Dodge/DoubleTree.hs | 8 ++++---- src/Dodge/HeldUse.hs | 7 ++----- src/Dodge/Item/Grammar.hs | 37 +++++++++------------------------- src/Dodge/Item/HeldOffset.hs | 4 ++-- src/Dodge/Item/Orientation.hs | 2 +- src/Dodge/Render/HUD.hs | 15 +++++++------- 7 files changed, 28 insertions(+), 51 deletions(-) diff --git a/src/Dodge/Data/ComposedItem.hs b/src/Dodge/Data/ComposedItem.hs index 39ba04204..e932ba8fb 100644 --- a/src/Dodge/Data/ComposedItem.hs +++ b/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)) diff --git a/src/Dodge/DoubleTree.hs b/src/Dodge/DoubleTree.hs index 33627c69c..9c598480f 100644 --- a/src/Dodge/DoubleTree.hs +++ b/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 loc = maybe loc locToTop $ locUp loc +--locToTop :: LocationLDT b a -> LocationLDT b a +--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' loc = maybe loc locToTop' $ locUp' loc +locToTop :: LocationDT a -> LocationDT a +locToTop loc = maybe loc locToTop $ locUp' loc --locToTop = fix $ \x -> fromMaybe x $ locUp x diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index ff0221620..8a5e73f27 100644 --- a/src/Dodge/HeldUse.hs +++ b/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 :: - ItemStructuralFunction -> - DTree OItem -> - Maybe (NewInt ItmInt) +getAttachedSFLink :: ItemSF -> DTree OItem -> Maybe (NewInt ItmInt) getAttachedSFLink sf = (^? dtRight . folding (find f) . dtValue . _1 . itID) where f :: DTree OItem -> Bool diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index 13d4b4ae7..e430166fe 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/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)] ---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 :: Item -> ItemSF -> ([ItemSF], [ItemSF]) 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) diff --git a/src/Dodge/Item/HeldOffset.hs b/src/Dodge/Item/HeldOffset.hs index 1677cb9bf..138bef0ec 100644 --- a/src/Dodge/Item/HeldOffset.hs +++ b/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 diff --git a/src/Dodge/Item/Orientation.hs b/src/Dodge/Item/Orientation.hs index 1eaf3f086..5958b04ef 100644 --- a/src/Dodge/Item/Orientation.hs +++ b/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) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 9e3d87bd9..d4d404f76 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 @@ -48,7 +48,7 @@ import SDL (MouseButton (..)) drawHUD :: Configuration -> World -> Picture drawHUD cfig w = case w ^. hud . hudElement of --- DisplayCarte -> drawCarte cfig w + -- DisplayCarte -> drawCarte cfig w DisplayInventory{_diSections = sections, _subInventory = subinv} -> drawInventory sections w cfig <> drawSubInventory subinv cfig w @@ -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) @@ -160,7 +160,7 @@ drawDragSelecting cfig w = do drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory subinv cfig w = case subinv of --- LockedInventory -> mempty -- topInvCursor col cursPos cfig w + -- LockedInventory -> mempty -- topInvCursor col cursPos cfig w NoSubInventory{} -> drawRBOptions cfig w ExamineInventory -> drawExamineInventory cfig w DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld) @@ -172,8 +172,7 @@ drawMapperInventory itid w = fold $ do itm <- w ^? pointerToItemID itid ls <- itm ^? itUse . useMapperLines let _ = w ^. wCam . camRot - return . color red - $ foldMap (\(x,y) -> line [f x,f y]) ls + return . color red $ foldMap (\(x, y) -> line [f x, f y]) ls where f = worldPosToScreen (w ^. wCam) @@ -253,7 +252,7 @@ drawRBOptions cfig w = fold $ do invid <- you w ^? crManipulation . manObject . imSelectedItem eslist <- fmap eqSiteToPositions $ - you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType + you w ^? crInv . ix invid >>= equipType -- . itUse . uequipEffect . eeType i <- w ^? rbOptions . opSel let ae = getEquipmentAllocation invid w sss <- w ^? hud . hudElement . diSections