Cleanup, tweak selection sections positioning

src/Dodge/Creature/State.hs

@@ -238,8 +238,9 @@ invSideEff cr w =
     updateTargeting (crGetTargeting cr) cr $
         weaponReloadSounds cr $
             IM.foldl' f w (_crInv cr)
-    -- be careful with side effects that affect creature targeting
   where
+    -- be careful with side effects that affect creature targeting
+
     f w' it =
         itemInvSideEffect cr it $
             --doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
@@ -258,7 +259,8 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff
     attachoff = it ^?! itDimension . dimAttachPos
 
 itemUpdate :: Creature -> Int -> Item -> Item
-itemUpdate cr i = updateAutoRecharge
+itemUpdate cr i =
+    updateAutoRecharge
         . (itUse %~ useUpdate)
         . (itLocation .~ InInv (_crID cr) i)
         . (itIsHeld .~ itmisheld)

src/Dodge/Data/SelectionList.hs

@@ -82,14 +82,6 @@ data SelectionItem a = SelectionItem
     , _siColor  :: Color
     , _siOffX   :: Int
     }
-    | SelectionRegex
-    { _siPictures :: [String]
-    , _siHeight :: Int
-    , _siIsSelectable :: Bool
-    , _siColor  :: Color
-    , _siOffX   :: Int
-    }
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''ListDisplayParams
 makeLenses ''SelectionList

src/Dodge/DisplayInventory.hs

@@ -58,7 +58,7 @@ updateCombineSections w cfig sss =
         return $
             IM.singleton
                 0
