justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Prevent selection of unselectable items when scrolling

Browse Source
This commit is contained in:
justin
2023-02-20 11:19:25 +00:00
parent ab69de73c7
commit 2e46123a92
6 changed files with 58 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+9 -6
View File
@@ -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
+16 -49
View File
@@ -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)
filtinvitems = case cr ^? crManipulation . invRegex . _Just of
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)
(filtinv,invx) = filtpair (-1) (crManipulation . invRegex . _Just) invitems' "INV. "
(filtclose,closex) = filtpair 2 (crManipulation . closeRegex . _Just) coitems' "NEARBY "
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
-1
View File
@@ -2,7 +2,6 @@
module Dodge.Inventory (
selSecSelPos,
firstPosSelectionSections,
checkInvSlotsYou,
rmSelectedInvItem,
selNumPos,
src/Dodge/Render/List.hs
-1
View File
@@ -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
+31 -22
View File
@@ -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
firstPosSelectionSections :: SelectionSections a -> SelectionSections a
firstPosSelectionSections sss = fromMaybe sss $ do
setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
setFirstPosSelectionSections sss = fromMaybe sss $ do
(i, j, _) <- ssLookupMin sss
return $
sss
& sssSelPos ?~ (i, j)
-- & sssSetCursor
-- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
--sssSetCursor :: SelectionSections a -> SelectionSections a
--sssSetCursor sss = sss
return $ sss & sssSelPos ?~ (i, j)
--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
(i, j) <- sss ^? sssSelPos . _Just
(i', j', _) <- ssLookupUp i j sss
return $ sss & sssSelPos ?~ (i', j')
scrollUpSelectionSections sss = sss & sssSelPos .~
fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where
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
(i, j) <- sss ^? sssSelPos . _Just
(i', j', _) <- ssLookupDown i j sss
return $ sss & sssSelPos ?~ (i', j')
scrollDownSelectionSections sss = sss & sssSelPos .~
fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where
f (i,j,_) = (i,j)
-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
src/Dodge/Update/Input.hs
+2 -2
View File
@@ -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