Move towards selection section inventory management

src/Dodge/Inventory.hs

@@ -25,6 +25,7 @@ module Dodge.Inventory (
     trimapAugmentInv,
 ) where
 
+import Dodge.Data.SelectionList
 import Color
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -353,27 +354,136 @@ changeAugInvSel :: Int -> World -> World
 changeAugInvSel yi w
     | yi == 0 = w
     | otherwise =
-        w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f
-  where
-    f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w
-    ninv = length (yourInv w)
-    nclose = length (w ^. hud . closeObjects)
+        w & hud . hudElement . diSections %~ scrollSelectionSections yi
+            & setInvPosFromSS
 
-toAugSelPos :: World -> ManipulatedObject -> Int
-toAugSelPos w mo = case mo of
-    SelItem i _ -> i
-    SelNothing -> ninv   
-    SelCloseObject i -> ninv + i + 1
+setInvPosFromSS :: World -> World
+setInvPosFromSS w = w
+    & cWorld . lWorld . creatures . ix 0 . crInvSel . isel .~ thesel
   where
-    ninv = length (yourInv w)
+    thesel = fromMaybe SelNothing $ do
+        sss <- w ^? hud . hudElement . diSections
+        i <- sss ^? sssSelPos . _Just
+        j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
+        case i of
+            0 -> Just $ SelItem j NoInvSelAction
+            2 -> Just $ SelCloseObject j
+            _ -> Just SelNothing
+            
+--changeAugInvSel :: Int -> World -> World
+--changeAugInvSel yi w
+--    | yi == 0 = w
+--    | otherwise =
+--        w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f
+--  where
+--    f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w
+--    ninv = length (yourInv w)
+--    nclose = length (w ^. hud . closeObjects)
 
-fromAugSelPos :: World -> Int -> ManipulatedObject
-fromAugSelPos w i
-    | i > ninv = SelCloseObject (i - ninv - 1)
-    | i == ninv = SelNothing
-    | otherwise = SelItem i NoInvSelAction
-  where
-    ninv = length (yourInv w)
+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)
+
+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
+
+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)
+
+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
+
+--toAugSelPos :: World -> ManipulatedObject -> Int
+--toAugSelPos w mo = case mo of
+--    SelItem i _ -> i
+--    SelNothing -> ninv   
+--    SelCloseObject i -> ninv + i + 1
+--  where
+--    ninv = length (yourInv w)
+--
+--fromAugSelPos :: World -> Int -> ManipulatedObject
+--fromAugSelPos w i
+--    | i > ninv = SelCloseObject (i - ninv - 1)
+--    | i == ninv = SelNothing
+--    | otherwise = SelItem i NoInvSelAction
+--  where
+--    ninv = length (yourInv w)
 
 bestCloseObjectIndex :: World -> Maybe Int
 bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects