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

Work on collapsing close item list

Browse Source
This commit is contained in:
justin
2023-02-11 09:09:23 +00:00
parent a8e00ac025
commit 10f732d489
6 changed files with 183 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
+12 -4
View File
@@ -42,11 +42,18 @@ data SSRestriction = NoSSRestriction
, _ssrOffset :: Int
}
data SectionCursor = SectionCursor
{ _scurPos :: Int
, _scurSize :: Int
, _scurColor :: Color
}
data SelectionSection a = SelectionSection
{ _ssItems :: [SelectionItem a]
, _ssSelPos :: Maybe Int
, _ssSelSize :: Maybe Int
, _ssSelColor :: Maybe Color
{ _ssItems :: IntMap (SelectionItem a)
, _ssCursor :: Maybe SectionCursor
-- , _ssSelPos :: Maybe Int
-- , _ssSelSize :: Maybe Int
-- , _ssSelColor :: Maybe Color
, _ssMinSize :: Int
, _ssPriority :: Int
, _ssOffset :: Int
@@ -97,6 +104,7 @@ makeLenses ''SelectionItem
makeLenses ''SelectionIntMap
makeLenses ''SelectionSection
makeLenses ''SelectionSections
makeLenses ''SectionCursor
makeLenses ''SSRestriction
--deriveJSON defaultOptions ''SelectionItem
--deriveJSON defaultOptions ''SelectionList
src/Dodge/Default/SelectionList.hs
+1 -1
View File
@@ -4,7 +4,7 @@ import Dodge.Data.SelectionList
defaultSelectionList :: SelectionList a
defaultSelectionList = SelectionList
{_slItems = []
{_slItems = mempty
, _slSelPos = Nothing
-- , _slLength = 0
, _slRegex = ""
src/Dodge/DisplayInventory.hs
+147 -53
View File
@@ -2,7 +2,7 @@
module Dodge.DisplayInventory where
import Data.Maybe
import Picture.Text
--import Picture.Text
import Dodge.Inventory.ItemSpace
import Picture.Base
import Dodge.Render.HUD
@@ -34,12 +34,31 @@ updateDisplayInventory w cfig sss = sss
SelCloseObject {} -> Just 2
availablelines = getAvailableListLines (invDisplayParams w) cfig
iavailablelines = availablelines - 6
invsection = makeInventorySection iavailablelines oldoffset w
invsectionlines = length $ _ssShownItems invsection
oldoffset = sss ^? sssSections . ix 0 . ssOffset
restrictsections = IM.fromList
[ (0, makeInventorySection iavailablelines oldoffset w )
[ (0, invsection )
, (1, makeYouSection w)
, (2, makeCloseObjectsSection w)
--, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
, (2, updateSection copos coitems (availablelines - invsectionlines - 1) w cosec)
]
cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
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
copos = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
mo <- cr ^? crInvSel . isel
case mo of
SelItem {} -> Nothing
SelNothing -> Nothing
SelCloseObject i -> Just i
defaultCOSection :: SelectionSection ()
defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2
makeDisplayInventory :: World -> Configuration -> SelectionSections ()
makeDisplayInventory w cfig = defaultDisplaySections
@@ -57,18 +76,21 @@ makeDisplayInventory w cfig = defaultDisplaySections
SelCloseObject {} -> Just 2
availablelines = getAvailableListLines (invDisplayParams w) cfig
iavailablelines = availablelines - 6
invsection = makeInventorySection iavailablelines (Just 0) w
--invsectionlines = length $ _ssShownItems invsection
restrictsections = IM.fromList
[ (0, makeInventorySection iavailablelines (Just 0) w )
[ (0, invsection )
, (1, makeYouSection w)
, (2, makeCloseObjectsSection w)
--, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
, (2, defaultCOSection)
]
makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
makeInventorySection iavailablelines moldoffset w = SelectionSection
{ _ssItems = map (invSelectionItem cr ) (IM.toList inv)
, _ssSelPos = fmap (subtract offset) selpos
, _ssSelSize = selsize
, _ssSelColor = selcolor
updateSection :: Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World
-> SelectionSection ()
-> SelectionSection ()
updateSection mspos sis availablelines w ss = ss
{ _ssItems = sis
, _ssCursor = scurs
, _ssRestriction = NoSSRestriction
, _ssPriority = 0
, _ssOffset = offset
@@ -80,6 +102,77 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
, _ssShownItems = shownitems
}
where
moldoffset = ss ^? ssOffset
scurs = do
csel <- mspos
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
csize <- selsize
ccolor <- selcolor
return $ SectionCursor cpos csize ccolor
oldoffset = fromMaybe 0 moldoffset
xselsize = fromMaybe 1 selsize
offset = maybe 0 offset' mspos
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
tweakfirst (x:xs)
| offset > 0 = hup : map h xs
| otherwise = map h (x:xs)
tweakfirst [] = []
shownitems
| length shownstrings > availablelines
= tweakfirst (take (availablelines - 1) shownstrings)
++ [hdown]
| otherwise = tweakfirst shownstrings
allstrings :: [(Color,String)]
allstrings = foldMap g sis
mustrestrict = length allstrings > availablelines
shownstrings :: [(Color,String)]
shownstrings = drop offset allstrings
cr = you w
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
selsize = do
i <- mspos
si <- sis ^? ix i
return . length $ _siPictures si
selcolor = do
i <- mspos
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
@@ -91,13 +184,13 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
| length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines
| otherwise = oldoffset
tweakfirst (x:xs)
| offset > 0 = hup x : map h xs
| offset > 0 = hup : map h xs
| otherwise = map h (x:xs)
tweakfirst [] = []
shownitems
| length shownstrings > iavailablelines
= tweakfirst (take (iavailablelines - 1) shownstrings)
++ [hdown $ shownstrings !! (iavailablelines -1)]
++ [hdown]
| otherwise = tweakfirst shownstrings
allstrings :: [(Color,String)]
allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv)
@@ -109,9 +202,8 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
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 (col,str) = color white $ text ">>> MORE INV ITEMS"
hup (col,str) = color white $ text "<<< MORE INV ITEMS"
f si = map (color (_siColor si) . text) $ _siPictures si
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
@@ -132,10 +224,8 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
makeYouSection :: World -> SelectionSection ()
makeYouSection w = SelectionSection
{ _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
, _ssSelPos = Just 0
, _ssSelSize = Just 1
, _ssSelColor = Just invDimColor
{ _ssItems = IM.singleton 0 $ SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()
, _ssCursor = Just $ SectionCursor 0 1 invDimColor
, _ssOffset = 0
, _ssPriority = 1
, _ssRestriction = NoSSRestriction
@@ -154,39 +244,43 @@ makeYouSection w = SelectionSection
1 -> " +1 FREE SLOT"
x -> " +" ++ show x ++ " FREE SLOTS"
makeCloseObjectsSection :: World -> SelectionSection ()
makeCloseObjectsSection w = SelectionSection
{ _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
, _ssSelPos = selpos
, _ssSelSize = selsize
, _ssSelColor = selcolor
, _ssPriority = 1
, _ssOffset = 0
, _ssIndent = 2
, _ssRestriction = NoSSRestriction
-- , _ssRegex = ""
-- , _ssRegexInput = False
, _ssMinSize = 5
--makeCloseObjectsSection :: Int -> World -> SelectionSection ()
--makeCloseObjectsSection cavailablelines w = SelectionSection
-- { _ssItems = IM.fromDistinctAscList . zip [0..]
-- $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-- , _ssCursor = scurs
-- , _ssPriority = 1
-- , _ssOffset = 0
, _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
}
where
f si = map (color (_siColor si) . text) $ _siPictures si
cr = you w
nfreeslots = crNumFreeSlots cr
selpos = do
i <- cr ^? crInvSel . isel . ispCloseObject
return . sum . map closeobjectsize . take i $ w ^. hud . closeObjects
selsize = do
i <- cr ^? crInvSel . isel . ispCloseObject
obj <- w ^? hud . closeObjects . ix i
return $ closeobjectsize obj
closeobjectsize co = maybe 1 itSlotsTaken (co ^? _Left . flIt)
selcolor = do
i <- cr ^? crInvSel . isel . ispCloseObject
obj <- w ^? hud . closeObjects . ix i
Just $ case obj of
Left flit -> _itInvColor $ _flIt flit
Right bt -> _btColor bt
-- , _ssIndent = 2
-- , _ssRestriction = NoSSRestriction
---- , _ssRegex = ""
---- , _ssRegexInput = False
-- , _ssMinSize = 5
---- , _ssOffset = 0
-- , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-- }
-- where
-- scurs = do
-- cpos <- selpos
-- csize <- selsize
-- ccolor <- selcolor
-- return $ SectionCursor cpos csize ccolor
-- f si = map (color (_siColor si) . text) $ _siPictures si
-- cr = you w
-- nfreeslots = crNumFreeSlots cr
-- selpos = do
-- i <- cr ^? crInvSel . isel . ispCloseObject
-- return . sum . map closeobjectsize . take i $ w ^. hud . closeObjects
-- selsize = do
-- i <- cr ^? crInvSel . isel . ispCloseObject
-- obj <- w ^? hud . closeObjects . ix i
-- return $ closeobjectsize obj
-- closeobjectsize co = maybe 1 itSlotsTaken (co ^? _Left . flIt)
-- selcolor = do
-- i <- cr ^? crInvSel . isel . ispCloseObject
-- obj <- w ^? hud . closeObjects . ix i
-- Just $ case obj of
-- Left flit -> _itInvColor $ _flIt flit
-- Right bt -> _btColor bt
src/Dodge/Inventory/SelectionList.hs
+17
View File
@@ -1,5 +1,6 @@
module Dodge.Inventory.SelectionList
( invSelectionItem
, invSelectionItem'
, closeObjectToSelectionItem
)
where
@@ -24,6 +25,22 @@ import LensHelp
-- Just CombineInventory{} -> Nothing
-- _ -> Just $ yourInvSel w
--
invSelectionItem' :: Creature -> Int -> Item -> SelectionItem ()
invSelectionItem' cr i it = SelectionItem
{ _siPictures = pics
, _siHeight = length pics
, _siIsSelectable = True
, _siWidth = 15
, _siColor = col
, _siOffX = 0
, _siPayload = ()
}
where
col = _itInvColor it
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
UndroppableIdentified -> itemDisplay it
_ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it
_ -> itemDisplay it
invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
invSelectionItem cr (i,it) = SelectionItem
{ _siPictures = pics
src/Dodge/Render/HUD.hs
+3 -3
View File
@@ -84,7 +84,7 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
where
thecolor = fromMaybe white $ do
spos <- _sssSelPos sss
sss ^? sssSections . ix spos . ssSelColor . _Just
sss ^? sssSections . ix spos . ssCursor . _Just . scurColor
thecursor = fromMaybe mempty $ do
sectype <- you w ^? crInvSel . isel
let secnum = case sectype of
@@ -94,8 +94,8 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
xint <- sss ^? sssSections . ix secnum . ssIndent
spos <- _sssSelPos sss
let y = sum . fmap (length . _ssShownItems) . fst . IM.split spos $ _sssSections sss
yint <- sss ^? sssSections . ix spos . ssSelPos . _Just
csize <- sss ^? sssSections . ix spos . ssSelSize . _Just
yint <- sss ^? sssSections . ix spos . ssCursor . _Just . scurPos
csize <- sss ^? sssSections . ix spos . ssCursor . _Just . scurSize
return $ listCursorDisplayParams ldps [North,South,West] cfig (yint + y) xint white 15 csize
ldps = invDisplayParams w
pics = foldMap (_ssShownItems) (_sssSections sss)
src/Dodge/SelectionList.hs
+2 -1
View File
@@ -5,6 +5,7 @@ import Regex
import Dodge.Data.Universe
import LensHelp
import Data.Maybe
--import Data.IntMap.Strict (IntMap)
getAvailableListLines :: ListDisplayParams -> Configuration -> Int
getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
@@ -17,7 +18,7 @@ getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
getShownItems :: SelectionList a -> [SelectionItem a]
getShownItems sl = case sl ^. slRegexList of
[] -> sl ^. slItems
xs -> map fst xs
xs -> fmap fst xs
makeRegexList :: SelectionList a -> [(SelectionItem a, Maybe Int)]
makeRegexList sl = case sl ^. slRegex of