Prevent selection of unselectable items when scrolling

src/Dodge/Combine.hs

@@ -6,7 +6,7 @@ module Dodge.Combine (
 ) where
 
 import Dodge.Data.Universe
-import Regex
+--import Regex
 import Dodge.DisplayInventory
 import Dodge.Render.HUD
 import Dodge.SelectionList
@@ -53,7 +53,6 @@ combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
 
 combineList :: World -> [SelectionItem CombinableItem]
 combineList w = case combineList' w of
-    -- [] -> [SelectionInfo ["No possible combinations"] 1 False 0 white 0]
     [] -> [SelectionInfo ["No possible combinations"] 1 False white 0]
     xs -> xs
 
@@ -140,22 +139,26 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
 
 enterCombineInv :: Configuration -> World -> World
 enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory 
-    cm
+    cm'
     Nothing 
     sss
     --(updateCombineSelections w cfig sss)
   where
-    cm = IM.fromAscList $ zip [0..] $ combineList w
+    cm' = IM.fromAscList $ zip [0..] $ combineList' w 
+    cm | null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
+       | otherwise = cm'
     sss = SelectionSections  
         { _sssSections = IM.singleton 0 combsection
-        , _sssSelPos = Just (0,0)
+        , _sssSelPos = selpos
         }
+    selpos | null cm' = Nothing
+       | otherwise = Just (0,0)
     availablelines = getAvailableListLines secondColumnParams cfig
     combsection = updateSection cm (Just 0) availablelines combinationssection'
     combinationssection' = SelectionSection
         { _ssItems = cm
         , _ssCursor = do
-            (i,si) <- IM.lookupMin cm
+            (_,si) <- IM.lookupMin cm
             return $ SectionCursor 0 (length (_siPictures si)) (_siColor si)
         , _ssMinSize = 5
         , _ssOffset = 0

src/Dodge/DisplayInventory.hs

@@ -4,7 +4,6 @@ module Dodge.DisplayInventory
     , defaultSS
     , defaultFiltSection
     , defaultDisplaySections
---    , updateSections
     , updateSection
     ) where
 
@@ -39,36 +38,32 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
         SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex]
         InNearby SortNearby ->  reverse [filtinv,filtclose,closex, invx ,youx]
         InNearby SelCloseObject {} ->  reverse [filtinv,filtclose,closex, invx ,youx]
-    filtinv = (-1,filtinvitems)
+    (filtinv,invx) = filtpair (-1) (crManipulation . invRegex . _Just) invitems' "INV. "
-    filtinvitems = case cr ^? crManipulation . invRegex . _Just of
+    (filtclose,closex) = filtpair 2 (crManipulation . closeRegex . _Just) coitems' "NEARBY "
-        Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0)
-        Nothing -> mempty
-    filtclose = (2,filtcloseitems)
-    filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of
-        Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0)
-        Nothing -> mempty
-    numfiltitems = "  " ++ show numfiltitems' ++ " FILTERED"
-    numfiltitems' = length invitems' - length invitems
-    numfiltclose = "  " ++ show numfiltclose' ++ " FILTERED"
-    numfiltclose' = length coitems' - length coitems
-    invx = (0, invitems)
     youx = (1, youitems)
-    closex = (3, coitems)
     youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
     thetext = displayFreeSlots nfreeslots
     availablelines = getAvailableListLines (invDisplayParams w) cfig
     coitems' = IM.fromDistinctAscList . zip [0..] 
         $ map closeObjectToSelectionItem (w ^. hud . closeObjects)
-    coitems = case cr ^? crManipulation . closeRegex . _Just of
-        Just str -> IM.filter (regexList str . _siPictures) coitems'
-        Nothing -> coitems'
     invitems' = IM.mapWithKey (invSelectionItem' cr) inv
-    invitems = case cr ^? crManipulation . invRegex . _Just of
-        Just str -> IM.filter (regexList str . _siPictures) invitems'
-        Nothing -> invitems'
     cr = you w
     inv = _crInv (you w)
     nfreeslots = crNumFreeSlots cr