-                (SelectionRegex ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
+                (SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
     mstr = w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . ix (-1) . _Just
     numfiltitems = "  " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
 
@@ -108,7 +108,7 @@ updateDisplaySections w cfig sss =
     coitems' =
         IM.fromDistinctAscList . zip [0 ..] $
             map closeObjectToSelectionItem (w ^. hud . closeObjects)
-    invitems' = IM.mapWithKey (invSelectionItem' cr) inv
+    invitems' = IM.mapWithKey (invSelectionItem cr) inv
     cr = you w
     inv = _crInv (you w)
     nfreeslots = crNumFreeSlots cr
@@ -123,7 +123,7 @@ updateDisplaySections w cfig sss =
             return $
                 IM.singleton
                     0
-                    (SelectionRegex [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
+                    (SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
         itms' = fromMaybe itms $ do
             str <- mstr
             return $ IM.filter (plainRegex str) itms
@@ -136,10 +136,10 @@ updateInventorySectionItems w = w
   where
     f olditems = fromMaybe olditems $ do
         cr <- w ^? cWorld . lWorld . creatures . ix 0
-        invitms <- cr ^? crInv
+        invitms <- IM.mapWithKey (invSelectionItem cr) <$> cr ^? crInv
         return $ case w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just of
-            Just str -> IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms
+            Just str -> IM.filter (plainRegex str) invitms
-            _ -> IM.mapWithKey (invSelectionItem' cr) invitms
+            _ -> invitms
 
 plainRegex :: String -> SelectionItem a -> Bool
 plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si))
@@ -193,7 +193,10 @@ updateSection sis mcsel availablelines ss =
             csize = length $ _siPictures si
             ccolor = _siColor si
         return $ SectionCursor (cpos - offset) csize ccolor
-    offset = fromMaybe oldoffset $ do
+    nocursoroffset = if length allstrings - oldoffset <= availablelines 
+        then max 0 (length allstrings - availablelines)
+        else oldoffset
+    offset = fromMaybe nocursoroffset $ do
         csel <- mcsel
         maxcsel <- fst <$> IM.lookupMax sis
         si <- sis ^? ix csel

src/Dodge/Inventory.hs

@@ -307,7 +307,6 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
             Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
     Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
   where
-    --invsel = crSel (you w)
     minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
     cr = you w
     invselcanactivate = isJust $ do

src/Dodge/Inventory/SelectionList.hs

@@ -1,6 +1,5 @@
 module Dodge.Inventory.SelectionList 
     ( invSelectionItem
-    , invSelectionItem'
     , closeObjectToSelectionItem
     )
     where
@@ -12,14 +11,8 @@ import Dodge.Data.SelectionList
 import Dodge.Data.World
 import LensHelp
 
---makeInventorySelectionList :: World -> SelectionList ()
+invSelectionItem :: Creature ->  Int -> Item -> SelectionItem ()
---makeInventorySelectionList w = defaultSelectionList
+invSelectionItem cr i it = SelectionItem
---    & slItems .~ inventorySelectionList w
---    & slSelPos .~ inventoryCursorPos w
---
---
-invSelectionItem' :: Creature ->  Int -> Item -> SelectionItem ()
-invSelectionItem' cr i it = SelectionItem
     { _siPictures = pics
     , _siHeight = length pics
     , _siIsSelectable = True
@@ -35,23 +28,6 @@ invSelectionItem' cr i it = SelectionItem
         _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
         _ -> itemDisplay it
 
-invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
-invSelectionItem cr (i,it) = SelectionItem
-    { _siPictures = pics
-    , _siHeight = length pics
-    , _siIsSelectable = True
-    --, _siWidth = 15
-    , _siColor = col
-    , _siOffX = 0
-    , _siPayload = ()
-    }
-  where
-    col = _itInvColor it
-    pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
-        UndroppableIdentified -> itemDisplay it
-        _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
-        _ -> itemDisplay it
---
 closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem ()
 closeObjectToSelectionItem e = SelectionItem
     { _siPictures = pics

src/Dodge/ListDisplayParams.hs

@@ -1,4 +1,8 @@
-module Dodge.ListDisplayParams where
+module Dodge.ListDisplayParams 
+    ( invDisplayParams
+    , secondColumnParams
+    , subInvX
+    ) where
 
 import Dodge.Data.CardinalPoint
 import SDL (MouseButton (..))

src/Dodge/Render/HUD.hs

@@ -3,23 +3,23 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
-import Dodge.ListDisplayParams
+import Dodge.SelectionSections.Draw
-import Dodge.Inventory
-import Dodge.Data.Combine
-import Dodge.Default.SelectionList
-import Dodge.Creature.Info
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Vector as V
 import Dodge.Base
 import Dodge.Clock
---import Dodge.Combine
+import Dodge.Creature.Info
 import Dodge.Data.CardinalPoint
+import Dodge.Data.Combine
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.World
+import Dodge.Default.SelectionList
+import Dodge.Inventory
 import Dodge.Item.Info
+import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
 import Dodge.Render.List
 import Dodge.Tweak.Show
@@ -37,31 +37,15 @@ drawHUD cfig w = case w ^. hud . hudElement of
     DisplayCarte -> drawCarte cfig w
     DisplayInventory{_diSections = sections, _subInventory = subinv} ->
         drawHP cfig w
-            <> inventoryDisplay sections w cfig
+            <> drawInventory sections w cfig
             <> drawSubInventory subinv cfig w
 
 drawHP :: Configuration -> World -> Picture
 drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w
 
 
-drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
+drawInventory :: SelectionSections () -> World -> Configuration -> Picture
-drawSelectionSections sss ldps cfig = listPicturesAtScaleOff
+drawInventory sss w = drawSelectionSections sss (invDisplayParams w)
-    (_ldpVerticalGap ldps)
-    (_ldpScale ldps)
-    (_ldpPosX ldps)
-    (_ldpPosY ldps)
-    cfig
-    0
-    pics
-    <> thecursor'
-  where
-    thecursor' = fromMaybe mempty $ do
-        (i,j) <- sss ^? sssExtra . sssSelPos . _Just
-        return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j
-    pics = foldMap _ssShownItems (_sssSections sss)
-
-inventoryDisplay :: SelectionSections () -> World -> Configuration -> Picture
-inventoryDisplay sss w = drawSelectionSections sss (invDisplayParams w)
 
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
@@ -69,28 +53,24 @@ drawSubInventory subinv cfig w = case subinv of
     NoSubInventory -> drawNoSubInventory cfig w
     ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
     DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
-    CombineInventory {_ciSections = sss}
+    CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
-        -> titledSub' cfig "COMBINE" sss
+
+
+drawCombineInventory :: Configuration -> SelectionSections CombinableItem -> World -> Picture
+drawCombineInventory cfig sss w =
+    invHead cfig "COMBINE"
+        <> drawSelectionSections sss secondColumnParams cfig
         <> combineInventoryExtra sss cfig w
 
-titledSub :: Configuration -> String -> SelectionList a -> Picture
-titledSub cfig subtitle subitems =
-    invHead cfig subtitle
-        <> drawSelectionList secondColumnParams cfig subitems
-
-titledSub' :: Configuration -> String -> SelectionSections a -> Picture
-titledSub' cfig subtitle subitems =
-    invHead cfig subtitle
-        <> drawSelectionSections subitems secondColumnParams cfig
-
 drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
 drawExamineInventory cfig mtweaki w =
-    titledSub
+    invHead cfig "EXAMINE"
-        cfig
-        "EXAMINE"
-        (defaultSelectionList & slItems .~ ammoTweakSelectionItems itm 
-            ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w)) ) w))
         <> examineInventoryExtra mtweaki itm cfig
+        <> drawSelectionList secondColumnParams 
+        cfig
+        ( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm
+            ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w))) w)
+        )
   where
     itm = yourItem w
     f str =
