Simplify updating selection sections

src/Dodge/Combine.hs

@@ -116,7 +116,7 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
 
 updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem 
     -> SelectionSections CombinableItem
-updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [filt,combs]
+updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt]
   where
     availablelines = getAvailableListLines secondColumnParams cfig
     filt = (-1, (filtsec,filtitems))

src/Dodge/Default/World.hs

@@ -1,5 +1,6 @@
 module Dodge.Default.World where
 
+import Control.Lens
 import Dodge.Data.SelectionList
 import Data.Graph.Inductive.Graph hiding ((&))
 import qualified Data.Map as M
@@ -151,7 +152,7 @@ defaultDisplaySections = SelectionSections
 defaultHUD :: HUD
 defaultHUD =
     HUD
-        { _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultDisplaySections}
+        { _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultInvSections}
         , _carteCenter = V2 0 0
         , _carteZoom = 0.5
         , _carteRot = 0
@@ -170,3 +171,48 @@ defaultHUD =
 --    }
 --  where
 --    f (V2 x y) = V3 x y 100
+
+defaultInvSections :: SelectionSections ()
+defaultInvSections = SelectionSections
+    { _sssSections = IM.fromDistinctAscList $ zip [-1..]
+        [ defaultFiltSection
+        , defaultInvSection
+        , defaultYouSection
+        , defaultFiltSection
+        , defaultCOSection
+        ]
+    , _sssSelPos = Nothing
+    }
+defaultSS :: SelectionSection a
+defaultSS = SelectionSection 
+    { _ssItems = mempty 
+    , _ssCursor = Nothing 
+    , _ssMinSize = 10
+    , _ssOffset = 0 
+    , _ssShownItems = [] 
+    , _ssIndent = 0 
+    , _ssDescriptor = ""
+    }
+
+
+defaultCOSection :: SelectionSection ()
+defaultCOSection = defaultSS 
+    & ssIndent .~ 2 
+    & ssDescriptor .~ "CLOSE OBJECTS"
+
+defaultFiltSection :: SelectionSection a
+defaultFiltSection = defaultSS 
+    & ssIndent .~ 0
+    & ssDescriptor .~ "INV"
+    & ssMinSize .~ 0
+
+defaultInvSection :: SelectionSection ()
+defaultInvSection = defaultSS
+    & ssDescriptor .~ "INVENTORY ITEMS"
+
+defaultYouSection :: SelectionSection ()
+defaultYouSection = defaultSS
+--    & ssRegex .~ UnavailableRegex
+    & ssIndent .~ 2
+    & ssMinSize .~ 1
+    & ssDescriptor .~ "YOUR STATUS"

src/Dodge/DisplayInventory.hs

@@ -26,34 +26,29 @@ import Dodge.Data.World
 
 updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
 updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
-    Just (InInventory SortInventory) -> sss
+--    Just mo -> sss
-        { _sssSections = updateSections availablelines (-1,0) [filtinv,filtclose,invx ,youx, closex]
+--        { _sssSections = updateSections availablelines (manObjIndex mo) $ addorder mo
-        , _sssSelPos = Just (-1)
+--        , _sssSelPos = Just (fst $ manObjIndex mo)
-        }
+--        }
-    Just (InInventory (SelItem i _)) -> sss
+    Just mo -> updateSectionsPositioning sss
-        { _sssSections = updateSections availablelines (0,i) [filtinv,filtclose,invx ,youx, closex]
+        { _sssSelPos = Just (fst $ manObjIndex mo)
-        , _sssSelPos = Just 0
+        } availablelines (manObjIndex mo) $ addorder mo
-        }
-    Just SelNothing -> sss
-        { _sssSections = updateSections availablelines (1,0) [filtinv,filtclose,invx ,youx, closex]
-        , _sssSelPos = Just 1
-        }
-    Just (InNearby SortNearby) -> sss
-        { _sssSections =  updateSections availablelines (2,0) [filtinv,filtclose,closex, invx ,youx]
-        , _sssSelPos = Just 2
-        }
-    Just (InNearby (SelCloseObject i)) -> sss
-        { _sssSections =  updateSections availablelines (3,i) [filtinv,filtclose,closex, invx ,youx]
-        , _sssSelPos = Just 3
-        }
     _ -> error "error when getting cr inv sel"
   where
