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

Implement telescoping inventory selection

Browse Source
This commit is contained in:
justin
2023-02-10 10:57:00 +00:00
parent c354949ca9
commit a8e00ac025
10 changed files with 172 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
+3
View File
@@ -45,11 +45,14 @@ data SSRestriction = NoSSRestriction
data SelectionSection a = SelectionSection
{ _ssItems :: [SelectionItem a]
, _ssSelPos :: Maybe Int
, _ssSelSize :: Maybe Int
, _ssSelColor :: Maybe Color
, _ssMinSize :: Int
, _ssPriority :: Int
, _ssOffset :: Int
, _ssRestriction :: SSRestriction
, _ssShownItems :: [Picture]
, _ssIndent :: Int
}
src/Dodge/DisplayInventory.hs
+114 -24
View File
@@ -1,5 +1,9 @@
{-# LANGUAGE TupleSections #-}
module Dodge.DisplayInventory where
import Data.Maybe
import Picture.Text
import Dodge.Inventory.ItemSpace
import Picture.Base
import Dodge.Render.HUD
import Dodge.SelectionList
@@ -14,60 +18,128 @@ import Dodge.Default.World
import Dodge.Data.SelectionList
import Dodge.Data.World
makeDisplayInventory :: World -> Configuration -> SelectionSections ()
makeDisplayInventory w cfig = defaultDisplaySections
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
updateDisplayInventory w cfig sss = sss
{ _sssSections = restrictsections
, _sssSelPos = Just 0
, _sssSelPos = mspos
, _sssMaxSize = availablelines
}
where
initialsections = IM.fromList
[ (0, inventorysection)
, (1, makeYouSection w)
, (2, closesection)
]
inventorysection = makeInventorySection w
closesection = makeCloseObjectsSection w
itotallength = length . foldMap _siPictures $ _ssItems inventorysection
ctotallength = length . foldMap _siPictures $ _ssItems closesection
mspos = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
mo <- cr ^? crInvSel . isel
case mo of
SelItem {} -> Just 0
SelNothing -> Just 1
SelCloseObject {} -> Just 2
availablelines = getAvailableListLines (invDisplayParams w) cfig
iavailablelines = availablelines - 6
minlengths = sum $ fmap _ssMinSize initialsections
sections | itotallength + 1 + ctotallength > availablelines = restrictsections
| otherwise = initialsections
ioffset = 1
oldoffset = sss ^? sssSections . ix 0 . ssOffset
restrictsections = IM.fromList
[ (0, makeInventorySection w & ssShownItems %~ (take iavailablelines . drop ioffset))
[ (0, makeInventorySection iavailablelines oldoffset w )
, (1, makeYouSection w)
, (2, makeCloseObjectsSection w)
]
makeDisplayInventory :: World -> Configuration -> SelectionSections ()
makeDisplayInventory w cfig = defaultDisplaySections
{ _sssSections = restrictsections
, _sssSelPos = mspos
, _sssMaxSize = availablelines
}
where
mspos = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
mo <- cr ^? crInvSel . isel
case mo of
SelItem {} -> Just 0
SelNothing -> Just 1
SelCloseObject {} -> Just 2
availablelines = getAvailableListLines (invDisplayParams w) cfig
iavailablelines = availablelines - 6
restrictsections = IM.fromList
[ (0, makeInventorySection iavailablelines (Just 0) w )
, (1, makeYouSection w)
, (2, makeCloseObjectsSection w)
]
makeInventorySection :: World -> SelectionSection ()
makeInventorySection w = SelectionSection
makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
makeInventorySection iavailablelines moldoffset w = SelectionSection
{ _ssItems = map (invSelectionItem cr ) (IM.toList inv)
, _ssSelPos = Just 0
, _ssSelPos = fmap (subtract offset) selpos
, _ssSelSize = selsize
, _ssSelColor = selcolor
, _ssRestriction = NoSSRestriction
, _ssPriority = 0
, _ssOffset = 0
, _ssOffset = offset
, _ssIndent = 0
-- , _ssRegex = ""
-- , _ssRegexInput = False
, _ssMinSize = 5
-- , _ssOffset = 0
, _ssShownItems = foldMap (f . invSelectionItem cr ) (IM.toList inv)
, _ssShownItems = shownitems
}
where
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 x : map h xs
| otherwise = map h (x:xs)
tweakfirst [] = []
shownitems
| length shownstrings > iavailablelines
= tweakfirst (take (iavailablelines - 1) shownstrings)
++ [hdown $ shownstrings !! (iavailablelines -1)]
| 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 (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
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 ()
makeYouSection w = SelectionSection
{ _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
, _ssSelPos = Nothing
, _ssSelPos = Just 0
, _ssSelSize = Just 1
, _ssSelColor = Just invDimColor
, _ssOffset = 0
, _ssPriority = 1
, _ssRestriction = NoSSRestriction
, _ssIndent = 2
-- , _ssRegex = ""
-- , _ssRegexInput = False
, _ssMinSize = 1
@@ -85,9 +157,12 @@ makeYouSection w = SelectionSection
makeCloseObjectsSection :: World -> SelectionSection ()
makeCloseObjectsSection w = SelectionSection
{ _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
, _ssSelPos = Just 0
, _ssSelPos = selpos
, _ssSelSize = selsize
, _ssSelColor = selcolor
, _ssPriority = 1
, _ssOffset = 0
, _ssIndent = 2
, _ssRestriction = NoSSRestriction
-- , _ssRegex = ""
-- , _ssRegexInput = False
@@ -99,4 +174,19 @@ makeCloseObjectsSection w = SelectionSection
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/HeldScroll.hs
+1 -1
View File
@@ -2,7 +2,7 @@ module Dodge.HeldScroll (
doHeldScroll,
) where
import Dodge.Base.You
--import Dodge.Base.You
import Control.Lens hiding ((<|), (|>))
import Data.Sequence
import Dodge.Data.Creature
src/Dodge/Inventory/SelectionList.hs
-15
View File
@@ -9,11 +9,8 @@ import Dodge.Inventory.Color
import Dodge.Item.Display
import Dodge.Inventory.ItemSpace
import Picture.Base
import Dodge.Inventory.CheckSlots
import Dodge.Base.You
import Dodge.Data.SelectionList
import Dodge.Data.World
import qualified Data.IntMap.Strict as IM
import LensHelp
--makeInventorySelectionList :: World -> SelectionList ()
@@ -21,18 +18,6 @@ import LensHelp
-- & slItems .~ inventorySelectionList w
-- & slSelPos .~ inventoryCursorPos w
--
inventorySelectionList :: World -> [SelectionItem ()]
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
++ [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
++ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
where
cr = you w
inv = _crInv cr
nfreeslots = crNumFreeSlots cr
thetext = case nfreeslots of
0 -> " INVENTORY FULL"
1 -> " +1 FREE SLOT"
x -> " +" ++ show x ++ " FREE SLOTS"
--
--inventoryCursorPos :: World -> Maybe Int
--inventoryCursorPos w = case w ^? hud . hudElement . subInventory of
src/Dodge/Item/Display.hs
+1 -1
View File
@@ -21,7 +21,7 @@ itemDisplayWithNumber numberstr it =
(midPadL 15 ' ' thename (' ' : numberstr) ++ theparam) :
catMaybes [maybeWarmupStatus it, maybeRateStatus it]
++ moduleStrings it
++ repeat "*"
++ repeat "\\"
where
thename = itemBaseName it
theparam =
src/Dodge/Render/HUD.hs
+20 -8
View File
@@ -21,7 +21,6 @@ import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Inventory
--import Dodge.Inventory.ItemSpace
import Dodge.Inventory.SelectionList
--import Dodge.Item.Display
import Dodge.Item.Info
import Dodge.Render.Connectors
@@ -79,13 +78,26 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
(_ldpPosX ldps)
(_ldpPosY ldps)
cfig
0 -- offset
--undefined
0
pics
<> color thecolor thecursor
where
thecolor = fromMaybe white $ do
spos <- _sssSelPos sss
sss ^? sssSections . ix spos . ssSelColor . _Just
thecursor = fromMaybe mempty $ do
sectype <- you w ^? crInvSel . isel
let secnum = case sectype of
SelItem{} -> 0
SelNothing{} -> 1
SelCloseObject{} -> 2
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
return $ listCursorDisplayParams ldps [North,South,West] cfig (yint + y) xint white 15 csize
ldps = invDisplayParams w
-- pics' = take (_sssMaxSize sss) pics
-- totallength = length pics'
pics = foldMap (_ssShownItems) (_sssSections sss)
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
@@ -187,7 +199,7 @@ examineInventoryExtra mtweaki mitm cfig =
tweaki <- mtweaki
-- consider moving this functionality out into a tweaks module
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
return $ listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 15
return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
-- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
]
@@ -327,14 +339,14 @@ lnkMidPosInvSelsCol cfig w i col =
hw = halfWidth cfig
topCursorTypeWidth ::
(Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture) ->
(Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture) ->
Int ->
Configuration ->
World ->
Int ->
Picture
topCursorTypeWidth ctype width cfig w i =
ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (invSelSize i w)
ctype 0 0 cfig (selNumPos i w) 0 (selNumCol i w) width (invSelSize i w)
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
src/Dodge/Render/InfoBox.hs
+1 -1
View File
@@ -15,7 +15,7 @@ renderInfoListAt :: Float -> Float -> Configuration -> CamPos -> (Point2, [Strin
renderInfoListAt x y cfig cam (p, ss) =
renderListAt x y cfig (zip ss (repeat white))
<> winScale cfig (color white $ lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
<> listCursorNSW x y cfig 0 white 19 (length ss)
<> listCursorNSW x y cfig 0 0 white 19 (length ss)
where
hw = halfWidth cfig
hh = halfHeight cfig
src/Dodge/Render/List.hs
+28 -9
View File
@@ -60,7 +60,7 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
NoCursor -> Nothing
let j = sum . map _siHeight $ take i lis
col = _siColor selit
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit)
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j 0 col wdth (_siHeight selit)
where
wdth = case _ldpWidth ldps of
FixedSelectionWidth x -> x
@@ -74,7 +74,7 @@ drawCursorAt' ldps cfig i lis = fromMaybe mempty $ do
NoCursor -> Nothing
let j = getIthPos i lis
col = _siColor selit
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit)
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j 0 col wdth (_siHeight selit)
where
wdth = case _ldpWidth ldps of
FixedSelectionWidth x -> x
@@ -109,6 +109,24 @@ stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i -1 ..]
listCursorDisplayParams ::
ListDisplayParams ->
[CardinalPoint] ->
Configuration ->
Int ->
Int ->
Color ->
Int ->
Int ->
Picture
listCursorDisplayParams ldp borders cfig yint xint col cursxsize cursysize =
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize
where
ygap = _ldpVerticalGap ldp
s = _ldpScale ldp
xoff = _ldpPosX ldp
yoff = _ldpPosY ldp
-- displays a cursor that should match up to list text pictures
-- the width of a character appears to be 9(?!)
-- this is probably because it is 8 pixels plus one for the border
@@ -120,14 +138,15 @@ listCursorChooseBorderScale ::
Float ->
Configuration ->
Int ->
Int ->
Color ->
Int ->
Int ->
Picture
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cursysize =
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
winScale cfig
. translate
(15 - (9 * s) + xoff - halfWidth cfig)
(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
(halfHeight cfig + s * 12.5 - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
. color col
$ chooseCursorBorders (s * wth) (s * hgt) borders
@@ -140,7 +159,7 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cur
-- the width of a character appears to be 9(?!)
-- this is probably because it is 8 pixels plus one for the border
listCursorChooseBorder ::
[CardinalPoint] -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
[CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorChooseBorder = listCursorChooseBorderScale 10 1
-- note we cannot simply scale lines because they are drawn as solid rectangles
@@ -155,16 +174,16 @@ chooseCursorBorders wth hgt = foldMap (line . toLine)
toLine South = [V2 wth bot, V2 lef bot]
toLine West = [V2 lef bot, V2 lef top]
listCursorNS :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNS :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorNS = listCursorChooseBorder [North, South]
listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNES :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorNES = listCursorChooseBorder [North, South, East]
listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNESW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorNESW = listCursorChooseBorder [North, South, East, West]
listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNSW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorNSW = listCursorChooseBorder [North, South, West]
fillScreenText :: Configuration -> String -> Picture
src/Dodge/Update.hs
+2 -3
View File
@@ -82,9 +82,8 @@ updateUniverse u =
cfig = u ^. uvConfig
updateInventoryDisplay :: Universe -> Universe
updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections %~ const di
where
di = makeDisplayInventory (_uvWorld u) (_uvConfig u)
updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections
%~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
maybeOpenTerminal :: Universe -> Universe
maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
src/SelectionIntMap.hs
+2 -2
View File
@@ -56,5 +56,5 @@ getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1)
where
yint = getIthPos i (sm ^. smShownItems)
selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a
selectionSectionsToIntMap ss = undefined
--selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a
--selectionSectionsToIntMap ss = undefined