Unify inventory/close-objects display sections

2023-02-11 09:44:31 +00:00
parent 10f732d489
commit 286c84e50d
1 changed files with 102 additions and 87 deletions
@@ -1,9 +1,12 @@
 {-# LANGUAGE TupleSections #-}
-module Dodge.DisplayInventory where
+module Dodge.DisplayInventory 
+    ( makeDisplayInventory
+    , updateDisplayInventory
+    ) where

 import Data.Maybe
 --import Picture.Text
-import Dodge.Inventory.ItemSpace
+--import Dodge.Inventory.ItemSpace
 import Picture.Base
 import Dodge.Render.HUD
 import Dodge.SelectionList
@@ -26,7 +29,6 @@ updateDisplayInventory w cfig sss = sss
    }
  where
    mspos = do 
-        cr <- w ^? cWorld . lWorld . creatures . ix 0
        mo <- cr ^? crInvSel . isel
        case mo of
            SelItem {} -> Just 0
@@ -34,23 +36,30 @@ updateDisplayInventory w cfig sss = sss
            SelCloseObject {} -> Just 2
    availablelines = getAvailableListLines (invDisplayParams w) cfig
    iavailablelines = availablelines - 6
-    invsection = makeInventorySection iavailablelines oldoffset w
+    --invsection = makeInventorySection iavailablelines oldoffset w
+    invsection = updateSection "MORE INV ITEMS" invpos invitems iavailablelines w invsec
    invsectionlines = length $ _ssShownItems invsection
-    oldoffset = sss ^? sssSections . ix 0 . ssOffset
    restrictsections = IM.fromList
        [ (0, invsection )
        , (1, makeYouSection w)
        --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
-        , (2, updateSection copos coitems (availablelines - invsectionlines - 1) w cosec)
+        , (2, updateSection "MORE CLOSE OBJECTS" copos coitems (availablelines - invsectionlines - 1) w cosec)
        ]
    cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
+    invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
    coitems = IM.fromDistinctAscList . zip [0..] 
        $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-    nfreeslots = fromMaybe 0 $ do