-    filtinv = (-1,(filtinvsec,filtinvitems))
+    addorder mo = case mo of
+        InInventory SortInventory -> reverse [filtinv,filtclose,invx ,youx, closex]
+        InInventory SelItem{} -> reverse [filtinv,filtclose,invx ,youx, closex]
+        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,(filtclosesec,filtcloseitems))
+    filtclose = (2,filtcloseitems)
     filtclosesec = fromMaybe (defaultFiltSection & ssIndent .~ 2)
         $ sss ^? sssSections . ix 2
     filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of
@@ -63,13 +58,16 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
     numfiltitems' = length invitems' - length invitems
     numfiltclose = "  " ++ show numfiltclose' ++ " FILTERED"
     numfiltclose' = length coitems' - length coitems
-    invx = (0,(invsec, invitems))
+    invx = (0, invitems)
-    youx = (1,(yousec, youitems))
+    --invx = (0,(invsec, invitems))
-    closex = (3,(cosec, coitems))
+    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 2
+    cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 3
     invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
     coitems' = IM.fromDistinctAscList . zip [0..] 
         $ map closeObjectToSelectionItem (w ^. hud . closeObjects)
@@ -90,42 +88,41 @@ displayFreeSlots x = case x of
     1 -> "1 FREE SLOT"
     _ -> show x ++ " FREE SLOTS"
 
+
+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
+updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss previoussections
-    $ updateSections (allavailablelines - length (_ssShownItems ss)) (i,j) xs
   where
-    ss  | i == k = updateSection (Just j) y availablelines x
+    ss  | i == k = updateSection (Just j) y linesleft x
-        | otherwise = updateSection Nothing y availablelines x
+        | otherwise = updateSection Nothing y linesleft x
-    availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)
+    availablelines = allavailablelines - _ssMinSize x
-
+    linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections)
-defaultSS :: SelectionSection a
+    previoussections = updateSections availablelines (i,j) xs
-defaultSS = SelectionSection 
-    { _ssItems = mempty 
-    , _ssCursor = Nothing 
-    , _ssMinSize = 5 
-    , _ssOffset = 0 
-    , _ssShownItems = [] 
-    , _ssIndent = 0 
-    , _ssDescriptor = ""
-    }
 
 
-defaultCOSection :: SelectionSection ()
+manObjIndex :: ManipulatedObject -> (Int,Int)
-defaultCOSection = defaultSS 
+manObjIndex mo = case mo of
-    & ssIndent .~ 2 
+    InInventory SortInventory -> (-1, 0)
-    & ssDescriptor .~ "CLOSE OBJECTS"
+    InInventory (SelItem i _) -> (0, i)
-
+    SelNothing -> (1,0)
-defaultFiltSection :: SelectionSection a
+    InNearby SortNearby -> (2,0)
-defaultFiltSection = defaultSS 
+    InNearby (SelCloseObject i) -> (3,i)
-    & ssIndent .~ 0
-    & ssDescriptor .~ "INV"
-    & ssMinSize .~ 0
-
-defaultInvSection :: SelectionSection ()
-defaultInvSection = defaultSS
-    & ssDescriptor .~ "INVENTORY ITEMS"
 
 updateSection 
     :: Maybe Int
@@ -133,60 +130,54 @@ updateSection
     -> Int 
     -> SelectionSection a
     -> SelectionSection a
-updateSection mspos sis' availablelines ss = ss
+updateSection mcsel sis availablelines ss = ss
     { _ssItems = sis
     , _ssCursor = scurs
     , _ssOffset = offset
     , _ssShownItems = shownitems
     }
   where
-    sis = sis' 
     oldoffset = ss ^. ssOffset
     scurs = do
-        csel <- mspos
+        csel <- mcsel
         si <- sis ^? ix csel
         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
-    mcpos = do
+    offset = fromMaybe oldoffset $ do
-        csel <- mspos
+        csel <- mcsel 
-        return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis
+        maxcsel <- fst <$> IM.lookupMax sis
-    xselsize = fromMaybe 1 selsize
+        si <- sis ^? ix csel
-    offset = maybe 0 offset' mcpos
+        let xselsize = length $ _siPictures si
-    offset' jselpos
+        return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
-        | jselpos == 0 || not mustrestrict = 0
+            pos | pos == 0 || length allstrings <= availablelines 
-        | jselpos - 1 < oldoffset = jselpos - 1
+                -> 0
-        | islastitm = jselpos - availablelines + xselsize
+            pos | pos - 1 < oldoffset 
-        | jselpos + 1 + xselsize - availablelines > oldoffset = jselpos - availablelines + 1 + xselsize
+                -> pos - 1
-        | length allstrings - oldoffset < availablelines = length allstrings - availablelines
+            pos | maxcsel == csel 
-        | otherwise = oldoffset
+                -> pos - availablelines + xselsize
+            pos | pos + 1 + xselsize - availablelines > oldoffset 
+                -> pos - availablelines + 1 + xselsize
+            _ | length allstrings - oldoffset < availablelines 
+                -> length allstrings - availablelines
+            _   -> oldoffset
     tweakfirst (x:xs)