@@ -98,8 +78,8 @@ drawExamineInventory cfig mtweaki w =
             { _siPictures = [str]
             , _siHeight = 1
             , _siIsSelectable = True
-            --, _siWidth = length str
+            , --, _siWidth = length str
-            , _siColor = white
+              _siColor = white
             , _siOffX = 0
             , _siPayload = ()
             }
@@ -134,8 +114,9 @@ drawNoSubInventory cfig w =
         invid <- cr ^. crLeftInvSel . lisMPos
         sss <- w ^? hud . hudElement . diSections
         pos <- selSecSelPos 0 invid sss
-        return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText 
+        return $
-            $ _crInvEquipped cr IM.! invid
+            listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $
+                _crInvEquipped cr IM.! invid
     f col invid epos = fromMaybe mempty $ do
         sss <- w ^? hud . hudElement . diSections
         pos <- selSecSelPos 0 invid sss
@@ -152,6 +133,7 @@ examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
     -- consider moving this functionality out into a tweaks module
     tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
     return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
+
 --        , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
 
 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
@@ -176,6 +158,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
     invcursor i = fromMaybe mempty $ do
         sss' <- w ^? hud . hudElement . diSections
         return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i
+
 --    fromMaybe mempty $ do
 --    i <- mi
 --    let cpos = getIthPos i (sm ^. smShownItems)
@@ -198,8 +181,6 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
 --        sss <- w ^? hud . hudElement . diSections
 --        return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
 
-
-
 --thirdColumnPara :: [String] -> SelectionList ()
 --thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
 --  where
@@ -225,7 +206,8 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
   where
     --toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 ()
     toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
-    thesellist tm = defaultSelectionList 
+    thesellist tm =
+        defaultSelectionList
             { _slItems = thelist tm
             --        , _slLength = length (thelist tm)
             }
@@ -244,12 +226,15 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
         | otherwise = []
 
 drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
-drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} 
+drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
-    = fromMaybe mempty $ do
+    fromMaybe mempty $ do
-        curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
+        sss <- w ^? hud . hudElement . diSections
+        (i', j) <- sss ^? sssExtra . sssSelPos . _Just
+        curpos <- selSecSelPos i' j sss
         let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
         let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
-        return $ listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
+        return $
+            listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
                 <> case ae of
                     DoNotMoveEquipment -> mempty
                     PutOnEquipment{} ->
@@ -279,8 +264,6 @@ eqPosText ep = case ep of
     OnLegs -> "LEGS"
     OnSpecial -> "EQUIPPED"
 
-
-
 combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = winScale cfig . foldMap f . group
   where
@@ -293,7 +276,8 @@ combineCounts cfig w = winScale cfig . foldMap f . group
     f _ = mempty
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
-lnkMidPosInvSelsCol cfig w i col = winScale cfig
+lnkMidPosInvSelsCol cfig w i col =
+    winScale cfig
         . foldMap f
   where
     f j = fromMaybe mempty $ do
@@ -305,8 +289,6 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig
     hh = halfHeight cfig
     hw = halfWidth cfig
 
-
-
 ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
 ammoTweakSelectionItems = textSelItems . ammoTweakStrings
 
@@ -418,8 +400,8 @@ picsToSelectable pics =
         { _siPictures = pics
         , _siHeight = length pics
         , _siIsSelectable = True
-        --, _siWidth = wdth
+        , --, _siWidth = wdth
-        , _siColor = white
+          _siColor = white
         , _siOffX = 0
         , _siPayload = ()
         }

src/Dodge/Update/Scroll.hs

@@ -49,8 +49,9 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
     invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
 
 moveCombineSel :: Int -> World -> World
-moveCombineSel yi = hud . hudElement . subInventory . ciSections
+moveCombineSel yi = (hud . hudElement . subInventory . ciSections
-    %~ scrollSelectionSections yi
+    %~ scrollSelectionSections yi)
+    .  (worldEventFlags . at CombineInventoryChange ?~ ())
 
 moveSubSel :: Int -> Int -> World -> World
 moveSubSel yi maxyi =