Cleanup

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

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 = itemDisplay w cr ci
-        { _siPictures = pics -- & ix 0 %~ (++ anyequippos ++ anyhotkey)
         , _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 = w ^?! cWorld . lWorld . creatures . ix 0
-    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
 
+-- 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 =
+    | isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = ["!TARG!"]
-        ["!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]

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))

src/Dodge/SelectionSections/Draw.hs

@@ -25,11 +25,13 @@ drawSelectionSections sss ldp cfig =
             (_ldpVerticalGap ldp)
             (_ldpScale ldp)
             0
-            (foldMap 
+            ( foldMap
-                (\ss -> translate (100*fromIntegral (_ssIndent ss)) 0 <$> 
+                ( \ss ->
-                --(take (_ssShownLength ss) $ _ssShownItems ss)) sss)
+                    translate (100 * fromIntegral (_ssIndent ss)) 0
-                    (_ssShownItems ss)
+                        <$> _ssShownItems ss
-                ) sss)
+                )
+                sss
+            )
 
 drawSSCursor ::
     IM.IntMap (SelectionSection a) ->

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
 

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