-        cr <- w ^? cWorld . lWorld . creatures . ix 0
-        return $ crNumFreeSlots cr
+    invitems = IM.mapWithKey (invSelectionItem' cr) inv
+    cr = you w
+    inv = _crInv (you w)
+    nfreeslots = crNumFreeSlots cr
+    invpos = do 
+        mo <- cr ^? crInvSel . isel
+        case mo of
+            SelItem i _ -> Just i
+            SelNothing -> Nothing
+            SelCloseObject {} -> Nothing
    copos = do 
-        cr <- w ^? cWorld . lWorld . creatures . ix 0
        mo <- cr ^? crInvSel . isel
        case mo of
            SelItem {} -> Nothing
@@ -60,6 +69,9 @@ updateDisplayInventory w cfig sss = sss
 defaultCOSection :: SelectionSection ()
 defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2

+defaultInvSection :: SelectionSection ()
+defaultInvSection = SelectionSection mempty Nothing 5 0 0 NoSSRestriction [] 0
+
 makeDisplayInventory :: World -> Configuration -> SelectionSections ()
 makeDisplayInventory w cfig = defaultDisplaySections
    { _sssSections = restrictsections    
@@ -75,26 +87,25 @@ makeDisplayInventory w cfig = defaultDisplaySections
            SelNothing -> Just 1
            SelCloseObject {} -> Just 2
    availablelines = getAvailableListLines (invDisplayParams w) cfig
-    iavailablelines = availablelines - 6
-    invsection = makeInventorySection iavailablelines (Just 0) w
+    --iavailablelines = availablelines - 6
+    --invsection = makeInventorySection iavailablelines (Just 0) w
    --invsectionlines = length $ _ssShownItems invsection
    restrictsections = IM.fromList
-        [ (0, invsection )
+        [ (0, defaultInvSection )
        , (1, makeYouSection w)
        --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
        , (2, defaultCOSection)
        ]

-updateSection :: Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World 
+updateSection :: String -> Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World 
    -> SelectionSection ()
    -> SelectionSection ()
-updateSection mspos sis availablelines w ss = ss
+updateSection morestring mspos sis availablelines w ss = ss
    { _ssItems = sis
    , _ssCursor = scurs
    , _ssRestriction = NoSSRestriction
    , _ssPriority = 0
    , _ssOffset = offset
-    , _ssIndent = 0
 --    , _ssRegex = ""
 --    , _ssRegexInput = False
    , _ssMinSize = 5
@@ -108,10 +119,13 @@ updateSection mspos sis availablelines w ss = ss
        let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
        csize <- selsize
        ccolor <- selcolor
-        return $ SectionCursor cpos csize ccolor
+        return $ SectionCursor (cpos - offset) csize ccolor
+    mcpos = do
+        csel <- mspos
+        return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis
    oldoffset = fromMaybe 0 moldoffset
    xselsize = fromMaybe 1 selsize
-    offset = maybe 0 offset' mspos
+    offset = maybe 0 offset' mcpos
    offset' jselpos
        | jselpos == 0 || not mustrestrict = 0
        | jselpos - 1 < oldoffset = jselpos - 1
@@ -137,8 +151,9 @@ updateSection mspos sis availablelines w ss = ss
    h (col,str) = color col . text $ str
    --hdown (col,str) = textGrad col (withAlpha 0 col) str
    --hup (col,str) = textGrad (withAlpha 0 col) col str
-    hdown = color white $ text ">>> MORE INV ITEMS"
-    hup = color white $ text "<<< MORE INV ITEMS"
+    theindent = replicate (_ssIndent ss) ' '
+    hdown = color white . text $ theindent ++ ">>> " ++ morestring
+    hup = color white . text $ theindent ++ "<<< " ++ morestring
    g si = map (_siColor si ,) $ _siPictures si
    islastitm = fromMaybe False $ do
        i <- cr ^? crInvSel . isel . ispItem
@@ -153,73 +168,73 @@ updateSection mspos sis availablelines w ss = ss
        si <- sis ^? ix i
        return $ _siColor si

-makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
-makeInventorySection iavailablelines moldoffset w = SelectionSection
-    { _ssItems = IM.mapWithKey (invSelectionItem' cr) inv
-    , _ssCursor = scurs
-    , _ssRestriction = NoSSRestriction
-    , _ssPriority = 0
-    , _ssOffset = offset
-    , _ssIndent = 0
--    , _ssRegex = ""
--    , _ssRegexInput = False
-    , _ssMinSize = 5
--    , _ssOffset = 0
-    , _ssShownItems = shownitems
-    }
-  where
-    scurs = do
-        cpos <- fmap (subtract offset) selpos
-        csize <- selsize
-        ccolor <- selcolor
-        return $ SectionCursor cpos csize ccolor
-    jselpos = fromMaybe 0 selpos
-    oldoffset = fromMaybe 0 moldoffset
-    xselsize = fromMaybe 1 selsize
-    offset
-        | jselpos == 0 || not mustrestrict = 0
-        | jselpos - 1 < oldoffset = jselpos - 1
-        | islastitm = jselpos - iavailablelines + xselsize
-        | jselpos + 1 + xselsize - iavailablelines > oldoffset = jselpos - iavailablelines + 1 + xselsize
-        | length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines
-        | otherwise = oldoffset
-    tweakfirst (x:xs)
-        | offset > 0 = hup : map h xs
-        | otherwise = map h (x:xs)
-    tweakfirst [] =  []
-    shownitems
-        | length shownstrings > iavailablelines
-            = tweakfirst (take (iavailablelines - 1) shownstrings) 
-                ++ [hdown]
-        | otherwise = tweakfirst shownstrings
-    allstrings :: [(Color,String)]
-    allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv)
-    mustrestrict = length allstrings > iavailablelines
-    shownstrings :: [(Color,String)]
-    shownstrings = drop offset allstrings
-    cr = you w
-    inv = _crInv cr
-    h (col,str) = color col . text $ str
-    --hdown (col,str) = textGrad col (withAlpha 0 col) str
-    --hup (col,str) = textGrad (withAlpha 0 col) col str
-    hdown = color white $ text ">>> MORE INV ITEMS"
-    hup = color white $ text "<<< MORE INV ITEMS"
-    g si = map (_siColor si ,) $ _siPictures si
-    islastitm = fromMaybe False $ do
-        i <- cr ^? crInvSel . isel . ispItem
-        k <- fmap fst $ IM.lookupMax (_crInv cr)
-        return $ k == i
-    selpos = do
-        i <- cr ^? crInvSel . isel . ispItem
-        return . sum . fmap itSlotsTaken . fst . IM.split i $ inv
-    selsize = do
-        i <- cr ^? crInvSel . isel . ispItem
-        itm <- inv ^? ix i 
-        return $ itSlotsTaken itm
-    selcolor = do
-        i <- cr ^? crInvSel . isel . ispItem
-        itm <- inv ^? ix i 
-        return $ _itInvColor itm
+--makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
+--makeInventorySection iavailablelines moldoffset w = SelectionSection
+--    { _ssItems = IM.mapWithKey (invSelectionItem' cr) inv
+--    , _ssCursor = scurs
+--    , _ssRestriction = NoSSRestriction
+--    , _ssPriority = 0
+--    , _ssOffset = offset
+--    , _ssIndent = 0
+----    , _ssRegex = ""
+----    , _ssRegexInput = False
+--    , _ssMinSize = 5
+----    , _ssOffset = 0
+--    , _ssShownItems = shownitems
+--    }
+--  where
+--    scurs = do
+--        cpos <- fmap (subtract offset) selpos
+--        csize <- selsize
+--        ccolor <- selcolor
+--        return $ SectionCursor cpos csize ccolor
+--    jselpos = fromMaybe 0 selpos
+--    oldoffset = fromMaybe 0 moldoffset
+--    xselsize = fromMaybe 1 selsize
+--    offset
+--        | jselpos == 0 || not mustrestrict = 0
+--        | jselpos - 1 < oldoffset = jselpos - 1
+--        | islastitm = jselpos - iavailablelines + xselsize
+--        | jselpos + 1 + xselsize - iavailablelines > oldoffset = jselpos - iavailablelines + 1 + xselsize
+--        | length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines
+--        | otherwise = oldoffset
+--    tweakfirst (x:xs)
+--        | offset > 0 = hup : map h xs
+--        | otherwise = map h (x:xs)
+--    tweakfirst [] =  []
+--    shownitems
+--        | length shownstrings > iavailablelines
+--            = tweakfirst (take (iavailablelines - 1) shownstrings) 
+--                ++ [hdown]
+--        | otherwise = tweakfirst shownstrings
+--    allstrings :: [(Color,String)]
+--    allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv)
+--    mustrestrict = length allstrings > iavailablelines
+--    shownstrings :: [(Color,String)]
+--    shownstrings = drop offset allstrings
+--    cr = you w
+--    inv = _crInv cr
+--    h (col,str) = color col . text $ str
+--    --hdown (col,str) = textGrad col (withAlpha 0 col) str
+--    --hup (col,str) = textGrad (withAlpha 0 col) col str
+--    hdown = color white $ text ">>> MORE INV ITEMS"
+--    hup = color white $ text "<<< MORE INV ITEMS"
+--    g si = map (_siColor si ,) $ _siPictures si
+--    islastitm = fromMaybe False $ do
+--        i <- cr ^? crInvSel . isel . ispItem
+--        k <- fmap fst $ IM.lookupMax (_crInv cr)
+--        return $ k == i
+--    selpos = do
+--        i <- cr ^? crInvSel . isel . ispItem
+--        return . sum . fmap itSlotsTaken . fst . IM.split i $ inv
+--    selsize = do
+--        i <- cr ^? crInvSel . isel . ispItem
+--        itm <- inv ^? ix i 
+--        return $ itSlotsTaken itm
+--    selcolor = do
+--        i <- cr ^? crInvSel . isel . ispItem
+--        itm <- inv ^? ix i 
+--        return $ _itInvColor itm
        

 makeYouSection :: World -> SelectionSection ()