Cleanup, tweak selection sections positioning

src/Dodge/Creature/State.hs

@@ -237,9 +237,10 @@ invSideEff :: Creature -> World -> World
 invSideEff cr w =
     updateTargeting (crGetTargeting cr) cr $
         weaponReloadSounds cr $
-                IM.foldl' f w (_crInv 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,10 +259,11 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff
     attachoff = it ^?! itDimension . dimAttachPos
 
 itemUpdate :: Creature -> Int -> Item -> Item
-itemUpdate cr i = updateAutoRecharge
+itemUpdate cr i =
-            . (itUse %~ useUpdate)
+    updateAutoRecharge
-            . (itLocation .~ InInv (_crID cr) i)
+        . (itUse %~ useUpdate)
-            . (itIsHeld .~ itmisheld)
+        . (itLocation .~ InInv (_crID cr) i)
+        . (itIsHeld .~ itmisheld)
   where
     itmisheld = Just i == (cr ^? crManipulation . manObject . inInventory . ispItem)
 

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
@@ -35,62 +35,42 @@ import SDL (MouseButton (..))
 drawHUD :: Configuration -> World -> Picture
 drawHUD cfig w = case w ^. hud . hudElement of
     DisplayCarte -> drawCarte cfig w
-    DisplayInventory {_diSections = sections, _subInventory = subinv} ->
+    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
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w
     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
-            <> 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
+drawCombineInventory :: Configuration -> SelectionSections CombinableItem -> World -> Picture
-titledSub' cfig subtitle subitems =
+drawCombineInventory cfig sss w =
-    invHead cfig subtitle
+    invHead cfig "COMBINE"
-        <> drawSelectionSections subitems secondColumnParams cfig
+        <> drawSelectionSections sss secondColumnParams cfig
+        <> combineInventoryExtra sss cfig w
 
 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,15 +78,15 @@ drawExamineInventory cfig mtweaki w =
             { _siPictures = [str]
             , _siHeight = 1
             , _siIsSelectable = True
-            --, _siWidth = length str
+            , --, _siWidth = length str
-            , _siColor = white
+              _siColor = white
             , _siOffX = 0
             , _siPayload = ()
             }
 
 closeObjectInfo :: Int -> Either FloorItem Button -> String
 closeObjectInfo n x = case x of
-    Left FlIt{_flIt = itm} -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm 
+    Left FlIt{_flIt = itm} -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm
     Right _ -> "Some sort of switch or button."
 
 floorItemPickupInfo :: Int -> Item -> String
@@ -114,10 +94,10 @@ floorItemPickupInfo n itm
     | n >= ceiling (_itInvSize itm) = ", but you have space to pick it up."
     | otherwise = ", and you don't have space to pick it up."
 
--- note the use of ^?! 
+-- note the use of ^?!
 -- it is probably desirable for this to crash hard for now
 yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
-yourAugmentedItem  f x g w = case you w ^? crManipulation . manObject of
+yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
     Just (InInventory (SelItem i _)) -> f $ yourInv w ^?! ix i
     Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
     _ -> x
@@ -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,11 +133,12 @@ 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))
+
+--        , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
 
 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
 combineInventoryExtra sss cfig w = fromMaybe mempty $ do
-    (i,j) <- sss ^? sssExtra . sssSelPos . _Just
+    (i, j) <- sss ^? sssExtra . sssSelPos . _Just
     si <- sss ^? sssSections . ix i . ssItems . ix j
     cpos <- selSecSelPos i j sss
     let col = _siColor si
@@ -175,7 +157,8 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
   where
     invcursor i = fromMaybe mempty $ do
         sss' <- w ^? hud . hudElement . diSections
-        return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss' 0 i
+        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,10 +206,11 @@ 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 =
-        { _slItems = thelist tm
+        defaultSelectionList
---        , _slLength = length (thelist tm)
+            { _slItems = thelist tm
-        }
+            --        , _slLength = length (thelist tm)
+            }
     thelist tm =
         map toselitm . displayTermInput tm
             . reverse
@@ -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 =