-        | offset > 0 = hup : map h xs
+        | offset > 0 = xtra "<<<" : map h xs
         | otherwise = map h (x:xs)
     tweakfirst [] =  []
     shownitems
         | length shownstrings > availablelines
             = tweakfirst (take (availablelines - 1) shownstrings) 
-                ++ [hdown]
+                ++ [xtra ">>>"]
         | otherwise = tweakfirst shownstrings
     allstrings :: [(Color,String)]
     allstrings = foldMap g sis
-    mustrestrict = length allstrings > availablelines
     shownstrings = drop offset allstrings
     h (col,str) = color col . text $ theindent ++ str
     theindent = replicate (_ssIndent ss) ' '
-    hdown = color white . text $ theindent ++ ">>> MORE " ++ _ssDescriptor ss
+    xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
-    hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss
     g si = map (_siColor si ,) $ _siPictures si
-    islastitm = fromMaybe False $ do
-        i <- mspos
-        k <- fst <$> IM.lookupMax sis
-        return $ k == i
-    selsize = do
-        i <- mspos
-        si <- sis ^? ix i
-        return . length $ _siPictures si
 
 yousec :: SelectionSection ()
 yousec = defaultSS
@@ -195,3 +186,4 @@ yousec = defaultSS
     & ssIndent .~ 2
     & ssMinSize .~ 1
     & ssDescriptor .~ "YOUR STATUS"
+

src/Dodge/SelectionSections.hs

@@ -0,0 +1,104 @@
+module Dodge.SelectionSections where
+
+import Data.Maybe
+import Control.Lens
+import qualified Data.IntMap.Strict as IM
+import Dodge.Data.SelectionList
+
+scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a
+scrollSelectionSections yi sss
+    | yi == 0 = sss
+    | yi  > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections
+    | otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections
+
+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)
+
+
+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)
+
+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)
+
+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)
+
+ssLookupMax :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssLookupMax sss = do
+    (i,_) <- IM.lookupMax (sss ^. sssSections)
+    ssLookupLE' i sss
+
+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 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 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)
+
+ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssLookupLT' i sss = do
+    (i',ss) <- IM.lookupLT i (sss ^. sssSections)
+    case IM.lookupMax (ss ^. ssItems) of
+        Just (j',si) -> return (i',j',si)
+        Nothing -> ssLookupLT' i' sss
+
+ssLookupLE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssLookupLE' i sss = do
+    (i',ss) <- IM.lookupLE i (sss ^. sssSections)
+    case IM.lookupMax (ss ^. ssItems) of
+        Just (j',si) -> return (i',j',si)
+        Nothing -> ssLookupLT' i' sss
+
+ssLookupMin :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssLookupMin sss = do
+    (i,_) <- IM.lookupMin (sss ^. sssSections)
+    ssLookupGE' i sss
+
+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)
+
+ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssLookupGT' i sss = do
+    (i',ss) <- IM.lookupGT i (sss ^. sssSections)
+    case IM.lookupMin (ss ^. ssItems) of
+        Just (j',si) -> return (i',j',si)
+        Nothing -> ssLookupGT' i' sss
+
+ssLookupGE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssLookupGE' i sss = do
+    (i',ss) <- IM.lookupGE i (sss ^. sssSections)
+    case IM.lookupMin (ss ^. ssItems) of
+        Just (j',si) -> return (i',j',si)
+        Nothing -> ssLookupGT' i' sss

src/Dodge/Update/Input.hs

@@ -6,6 +6,7 @@ module Dodge.Update.Input (
     doRegexInput,
 ) where
 
+import Dodge.Default.World
 import Data.Char
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
@@ -256,7 +257,7 @@ spaceAction w = case w ^?! hud . hudElement of
 toggleMap :: Universe -> Universe
 toggleMap u = case u ^?! uvWorld . hud . hudElement of
     DisplayCarte -> u & uvWorld . hud . hudElement 
-        .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultDisplaySections}
+        .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections}
     _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
 
 toggleTweakInv :: World -> World