From c20486fc3453e1ace4dcadb4b465b9279274705c Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 6 Jan 2025 01:05:56 +0000 Subject: [PATCH] Cleanup --- src/Dodge/DisplayInventory.hs | 4 -- src/Dodge/Inventory/SelectionList.hs | 73 +++------------------------- src/Dodge/Item/Display.hs | 18 ++----- src/Dodge/SelectionSections/Draw.hs | 12 +++-- src/Dodge/Zoning/Base.hs | 2 +- src/Padding.hs | 4 -- 6 files changed, 19 insertions(+), 94 deletions(-) diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 49a7acca5..830465d67 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -287,10 +287,6 @@ updateSection indent mcsel sis availablelines oldoffset = , _ssIndent = indent } where - --shownitems = take availablelines allstrings - --shownitems = tweakfirst $ allstrings - --shownitems = tweakfirst $ allstrings - shownitems'' = tweakfirst $ take availablelines shownstrings shownitems = tweakfirst . tweaklast $ take availablelines shownstrings oldoffsetbounded = max 0 . min oldoffset $ aslength - availablelines offset = fromMaybe oldoffsetbounded $ do diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 6f379e00b..405fb654b 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -22,32 +22,23 @@ import NewInt import Padding import Picture.Base ---invSelectionItem :: Int -> World -> ComposedItem -> SelectionItem () invSelectionItem :: World -> Int -> LocationLDT ItemLink ComposedItem -> SelectionItem () invSelectionItem w indent loc = SelectionItem --- { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey) - { _siPictures = pics -- & ix 0 %~ (++ anyequippos ++ anyhotkey) + { _siPictures = itemDisplay w cr ci , _siHeight = itInvHeight $ ci ^. _1 , _siWidth = 15 , _siIsSelectable = True - , _siColor = col + , _siColor = itemInvColor ci , _siOffX = indent , _siPayload = () } where ci = loc ^. locLDT . ldtValue - lw = w ^. cWorld . lWorld - cr = lw ^?! creatures . ix 0 - itid = ci ^. _1 . itID . unNInt - anyhotkey = maybe [] ((' ' :) . hotkeyToString) (lw ^? imHotkeys . unNIntMap . ix itid) - anyequippos = maybe - [] - (rightPad 8 ' ' . (' ' :) . eqPosText) - (ci ^? _1 . itLocation . ilEquipSite . _Just) - col = itemInvColor ci - pics = itemDisplay w cr ci + cr = w ^?! cWorld . lWorld . creatures . ix 0 +-- note the convoluted display of the hotkey/equipment, this was done to avoid a +-- space leak itemDisplay :: World -> Creature -> ComposedItem -> [String] itemDisplay w cr ci = f (basicItemDisplay itm) @@ -60,67 +51,18 @@ itemDisplay w cr ci = f f xs _ = xs g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs g xs _ = xs - anyextra = maybe [] ((:[])) (anyhotkey <> anyequippos) + anyextra = maybe [] (:[]) (anyhotkey <> anyequippos) anyhotkey = fmap hotkeyToString (w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid) --- anyhotkey = maybe [] ((:[]) . hotkeyToString) --- (w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid) anyequippos = fmap (rightPad 8 ' ' . (' ' :) . eqPosText) (ci ^? _1 . itLocation . ilEquipSite . _Just) --- anyequippos = maybe --- [] --- (rightPad 8 ' ' . (' ' :) . eqPosText) --- (ci ^? _1 . itLocation . ilEquipSite . _Just) - ---itemDisplay :: World -> Creature -> ComposedItem -> [String] ---itemDisplay w cr ci = --- zipWithDefaults --- id --- (leftPad 15 ' ') --- itemDisplayPad --- (basicItemDisplay itm) --- (itemNumberDisplay w cr ci) --- where --- itm = ci ^. _1 - -zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c] -zipWithDefaults f g h = go - where - go [] bs = map g bs - go as [] = map f as - go (a : as) (b : bs) = h a b : go as bs itemDisplayPad :: [Char] -> String -> [Char] itemDisplayPad ls rs | rs == "" = ls | otherwise = midPadL 15 ' ' ls (' ' : rs) --- this can change, but probably won't when (say) dropped and then picked up --- again --- that is to say, it should not change based on functional positioning ---itemNumberDisplay :: World -> Creature -> ComposedItem -> String ---itemNumberDisplay w cr ci --- | Just x <- ci ^? _1 . itUse . uInt = show x --- | Just x <- ci ^? _1 . itUse . useToggle = show x --- | ITEMSCAN <- ci ^. _1 . itType --- , Just ExamineInventory <- w ^? hud . hudElement . subInventory --- = "ACTIVE" --- | EQUIP WRIST_ECG <- ci ^. _1 . itType = --- displayPulse $ cr ^?! crType . avatarPulse . pulseProgress --- | HELD ALTERIFLE <- ci ^. _1 . itType = --- case ci ^? _1 . itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot of --- Just 0 -> "/" --- _ -> "\\" --- | isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = --- "!TARG!" --- | Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = shortShow x --- | UseAttach (APInt i) <- ci ^. _1 . itUse = show i --- | UseAttach (APProjectiles x) <- ci ^. _1 . itUse = show x --- | UseScope OpticScope{_opticZoom = x} <- ci ^. _1 . itUse = shortShow x --- | Just t <- ci ^? _1 . itType . ibtIntroScanType = introScanDisplay cr t --- | otherwise = mempty - itemNumberDisplay :: World -> Creature -> ComposedItem -> [String] itemNumberDisplay w cr ci | Just x <- ci ^? _1 . itUse . uInt = [show x] @@ -134,8 +76,7 @@ itemNumberDisplay w cr ci case ci ^? _1 . itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot of Just 0 -> ["/"] _ -> ["\\"] - | isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = - ["!TARG!"] + | isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = ["!TARG!"] | Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x] | UseAttach (APInt i) <- ci ^. _1 . itUse = [show i] | UseAttach (APProjectiles x) <- ci ^. _1 . itUse = [show x] diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 53093a6f6..8de13a531 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -1,28 +1,25 @@ {-# LANGUAGE LambdaCase #-} + module Dodge.Item.Display ( itemBaseName, itemString, basicItemDisplay, ) where -import Dodge.Data.World import Data.Maybe -import Dodge.Data.ComposedItem +import Dodge.Data.World import Dodge.Item.InvSize import LensHelp -import Padding -import ShortShow -- Principles: base names should identify an item, numbers can change based on a -- variety of factors but typically don't depend on functional quality, -- colour gives an indication of an item's function within a structure - +-- itemDisplay has been moved out of this module 06/01/25 basicItemDisplay :: Item -> [String] basicItemDisplay itm = Prelude.take (itInvHeight itm) $ itemBaseName (itm ^. itType) : - --catMaybes [maybeWarmupStatus itm, maybeRateStatus itm] catMaybes [maybeWarmupStatus itm] ++ repeat "*" @@ -36,7 +33,6 @@ maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of let n = show x in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n - itemString :: Item -> String itemString = head . basicItemDisplay @@ -53,7 +49,7 @@ itemBaseName = \case TARGETING tt -> show tt BULLETMOD (BulletModPayload btt) -> show btt BULLETMOD (BulletModEffect btt) -> show btt - STICKYMOD -> "STICKYMOD" + STICKYMOD -> "STICKYMOD" ITEMSCAN -> "ITEMSCAN" INTROSCAN t -> show t MAPPER -> "MAPPER" @@ -89,9 +85,3 @@ showEquipItem :: EquipItemType -> String showEquipItem eit = case eit of INVISIBILITYEQUIPMENT esite -> "INVISIBILITY " ++ show esite _ -> show eit - - ---maybeRateStatus :: Item -> Maybe String ---maybeRateStatus it = case it ^? itUse . heldDelay . rateMaxMax of --- Nothing -> Nothing --- _ -> Just $ leftPad 3 ' ' (show (_rateMax . _heldDelay $ _itUse it)) diff --git a/src/Dodge/SelectionSections/Draw.hs b/src/Dodge/SelectionSections/Draw.hs index 3c5f5e70e..0989482e0 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/src/Dodge/SelectionSections/Draw.hs @@ -25,11 +25,13 @@ drawSelectionSections sss ldp cfig = (_ldpVerticalGap ldp) (_ldpScale ldp) 0 - (foldMap - (\ss -> translate (100*fromIntegral (_ssIndent ss)) 0 <$> - --(take (_ssShownLength ss) $ _ssShownItems ss)) sss) - (_ssShownItems ss) - ) sss) + ( foldMap + ( \ss -> + translate (100 * fromIntegral (_ssIndent ss)) 0 + <$> _ssShownItems ss + ) + sss + ) drawSSCursor :: IM.IntMap (SelectionSection a) -> diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index f13d21d4a..bff40ca55 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/src/Dodge/Zoning/Base.hs @@ -80,7 +80,7 @@ yIntercepts' s sp ep = map f $ xIntercepts s (f sp) (f ep) zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m) {-# INLINE zoneMonoid #-} -zoneMonoid !(V2 !x !y) a = IM.insertWith f x $! IM.singleton y a +zoneMonoid (V2 !x !y) a = IM.insertWith f x $! IM.singleton y a where f _ = IM.insertWith (<>) y a diff --git a/src/Padding.hs b/src/Padding.hs index 0c7f93b84..16bd84bbf 100644 --- a/src/Padding.hs +++ b/src/Padding.hs @@ -15,10 +15,6 @@ leftPad :: Int -> a -> [a] -> [a] {-# INLINE leftPad #-} leftPad i x xs = reverse $ take i $ reverse (take i xs) ++ repeat x ---fourCharInt :: Int -> String ---fourCharInt x --- | x < 10000 = leftPad 4 ' ' $ show x - rightPad :: Int -> a -> [a] -> [a] {-# INLINE rightPad #-} rightPad i x xs = take i $ xs ++ repeat x