diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index e29167788..617467fad 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -226,10 +226,12 @@ scrollAugInvSel :: Int -> World -> World scrollAugInvSel yi w | yi == 0 = w | otherwise = - w & hud . hudElement . diSections %~ scrollSelectionSections yi + w & hud . hudElement . diSections %~ doscroll & worldEventFlags . at InventoryChange ?~ () & setInvPosFromSS & cWorld . lWorld %~ crUpdateItemLocations 0 + where + doscroll sss = sss & sssExtra . sssSelPos %~ scrollSelectionSections yi sss selectedCloseObject :: World -> Maybe (Either FloorItem Button) selectedCloseObject w = do diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index 91930afa2..f421a589f 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -13,22 +13,23 @@ module Dodge.SelectionSections ( inverseSelBoundaryDown, ) where -import Control.Monad -import qualified Control.Foldl as L -import Dodge.ScreenPos -import Geometry.Data -import Dodge.Data.Config import Control.Applicative +import qualified Control.Foldl as L import Control.Lens +import Control.Monad import qualified Data.IntMap.Strict as IM import Data.Maybe +import Dodge.Data.Config import Dodge.Data.SelectionList +import Dodge.ScreenPos +import Geometry.Data -scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a -scrollSelectionSections yi sss - | yi == 0 = sss - | yi > 0 = foldr ($) sss $ replicate yi (ssScrollUsing ssLookupUp) - | otherwise = foldr ($) sss $ replicate (negate yi) (ssScrollUsing ssLookupDown) +scrollSelectionSections :: Int -> SelectionSections a -> Maybe (Int,Int) + -> Maybe (Int,Int) +scrollSelectionSections yi sss msel + | yi == 0 = msel + | yi > 0 = foldr ($) msel $ replicate yi (ssScrollUsing ssLookupUp sss) + | otherwise = foldr ($) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss) setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a setFirstPosSelectionSections sss = fromMaybe sss $ do @@ -38,26 +39,28 @@ setFirstPosSelectionSections sss = fromMaybe sss $ do ssScrollUsing :: (Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) -> SelectionSections a -> - SelectionSections a -ssScrollUsing g sss = - sss & sssExtra . sssSelPos - .~ fmap f (ssScrollSelectable g - (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) - where - f (i, j, _) = (i, j) + Maybe (Int,Int) -> + Maybe (Int,Int) +ssScrollUsing g sss msel = + ( ssScrollMinOnFail + g + (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)) + msel + ) -ssScrollSelectable :: +ssScrollMinOnFail :: ( Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a) ) -> SelectionSections a -> - Maybe (Int, Int, SelectionItem a) -ssScrollSelectable f sss = l <|> ssLookupMin sss + Maybe (Int, Int) -> + Maybe (Int, Int) +ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin sss where l = do - (i, j) <- sss ^? sssExtra . sssSelPos . _Just + (i, j) <- msel f i j sss ssSetCursor :: @@ -155,21 +158,26 @@ selSecYint i j sss = do -- it is annoying that Control.Foldl doesn't seem to allow for scans to be done -- at the same time as folds -inverseSelSecYint :: Int -> SelectionSections a -> Maybe (Int,Int) -inverseSelSecYint yint sss = do - ((i,ss),othersss) <- IM.minViewWithKey (_sssSections sss) +inverseSelSecYint :: Int -> SelectionSections a -> Maybe (Int, Int) +inverseSelSecYint yint sss = do + ((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss) let l = length $ _ssShownItems ss if l <= yint then inverseSelSecYint (yint - l) (sss & sssSections .~ othersss) else do let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss) j <- L.fold (L.findIndex (\x -> x - _ssOffset ss > yint)) ls - return (i,j) + return (i, j) -inverseSelSecYintXPosCheck :: Configuration -> ListDisplayParams - -> Float -> Int -> SelectionSections a -> Maybe (Int,Int) -inverseSelSecYintXPosCheck cfig ldp x yint sss = do - ((i,ss),othersss) <- IM.minViewWithKey (_sssSections sss) +inverseSelSecYintXPosCheck :: + Configuration -> + ListDisplayParams -> + Float -> + Int -> + SelectionSections a -> + Maybe (Int, Int) +inverseSelSecYintXPosCheck cfig ldp x yint sss = do + ((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss) let l = length $ _ssShownItems ss V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos) guard (x - x0 < 150) -- HACK, should determine selection item width and offset below @@ -178,44 +186,42 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do else do let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss) j <- L.fold (L.findIndex (\val -> val - _ssOffset ss > yint)) ls - return (i,j) + return (i, j) inverseSelNumPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Point2 -> - Maybe (Int,Int) + Maybe (Int, Int) inverseSelNumPos cfig ldp sss (V2 x y) = inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y) sss - -inverseSelBoundaryUp :: +inverseSelBoundaryUp :: Configuration -> ListDisplayParams -> SelectionSections a -> Point2 -> - Maybe (Int,Int) -inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do + Maybe (Int, Int) +inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do sel <- inverseSelSecYint (posSelSecYint cfig ldp y) sss let mselup = inverseSelSecYint (posSelSecYint cfig ldp y - 1) sss if Just sel == mselup then return $ sel & _2 +~ 1 else return $ sel -inverseSelBoundaryDown :: +inverseSelBoundaryDown :: Configuration -> ListDisplayParams -> SelectionSections a -> Point2 -> - Maybe (Int,Int) -inverseSelBoundaryDown cfig ldp sss (V2 _ y) = do + Maybe (Int, Int) +inverseSelBoundaryDown cfig ldp sss (V2 _ y) = do sel <- inverseSelSecYint (posSelSecYint cfig ldp y) sss let mseldown = inverseSelSecYint (posSelSecYint cfig ldp y + 1) sss if Just sel == mseldown then return $ sel & _2 -~ 1 else return sel - --getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int --getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index fbcbf6d47..87350bd02 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -59,9 +59,11 @@ updateWheelEvent yi w = case w ^. hud . hudElement of moveCombineSel :: Int -> World -> World moveCombineSel yi = ( hud . hudElement . subInventory . ciSections - %~ scrollSelectionSections yi + %~ doscroll ) . (worldEventFlags . at CombineInventoryChange ?~ ()) + where + doscroll sss = sss & sssExtra . sssSelPos %~ scrollSelectionSections yi sss --moveSubSel :: Int -> Int -> World -> World --moveSubSel yi maxyi =