diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index d03bdcacb..9d55c9f86 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -114,29 +114,29 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig) -updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem - -> SelectionSections CombinableItem -updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt] - where - availablelines = getAvailableListLines secondColumnParams cfig - filt = (-1, (filtsec,filtitems)) - filtsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1) - filtitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of - Just str -> IM.singleton 0 (SelectionRegex ["COMB. FILTER: " ++ str,numfiltitems] 2 True white 0) - Nothing -> mempty - numfiltitems = " " ++ show numfiltitems' ++ " FILTERED" - numfiltitems' = length combitems' - length combitems - combs :: (Int , (SelectionSection CombinableItem , IM.IntMap (SelectionItem CombinableItem))) - combs = (0, (combsec,combitems)) - combsec = fromMaybe (defaultSS & ssDescriptor .~ "COMBINATIONS") $ sss ^? sssSections . ix 0 - combitems' = fromMaybe mempty $ w ^? hud . hudElement . subInventory . ciCombinations - combitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of - Just str -> IM.filter (regexList str . _siPictures) combitems' - Nothing -> combitems' - ij = fromMaybe (0,0) $ do - i <- sss ^? sssSelPos . _Just - j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel - return (i,j) +--updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem +-- -> SelectionSections CombinableItem +--updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt] +-- where +-- availablelines = getAvailableListLines secondColumnParams cfig +-- filt = (-1, (filtsec,filtitems)) +-- filtsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1) +-- filtitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of +-- Just str -> IM.singleton 0 (SelectionRegex ["COMB. FILTER: " ++ str,numfiltitems] 2 True white 0) +-- Nothing -> mempty +-- numfiltitems = " " ++ show numfiltitems' ++ " FILTERED" +-- numfiltitems' = length combitems' - length combitems +-- combs :: (Int , (SelectionSection CombinableItem , IM.IntMap (SelectionItem CombinableItem))) +-- combs = (0, (combsec,combitems)) +-- combsec = fromMaybe (defaultSS & ssDescriptor .~ "COMBINATIONS") $ sss ^? sssSections . ix 0 +-- combitems' = fromMaybe mempty $ w ^? hud . hudElement . subInventory . ciCombinations +-- combitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of +-- Just str -> IM.filter (regexList str . _siPictures) combitems' +-- Nothing -> combitems' +-- ij = fromMaybe (0,0) $ do +-- i <- sss ^? sssSelPos . _Just +-- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel +-- return (i,j) enterCombineInv :: Configuration -> World -> World enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory @@ -148,15 +148,15 @@ enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory cm = IM.fromAscList $ zip [0..] $ combineList w sss = SelectionSections { _sssSections = IM.singleton 0 combsection - , _sssSelPos = Just 0 + , _sssSelPos = Just (0,0) } availablelines = getAvailableListLines secondColumnParams cfig - combsection = updateSection (Just 0) cm availablelines combinationssection' + combsection = updateSection cm (Just 0) availablelines combinationssection' combinationssection' = SelectionSection { _ssItems = cm , _ssCursor = do (i,si) <- IM.lookupMin cm - return $ SectionCursor i 0 (length (_siPictures si)) (_siColor si) + return $ SectionCursor 0 (length (_siPictures si)) (_siColor si) , _ssMinSize = 5 , _ssOffset = 0 , _ssShownItems = mempty diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 210e713f4..c564daf40 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -32,12 +32,12 @@ data SelectionList a = SelectionList data SelectionSections a = SelectionSections { _sssSections :: IntMap (SelectionSection a) - , _sssSelPos :: Maybe Int + , _sssSelPos :: Maybe (Int,Int) } data SectionCursor = SectionCursor - { _scurSel :: Int - , _scurPos :: Int + --{ _scurSel :: Int + { _scurPos :: Int , _scurSize :: Int , _scurColor :: Color } diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 741ace977..7cf68e4b2 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -146,7 +146,7 @@ defaultLWorld = defaultDisplaySections :: SelectionSections a defaultDisplaySections = SelectionSections { _sssSections = mempty - , _sssSelPos = Just 0 + , _sssSelPos = Just (0,0) } defaultHUD :: HUD diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index fb428f0cb..af00e49e3 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -4,10 +4,11 @@ module Dodge.DisplayInventory , defaultSS , defaultFiltSection , defaultDisplaySections - , updateSections +-- , updateSections , updateSection ) where +import Control.Monad import Regex import Data.Maybe import Picture.Base @@ -26,13 +27,10 @@ import Dodge.Data.World updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of --- Just mo -> sss --- { _sssSections = updateSections availablelines (manObjIndex mo) $ addorder mo --- , _sssSelPos = Just (fst $ manObjIndex mo) --- } - Just mo -> updateSectionsPositioning sss - { _sssSelPos = Just (fst $ manObjIndex mo) - } availablelines (manObjIndex mo) $ addorder mo + Just mo -> updateSectionsPositioning + (sss & sssSelPos ?~ manObjIndex mo) + availablelines + (addorder mo) _ -> error "error when getting cr inv sel" where addorder mo = case mo of @@ -41,16 +39,11 @@ 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,(filtinvsec,filtinvitems)) filtinv = (-1,filtinvitems) - filtinvsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1) 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,(filtclosesec,filtcloseitems)) filtclose = (2,filtcloseitems) - filtclosesec = fromMaybe (defaultFiltSection & ssIndent .~ 2) - $ sss ^? sssSections . ix 2 filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0) Nothing -> mempty @@ -59,16 +52,11 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of numfiltclose = " " ++ show numfiltclose' ++ " FILTERED" numfiltclose' = length coitems' - length coitems invx = (0, invitems) - --invx = (0,(invsec, invitems)) youx = (1, youitems) - --youx = (1,(yousec, youitems)) - --closex = (3,(cosec, coitems)) closex = (3, coitems) youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () thetext = displayFreeSlots nfreeslots availablelines = getAvailableListLines (invDisplayParams w) cfig - cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 3 - invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0 coitems' = IM.fromDistinctAscList . zip [0..] $ map closeObjectToSelectionItem (w ^. hud . closeObjects) coitems = case cr ^? crManipulation . closeRegex . _Just of @@ -91,29 +79,48 @@ displayFreeSlots x = case x of updateSectionsPositioning :: SelectionSections a - -> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))] + -> Int -> [(Int,IM.IntMap (SelectionItem a))] -> SelectionSections a -updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty -updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs) +updateSectionsPositioning sss _ [] = sss & sssSections .~ mempty +updateSectionsPositioning sss allavailablelines ((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 + mscel = do + (i,j) <- sss ^? sssSelPos . _Just + guard $ i == k + return j + ss = updateSection y mscel 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 + linesleft = allavailablelines - sum (fmap linestaken $ _sssSections previoussections) + linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss') + previoussections = updateSectionsPositioning sss availablelines 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 (Just j) y linesleft x - | otherwise = updateSection Nothing y linesleft x - availablelines = allavailablelines - _ssMinSize x - linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections) - previoussections = updateSections availablelines (i,j) 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) @@ -125,12 +132,12 @@ manObjIndex mo = case mo of InNearby (SelCloseObject i) -> (3,i) updateSection - :: Maybe Int - -> IM.IntMap (SelectionItem a) + :: IM.IntMap (SelectionItem a) + -> Maybe Int -> Int -> SelectionSection a -> SelectionSection a -updateSection mcsel sis availablelines ss = ss +updateSection sis mcsel availablelines ss = ss { _ssItems = sis , _ssCursor = scurs , _ssOffset = offset @@ -140,11 +147,11 @@ updateSection mcsel sis availablelines ss = ss oldoffset = ss ^. ssOffset scurs = do csel <- mcsel - si <- sis ^? ix csel + (_,si) <- IM.lookupGE csel sis -- this is not right let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis) csize = length $ _siPictures si ccolor = _siColor si - return $ SectionCursor csel (cpos - offset) csize ccolor + return $ SectionCursor (cpos - offset) csize ccolor offset = fromMaybe oldoffset $ do csel <- mcsel maxcsel <- fst <$> IM.lookupMax sis @@ -178,12 +185,3 @@ updateSection mcsel sis availablelines ss = ss theindent = replicate (_ssIndent ss) ' ' xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss g si = map (_siColor si ,) $ _siPictures si - -yousec :: SelectionSection () -yousec = defaultSS - & ssCursor ?~ SectionCursor 0 0 1 invDimColor --- & ssRegex .~ UnavailableRegex - & ssIndent .~ 2 - & ssMinSize .~ 1 - & ssDescriptor .~ "YOUR STATUS" - diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 639392a40..eeb2f961e 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -21,19 +21,19 @@ inTermFocus w = fromMaybe False $ do inInvRegex :: World -> Bool inInvRegex w = fromMaybe False $ do sss <- w ^? hud . hudElement . diSections - i <- sss ^? sssSelPos . _Just + i <- sss ^? sssSelPos . _Just . _1 return $ i == (-1) inCloseRegex :: World -> Bool inCloseRegex w = fromMaybe False $ do sss <- w ^? hud . hudElement . diSections - i <- sss ^? sssSelPos . _Just + i <- sss ^? sssSelPos . _Just . _1 return $ i == 2 inSubInvRegex :: World -> Bool inSubInvRegex w = fromMaybe False $ do sss <- w ^? hud . hudElement . subInventory . ciSections - i <- sss ^? sssSelPos . _Just + i <- sss ^? sssSelPos . _Just . _1 return $ i == (-1) inputFocus :: World -> Bool diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 9c59e49e0..18c9fafb4 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -2,9 +2,6 @@ module Dodge.Inventory ( selSecSelPos, - ssLookupDown, - ssLookupGT, - ssSetCursor, firstPosSelectionSections, checkInvSlotsYou, rmSelectedInvItem, @@ -18,7 +15,7 @@ module Dodge.Inventory ( updateTerminal, closeObjScrollDir, changeSwapInvSel, - changeAugInvSel, + scrollAugInvSel, crNumFreeSlots, crInvSize, selectedCloseObject, @@ -67,15 +64,15 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount & doanyitemeffect & pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.mapKeys g - & updatemanipulation + & updateselection where getcid = cWorld . lWorld . creatures . ix cid pointcid = cWorld . lWorld . creatures . ix cid - updatemanipulation + updateselection | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid - = (pointcid . crManipulation . manObject . inInventory . ispItem %~ g) . changeAugInvSel (-1) + = scrollAugInvSel (-1) . scrollAugInvSel 1 | otherwise = pointcid . crManipulation . manObject . inInventory . ispItem %~ g @@ -181,9 +178,9 @@ updateCloseObjects w = updatecursorposifnecessary = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of Just i - | i >= length newcloseobjects -> changeAugInvSel 1 + | i >= length newcloseobjects -> scrollAugInvSel 1 | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) - -> changeAugInvSel (-1) + -> scrollAugInvSel (-1) _ -> id filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w ypos = _crPos $ you w @@ -360,8 +357,8 @@ changeSwapInvSel k w = case you w ^? crManipulation . manObject of n = length $ _crInv cr numCO = length $ w ^. hud . closeObjects -changeAugInvSel :: Int -> World -> World -changeAugInvSel yi w +scrollAugInvSel :: Int -> World -> World +scrollAugInvSel yi w | yi == 0 = w | otherwise = w & hud . hudElement . diSections %~ scrollSelectionSections yi @@ -373,8 +370,8 @@ setInvPosFromSS w = w where thesel = fromMaybe SelNothing $ do sss <- w ^? hud . hudElement . diSections - i <- sss ^? sssSelPos . _Just - j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel + (i,j) <- sss ^? sssSelPos . _Just +-- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel case i of (-1) -> Just $ InInventory SortInventory 0 -> Just $ InInventory (SelItem j NoInvSelAction) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 34e216e51..17d42796b 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -81,8 +81,7 @@ drawSelectionSections sss ldps cfig = listPicturesAtScaleOff <> thecursor' where thecursor' = fromMaybe mempty $ do - i <- sss ^? sssSelPos . _Just - j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel + (i,j) <- sss ^? sssSelPos . _Just return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j pics = foldMap _ssShownItems (_sssSections sss) diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index fccf94e3f..9bb536346 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -1,104 +1,121 @@ -module Dodge.SelectionSections where +module Dodge.SelectionSections ( + scrollSelectionSections, + ssLookupDown, + ssLookupGT, + ssSetCursor, + firstPosSelectionSections, +) where -import Data.Maybe import Control.Lens import qualified Data.IntMap.Strict as IM +import Data.Maybe import Dodge.Data.SelectionList scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a scrollSelectionSections yi sss | yi == 0 = sss - | yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections + | 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 - (i,j,si) <- ssLookupMin sss - return $ sss - & sssSelPos ?~ i - & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) + (i, j, si) <- 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 scrollUpSelectionSections :: SelectionSections a -> SelectionSections a scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do - i <- sss ^? sssSelPos . _Just - j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel - (i',j',si) <- ssLookupUp i j sss - return $ sss & sssSelPos ?~ i' - & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) + (i, j) <- sss ^? sssSelPos . _Just + (i', j', si) <- ssLookupUp i j sss + return $ sss & sssSelPos ?~ (i', j') + +-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) scrollDownSelectionSections :: SelectionSections a -> SelectionSections a scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do - i <- sss ^? sssSelPos . _Just - j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel - (i',j',si) <- ssLookupDown i j sss - return $ sss & sssSelPos ?~ i' - & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) + (i, j) <- sss ^? sssSelPos . _Just + -- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel + (i', j', si) <- ssLookupDown i j sss + return $ sss & sssSelPos ?~ (i', j') -ssSetCursor :: (SelectionSections a -> Maybe (Int,Int,SelectionItem a)) - -> SelectionSections a -> SelectionSections a +-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) + +ssSetCursor :: + (SelectionSections a -> Maybe (Int, Int, SelectionItem a)) -> + SelectionSections a -> + SelectionSections a ssSetCursor f sss = fromMaybe sss $ do - (i,j,si) <- f sss - return $ sss - & sssSelPos ?~ i - & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) + (i, j, si) <- f sss + return $ + sss + & sssSelPos ?~ (i, j) -ssLookupMax :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) +-- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) + +ssLookupMax :: SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupMax sss = do - (i,_) <- IM.lookupMax (sss ^. sssSections) + (i, _) <- IM.lookupMax (sss ^. sssSections) ssLookupLE' i sss -ssLookupUp :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupUp :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupUp i j sss = case ssLookupLT i j sss of Nothing -> ssLookupMax sss x -> x -ssLookupDown :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupDown :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupDown i j sss = case ssLookupGT i j sss of Nothing -> ssLookupMin sss x -> x -ssLookupLT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupLT :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do ss <- sss ^? sssSections . ix i - (j',si) <- IM.lookupLT j (ss ^. ssItems) - return $ Just (i,j',si) + (j', si) <- IM.lookupLT j (ss ^. ssItems) + return $ Just (i, j', si) -ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupLT' i sss = do - (i',ss) <- IM.lookupLT i (sss ^. sssSections) + (i', ss) <- IM.lookupLT i (sss ^. sssSections) case IM.lookupMax (ss ^. ssItems) of - Just (j',si) -> return (i',j',si) + Just (j', si) -> return (i', j', si) Nothing -> ssLookupLT' i' sss -ssLookupLE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupLE' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupLE' i sss = do - (i',ss) <- IM.lookupLE i (sss ^. sssSections) + (i', ss) <- IM.lookupLE i (sss ^. sssSections) case IM.lookupMax (ss ^. ssItems) of - Just (j',si) -> return (i',j',si) + Just (j', si) -> return (i', j', si) Nothing -> ssLookupLT' i' sss -ssLookupMin :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupMin :: SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupMin sss = do - (i,_) <- IM.lookupMin (sss ^. sssSections) + (i, _) <- IM.lookupMin (sss ^. sssSections) ssLookupGE' i sss -ssLookupGT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupGT :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do ss <- sss ^? sssSections . ix i - (j',si) <- IM.lookupGT j (ss ^. ssItems) - return $ Just (i,j',si) + (j', si) <- IM.lookupGT j (ss ^. ssItems) + return $ Just (i, j', si) -ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupGT' i sss = do - (i',ss) <- IM.lookupGT i (sss ^. sssSections) + (i', ss) <- IM.lookupGT i (sss ^. sssSections) case IM.lookupMin (ss ^. ssItems) of - Just (j',si) -> return (i',j',si) + Just (j', si) -> return (i', j', si) Nothing -> ssLookupGT' i' sss -ssLookupGE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupGE' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupGE' i sss = do - (i',ss) <- IM.lookupGE i (sss ^. sssSections) + (i', ss) <- IM.lookupGE i (sss ^. sssSections) case IM.lookupMin (ss ^. ssItems) of - Just (j',si) -> return (i',j',si) + Just (j', si) -> return (i', j', si) Nothing -> ssLookupGT' i' sss diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index b20559976..ae2955571 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -6,6 +6,7 @@ module Dodge.Update.Input ( doRegexInput, ) where +import Dodge.SelectionSections import Dodge.Default.World import Data.Char import qualified Data.IntMap.Strict as IM @@ -18,7 +19,7 @@ import Dodge.Combine import Dodge.Creature.Action import Dodge.Data.Universe import Dodge.Debug.Terminal -import Dodge.DisplayInventory +--import Dodge.DisplayInventory import Dodge.Event.Test import Dodge.Inventory import Dodge.Menu @@ -28,7 +29,7 @@ import Dodge.Terminal.LeftButton import Dodge.WorldPos import LensHelp import SDL -import SelectionIntMap +--import SelectionIntMap doTextInputOver :: ASetter' Universe String -> Universe -> Universe doTextInputOver p u = @@ -184,7 +185,7 @@ updateBackspaceRegex w = case di ^? subInventory of _ -> w where secfocus a b = fromMaybe False $ do - i <- di ^? diSections . sssSelPos . _Just + i <- di ^? diSections . sssSelPos . _Just . _1 return $ i == a || i == b trybackspace cm = case cm ^? invRegex . _Just of Just (_ : _) -> @@ -226,14 +227,14 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of where di = w ^. hud . hudElement secfocus a b = fromMaybe False $ do - i <- di ^? diSections . sssSelPos . _Just + i <- di ^? diSections . sssSelPos . _Just . _1 return $ i == a || i == b enterregex Nothing = Just "" enterregex x = x overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a overSection f sss = fromMaybe sss $ do - i <- sss ^? sssSelPos . _Just + i <- sss ^? sssSelPos . _Just . _1 return $ sss & sssSections . ix i %~ f pauseGame :: Universe -> Universe diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 685f7da3b..0a7323d13 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -33,10 +33,10 @@ updateWheelEvent yi w = case w ^. hud . hudElement of (Just f, _) -> doHeldScroll f y (you w) w | lbDown -> w & cWorld . camPos . camZoom +~ y | invKeyDown -> changeSwapInvSel yi w - | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w + | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w DisplayInventory {_subInventory = ExamineInventory mi} | invKeyDown && rbDown -> w & moveTweakSel yi - | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w + | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w | rbDown -> w & changeTweakParam mi yi | otherwise -> w & moveTweakSel yi DisplayInventory {_subInventory = CombineInventory {}} -> w & moveCombineSel yi