+    filtpair i regpointer itms filtdescription = 
+        ( ( i, filtsis)
+        , ( i+1, itms')
+        )
+      where
+        mstr = cr ^? regpointer
+        filtsis = fromMaybe mempty $ do
+            str <- mstr
+            return $ IM.singleton 0 
+                (SelectionRegex [filtdescription ++ "FILTER: "++str,numfiltitems] 2 True white 0)
+        itms' = fromMaybe itms $ do
+            str <- mstr
+            return $ IM.filter (regexList str . _siPictures) itms
+        numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
 
 displayFreeSlots :: Int -> String
 displayFreeSlots x = case x of
@@ -76,7 +71,6 @@ displayFreeSlots x = case x of
     1 -> "1 FREE SLOT"
     _ -> show x ++ " FREE SLOTS"
 
-
 updateSectionsPositioning 
     :: SelectionSections a
     -> Int -> [(Int,IM.IntMap (SelectionItem a))]
@@ -96,33 +90,6 @@ updateSectionsPositioning sss allavailablelines ((k,y) : xs)
     linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
     previoussections = updateSectionsPositioning sss availablelines xs
 
---updateSectionsPositioning 
---    :: SelectionSections a
---    -> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))]
---    -> SelectionSections a
---updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty
---updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs)
--- = previoussections & sssSections %~ IM.insert k ss
---  where
---    ss  | i == k = updateSection (Just j) y linesleft x
---        | otherwise = updateSection Nothing y linesleft x
---    x = sss ^?! sssSections . ix k
---    availablelines = allavailablelines - _ssMinSize x
---    linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ _sssSections previoussections)
---    previoussections = updateSectionsPositioning sss availablelines (i,j) xs
-
---updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))]
---    -> IM.IntMap (SelectionSection a)
---updateSections _ _ [] = mempty
---updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss previoussections
---  where
---    ss  | i == k = updateSection y linesleft x
---        | otherwise = updateSection y linesleft x
---    availablelines = allavailablelines - _ssMinSize x
---    linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections)
---    previoussections = updateSections availablelines (i,j) xs
-
-
 manObjIndex :: ManipulatedObject -> (Int,Int)
 manObjIndex mo = case mo of
     InInventory SortInventory -> (-1, 0)

src/Dodge/Inventory.hs

@@ -2,7 +2,6 @@
 
 module Dodge.Inventory (
     selSecSelPos,
-    firstPosSelectionSections,
     checkInvSlotsYou,
     rmSelectedInvItem,
     selNumPos,

src/Dodge/Render/List.hs

@@ -2,7 +2,6 @@ module Dodge.Render.List where
 
 --import Picture.Text
 import Dodge.Inventory
-import qualified Data.IntMap.Strict as IM
 --import Data.Foldable
 import Dodge.SelectionList
 import Data.Maybe

src/Dodge/SelectionSections.hs

@@ -3,9 +3,10 @@ module Dodge.SelectionSections (
     ssLookupDown,
     ssLookupGT,
     ssSetCursor,
-    firstPosSelectionSections,
+    setFirstPosSelectionSections,
 ) where
 
+import Control.Applicative
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
@@ -17,33 +18,41 @@ scrollSelectionSections yi sss
     | yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections
     | otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections
 
--- when is this used? it needs to correctly set the cursor
+setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
-firstPosSelectionSections :: SelectionSections a -> SelectionSections a
+setFirstPosSelectionSections sss = fromMaybe sss $ do
-firstPosSelectionSections sss = fromMaybe sss $ do
     (i, j, _) <- ssLookupMin sss
-    return $
+    return $ sss & sssSelPos ?~ (i, j)
-        sss
-            & sssSelPos ?~ (i, j)
-
---        & sssSetCursor
---        & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
-
---sssSetCursor :: SelectionSections a -> SelectionSections a
---sssSetCursor sss = sss
 
+--scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
+--scrollUpSelectionSections sss = fromMaybe (setFirstPosSelectionSections sss) $ do
+--    (i, j) <- sss ^? sssSelPos . _Just
+--    (i', j', _) <- ssLookupUp i j sss
+--    return $ sss & sssSelPos ?~ (i', j')
 scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
-scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
+scrollUpSelectionSections sss = sss & sssSelPos .~
-    (i, j) <- sss ^? sssSelPos . _Just
+    fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
-    (i', j', _) <- ssLookupUp i j sss
+  where
-    return $ sss & sssSelPos ?~ (i', j')
+    f (i,j,_) = (i,j)
 
---        & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
+ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssScrollUp sss = l <|> ssLookupMin sss
+  where
+    l = do
+        (i,j) <- sss ^? sssSelPos . _Just
+        ssLookupUp i j sss
+
+ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssScrollDown sss = l <|> ssLookupMin sss
+  where
+    l = do
+        (i,j) <- sss ^? sssSelPos . _Just
+        ssLookupDown i j sss
 
 scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
-scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
+scrollDownSelectionSections sss = sss & sssSelPos .~
-    (i, j) <- sss ^? sssSelPos . _Just
+    fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
-    (i', j', _) <- ssLookupDown i j sss
+  where
-    return $ sss & sssSelPos ?~ (i', j')
+    f (i,j,_) = (i,j)
 
 --        & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
 

src/Dodge/Update/Input.hs

@@ -57,7 +57,7 @@ updateUseInputInGame h u = case h of
                 u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
         CombineInventory _ _ sss
             | inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u
-            | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u -- maybeexitcombine (maybe id doCombine mi w)
+            | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u
         _ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u
         _ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u
         _ -> M.foldlWithKey' updateKeyInGame u pkeys
@@ -76,7 +76,7 @@ tryCombine sss w = fromMaybe w $ do
 maybeExitCombine :: Universe -> Universe
 maybeExitCombine u
     | ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons)
-        = u
+        = u & uvWorld %~ enterCombineInv (u ^. uvConfig)
     | otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
 
 doTextInputOver :: ASetter' Universe String -> Universe -> Universe