justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Unify inventory/close-objects display sections

Browse Source
This commit is contained in:
justin
2023-02-11 09:44:31 +00:00
parent 10f732d489
commit 286c84e50d
1 changed files with 102 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/DisplayInventory.hs
+102 -87
View File
@@ -1,9 +1,12 @@
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
module Dodge.DisplayInventory where module Dodge.DisplayInventory
( makeDisplayInventory
, updateDisplayInventory
) where
import Data.Maybe import Data.Maybe
--import Picture.Text --import Picture.Text
import Dodge.Inventory.ItemSpace --import Dodge.Inventory.ItemSpace
import Picture.Base import Picture.Base
import Dodge.Render.HUD import Dodge.Render.HUD
import Dodge.SelectionList import Dodge.SelectionList
@@ -26,7 +29,6 @@ updateDisplayInventory w cfig sss = sss
} }
where where
mspos = do mspos = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
mo <- cr ^? crInvSel . isel mo <- cr ^? crInvSel . isel
case mo of case mo of
SelItem {} -> Just 0 SelItem {} -> Just 0
@@ -34,23 +36,30 @@ updateDisplayInventory w cfig sss = sss
SelCloseObject {} -> Just 2 SelCloseObject {} -> Just 2
availablelines = getAvailableListLines (invDisplayParams w) cfig availablelines = getAvailableListLines (invDisplayParams w) cfig
iavailablelines = availablelines - 6 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 invsectionlines = length $ _ssShownItems invsection
oldoffset = sss ^? sssSections . ix 0 . ssOffset
restrictsections = IM.fromList restrictsections = IM.fromList
[ (0, invsection ) [ (0, invsection )
, (1, makeYouSection w) , (1, makeYouSection w)
--, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) 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 cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
coitems = IM.fromDistinctAscList . zip [0..] coitems = IM.fromDistinctAscList . zip [0..]
$ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
nfreeslots = fromMaybe 0 $ do invitems = IM.mapWithKey (invSelectionItem' cr) inv
cr <- w ^? cWorld . lWorld . creatures . ix 0 cr = you w
return $ crNumFreeSlots cr 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 copos = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
mo <- cr ^? crInvSel . isel mo <- cr ^? crInvSel . isel
case mo of case mo of
SelItem {} -> Nothing SelItem {} -> Nothing
@@ -60,6 +69,9 @@ updateDisplayInventory w cfig sss = sss
defaultCOSection :: SelectionSection () defaultCOSection :: SelectionSection ()
defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2 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 :: World -> Configuration -> SelectionSections ()
makeDisplayInventory w cfig = defaultDisplaySections makeDisplayInventory w cfig = defaultDisplaySections
{ _sssSections = restrictsections { _sssSections = restrictsections
@@ -75,26 +87,25 @@ makeDisplayInventory w cfig = defaultDisplaySections
SelNothing -> Just 1 SelNothing -> Just 1
SelCloseObject {} -> Just 2 SelCloseObject {} -> Just 2
availablelines = getAvailableListLines (invDisplayParams w) cfig availablelines = getAvailableListLines (invDisplayParams w) cfig
iavailablelines = availablelines - 6 --iavailablelines = availablelines - 6
invsection = makeInventorySection iavailablelines (Just 0) w --invsection = makeInventorySection iavailablelines (Just 0) w
--invsectionlines = length $ _ssShownItems invsection --invsectionlines = length $ _ssShownItems invsection
restrictsections = IM.fromList restrictsections = IM.fromList
[ (0, invsection ) [ (0, defaultInvSection )
, (1, makeYouSection w) , (1, makeYouSection w)
--, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w) --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
, (2, defaultCOSection) , (2, defaultCOSection)
] ]
updateSection :: Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World updateSection :: String -> Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World
-> SelectionSection () -> SelectionSection ()
-> SelectionSection () -> SelectionSection ()
updateSection mspos sis availablelines w ss = ss updateSection morestring mspos sis availablelines w ss = ss
{ _ssItems = sis { _ssItems = sis
, _ssCursor = scurs , _ssCursor = scurs
, _ssRestriction = NoSSRestriction , _ssRestriction = NoSSRestriction
, _ssPriority = 0 , _ssPriority = 0
, _ssOffset = offset , _ssOffset = offset
, _ssIndent = 0
-- , _ssRegex = "" -- , _ssRegex = ""
-- , _ssRegexInput = False -- , _ssRegexInput = False
, _ssMinSize = 5 , _ssMinSize = 5
@@ -108,10 +119,13 @@ updateSection mspos sis availablelines w ss = ss
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis) let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
csize <- selsize csize <- selsize
ccolor <- selcolor 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 oldoffset = fromMaybe 0 moldoffset
xselsize = fromMaybe 1 selsize xselsize = fromMaybe 1 selsize
offset = maybe 0 offset' mspos offset = maybe 0 offset' mcpos
offset' jselpos offset' jselpos
| jselpos == 0 || not mustrestrict = 0 | jselpos == 0 || not mustrestrict = 0
| jselpos - 1 < oldoffset = jselpos - 1 | jselpos - 1 < oldoffset = jselpos - 1
@@ -137,8 +151,9 @@ updateSection mspos sis availablelines w ss = ss
h (col,str) = color col . text $ str h (col,str) = color col . text $ str
--hdown (col,str) = textGrad col (withAlpha 0 col) str --hdown (col,str) = textGrad col (withAlpha 0 col) str
--hup (col,str) = textGrad (withAlpha 0 col) col str --hup (col,str) = textGrad (withAlpha 0 col) col str
hdown = color white $ text ">>> MORE INV ITEMS" theindent = replicate (_ssIndent ss) ' '
hup = color white $ text "<<< MORE INV ITEMS" hdown = color white . text $ theindent ++ ">>> " ++ morestring
hup = color white . text $ theindent ++ "<<< " ++ morestring
g si = map (_siColor si ,) $ _siPictures si g si = map (_siColor si ,) $ _siPictures si
islastitm = fromMaybe False $ do islastitm = fromMaybe False $ do
i <- cr ^? crInvSel . isel . ispItem i <- cr ^? crInvSel . isel . ispItem
@@ -153,73 +168,73 @@ updateSection mspos sis availablelines w ss = ss
si <- sis ^? ix i si <- sis ^? ix i
return $ _siColor si return $ _siColor si
makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection () --makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
makeInventorySection iavailablelines moldoffset w = SelectionSection --makeInventorySection iavailablelines moldoffset w = SelectionSection
{ _ssItems = IM.mapWithKey (invSelectionItem' cr) inv -- { _ssItems = IM.mapWithKey (invSelectionItem' cr) inv
, _ssCursor = scurs -- , _ssCursor = scurs
, _ssRestriction = NoSSRestriction -- , _ssRestriction = NoSSRestriction
, _ssPriority = 0 -- , _ssPriority = 0
, _ssOffset = offset -- , _ssOffset = offset
, _ssIndent = 0 -- , _ssIndent = 0
-- , _ssRegex = "" ---- , _ssRegex = ""
-- , _ssRegexInput = False ---- , _ssRegexInput = False
, _ssMinSize = 5 -- , _ssMinSize = 5
-- , _ssOffset = 0 ---- , _ssOffset = 0
, _ssShownItems = shownitems -- , _ssShownItems = shownitems
} -- }
where -- where
scurs = do -- scurs = do
cpos <- fmap (subtract offset) selpos -- cpos <- fmap (subtract offset) selpos
csize <- selsize -- csize <- selsize
ccolor <- selcolor -- ccolor <- selcolor
return $ SectionCursor cpos csize ccolor -- return $ SectionCursor cpos csize ccolor
jselpos = fromMaybe 0 selpos -- jselpos = fromMaybe 0 selpos
oldoffset = fromMaybe 0 moldoffset -- oldoffset = fromMaybe 0 moldoffset
xselsize = fromMaybe 1 selsize -- xselsize = fromMaybe 1 selsize
offset -- offset
| jselpos == 0 || not mustrestrict = 0 -- | jselpos == 0 || not mustrestrict = 0
| jselpos - 1 < oldoffset = jselpos - 1 -- | jselpos - 1 < oldoffset = jselpos - 1
| islastitm = jselpos - iavailablelines + xselsize -- | islastitm = jselpos - iavailablelines + xselsize
| jselpos + 1 + xselsize - iavailablelines > oldoffset = jselpos - iavailablelines + 1 + xselsize -- | jselpos + 1 + xselsize - iavailablelines > oldoffset = jselpos - iavailablelines + 1 + xselsize
| length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines -- | length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines
| otherwise = oldoffset -- | otherwise = oldoffset
tweakfirst (x:xs) -- tweakfirst (x:xs)
| offset > 0 = hup : map h xs -- | offset > 0 = hup : map h xs
| otherwise = map h (x:xs) -- | otherwise = map h (x:xs)
tweakfirst [] = [] -- tweakfirst [] = []
shownitems -- shownitems
| length shownstrings > iavailablelines -- | length shownstrings > iavailablelines
= tweakfirst (take (iavailablelines - 1) shownstrings) -- = tweakfirst (take (iavailablelines - 1) shownstrings)
++ [hdown] -- ++ [hdown]
| otherwise = tweakfirst shownstrings -- | otherwise = tweakfirst shownstrings
allstrings :: [(Color,String)] -- allstrings :: [(Color,String)]
allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv) -- allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv)
mustrestrict = length allstrings > iavailablelines -- mustrestrict = length allstrings > iavailablelines
shownstrings :: [(Color,String)] -- shownstrings :: [(Color,String)]
shownstrings = drop offset allstrings -- shownstrings = drop offset allstrings
cr = you w -- cr = you w
inv = _crInv cr -- inv = _crInv cr
h (col,str) = color col . text $ str -- h (col,str) = color col . text $ str
--hdown (col,str) = textGrad col (withAlpha 0 col) str -- --hdown (col,str) = textGrad col (withAlpha 0 col) str
--hup (col,str) = textGrad (withAlpha 0 col) col str -- --hup (col,str) = textGrad (withAlpha 0 col) col str
hdown = color white $ text ">>> MORE INV ITEMS" -- hdown = color white $ text ">>> MORE INV ITEMS"
hup = color white $ text "<<< MORE INV ITEMS" -- hup = color white $ text "<<< MORE INV ITEMS"
g si = map (_siColor si ,) $ _siPictures si -- g si = map (_siColor si ,) $ _siPictures si
islastitm = fromMaybe False $ do -- islastitm = fromMaybe False $ do
i <- cr ^? crInvSel . isel . ispItem -- i <- cr ^? crInvSel . isel . ispItem
k <- fmap fst $ IM.lookupMax (_crInv cr) -- k <- fmap fst $ IM.lookupMax (_crInv cr)
return $ k == i -- return $ k == i
selpos = do -- selpos = do
i <- cr ^? crInvSel . isel . ispItem -- i <- cr ^? crInvSel . isel . ispItem
return . sum . fmap itSlotsTaken . fst . IM.split i $ inv -- return . sum . fmap itSlotsTaken . fst . IM.split i $ inv
selsize = do -- selsize = do
i <- cr ^? crInvSel . isel . ispItem -- i <- cr ^? crInvSel . isel . ispItem
itm <- inv ^? ix i -- itm <- inv ^? ix i
return $ itSlotsTaken itm -- return $ itSlotsTaken itm
selcolor = do -- selcolor = do
i <- cr ^? crInvSel . isel . ispItem -- i <- cr ^? crInvSel . isel . ispItem
itm <- inv ^? ix i -- itm <- inv ^? ix i
return $ _itInvColor itm -- return $ _itInvColor itm
makeYouSection :: World -> SelectionSection () makeYouSection :: World -> SelectionSection ()