Simplify updating selection sections

2023-02-18 15:46:03 +00:00
parent 6eca3bab38
commit 41851ba24d
5 changed files with 230 additions and 87 deletions
@@ -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
-        { _sssSections = updateSections availablelines (-1,0) [filtinv,filtclose,invx ,youx, closex]
-        , _sssSelPos = Just (-1)
-        }
-    Just (InInventory (SelItem i _)) -> sss
-        { _sssSections = updateSections availablelines (0,i) [filtinv,filtclose,invx ,youx, closex]
-        , _sssSelPos = Just 0
-        }
-    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
-        }
+--    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
    _ -> 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))
-    youx = (1,(yousec, youitems))
-    closex = (3,(cosec, 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 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 - length (_ssShownItems ss)) (i,j) xs
+updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss previoussections
  where
-    ss  | i == k = updateSection (Just j) y availablelines x
-        | otherwise = updateSection Nothing y availablelines x
-    availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)
-
-defaultSS :: SelectionSection a
-defaultSS = SelectionSection 
-    { _ssItems = mempty 
-    , _ssCursor = Nothing 
-    , _ssMinSize = 5 
-    , _ssOffset = 0 
-    , _ssShownItems = [] 
-    , _ssIndent = 0 
-    , _ssDescriptor = ""
-    }
+    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


-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"
+manObjIndex :: ManipulatedObject -> (Int,Int)
+manObjIndex mo = case mo of
+    InInventory SortInventory -> (-1, 0)
+    InInventory (SelItem i _) -> (0, i)
+    SelNothing -> (1,0)
+    InNearby SortNearby -> (2,0)
+    InNearby (SelCloseObject i) -> (3,i)

 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
-        csel <- mspos
-        return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis
-    xselsize = fromMaybe 1 selsize
-    offset = maybe 0 offset' mcpos
-    offset' jselpos
-        | jselpos == 0 || not mustrestrict = 0
-        | jselpos - 1 < oldoffset = jselpos - 1
-        | islastitm = jselpos - availablelines + xselsize
-        | jselpos + 1 + xselsize - availablelines > oldoffset = jselpos - availablelines + 1 + xselsize
-        | length allstrings - oldoffset < availablelines = length allstrings - availablelines
-        | otherwise = oldoffset
+    offset = fromMaybe oldoffset $ do
+        csel <- mcsel 
+        maxcsel <- fst <$> IM.lookupMax sis
+        si <- sis ^? ix csel
+        let xselsize = length $ _siPictures si
+        return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
+            pos | pos == 0 || length allstrings <= availablelines 
+                -> 0
+            pos | pos - 1 < oldoffset 
+                -> pos - 1
+            pos | maxcsel == csel 
+                -> 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
-    hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss
+    xtra str = color white . text $ theindent ++ str ++ " 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"
+