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

Unify inventory sections further (slow?)

Browse Source
This commit is contained in:
justin
2023-02-11 13:10:10 +00:00
parent 286c84e50d
commit 24825728f5
7 changed files with 58 additions and 174 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+1 -2
View File
@@ -123,7 +123,7 @@ useLeftItem cid w = fromMaybe w $ do
cr ^? crInv . ix itRef . itUse . cUse
itmIsEquipable = isJust $ do
itRef <- mitRef
guard . not $ cr ^. crLeftInvSel . lisMPos /= Just itRef
guard $ cr ^. crLeftInvSel . lisMPos == Just itRef
cr ^? crInv . ix itRef . itUse . equipEffect . eeUse
if itmIsConsumable || itmIsEquipable
then return $ useItem cr w -- I believe this ONLY sets equipment options
@@ -136,6 +136,5 @@ useLeftItem cid w = fromMaybe w $ do
. useL f itm cr
$ w
where
-- TODO determine itmShouldBeUsed with reference to config options
src/Dodge/Data/SelectionList.hs
+1
View File
@@ -60,6 +60,7 @@ data SelectionSection a = SelectionSection
, _ssRestriction :: SSRestriction
, _ssShownItems :: [Picture]
, _ssIndent :: Int
, _ssDescriptor :: String
}
src/Dodge/DisplayInventory.hs
+48 -164
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE TupleSections #-}
module Dodge.DisplayInventory
( makeDisplayInventory
, updateDisplayInventory
( updateDisplayInventory
, defaultDisplaySections
) where
import Data.Maybe
@@ -23,11 +23,25 @@ import Dodge.Data.World
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
updateDisplayInventory w cfig sss = sss
{ _sssSections = restrictsections
--{ _sssSections = restrictsections
{ _sssSections = sections
, _sssSelPos = mspos
, _sssMaxSize = availablelines
}
where
sections = case cr ^? crInvSel . isel of
Just (SelItem i _) -> updateSections availablelines (0,i) [invx ,youx, closex]
Just SelNothing -> updateSections availablelines (1,0) [invx ,youx, closex]
Just (SelCloseObject i) -> updateSections availablelines (2,i) [closex, invx ,youx]
_ -> error "wat"
invx = (0,(invsec, invitems))
youx = (1,(makeYouSection w, youitems))
closex = (2,(cosec, coitems))
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()
thetext = case nfreeslots of
0 -> " INVENTORY FULL"
1 -> " +1 FREE SLOT"
x -> " +" ++ show x ++ " FREE SLOTS"
mspos = do
mo <- cr ^? crInvSel . isel
case mo of
@@ -36,14 +50,12 @@ updateDisplayInventory w cfig sss = sss
SelCloseObject {} -> Just 2
availablelines = getAvailableListLines (invDisplayParams w) cfig
iavailablelines = availablelines - 6
--invsection = makeInventorySection iavailablelines oldoffset w
invsection = updateSection "MORE INV ITEMS" invpos invitems iavailablelines w invsec
invsection = updateSection invpos invitems iavailablelines invsec
invsectionlines = length $ _ssShownItems invsection
restrictsections = IM.fromList
[ (0, invsection )
, (1, makeYouSection w)
--, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
, (2, updateSection "MORE CLOSE OBJECTS" copos coitems (availablelines - invsectionlines - 1) w cosec)
, (2, updateSection copos coitems (availablelines - invsectionlines - 1) cosec)
]
cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
@@ -66,41 +78,30 @@ updateDisplayInventory w cfig sss = sss
SelNothing -> Nothing
SelCloseObject i -> Just i
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
where
ss | i == k = updateSection (Just j) y availablelines x
| otherwise = updateSection Nothing y availablelines x
availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)
defaultCOSection :: SelectionSection ()
defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2
defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2 "CLOSE OBJECTS"
defaultInvSection :: SelectionSection ()
defaultInvSection = SelectionSection mempty Nothing 5 0 0 NoSSRestriction [] 0
defaultInvSection = SelectionSection mempty Nothing 5 0 0 NoSSRestriction [] 0 "INVENTORY ITEMS"
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
--invsection = makeInventorySection iavailablelines (Just 0) w
--invsectionlines = length $ _ssShownItems invsection
restrictsections = IM.fromList
[ (0, defaultInvSection )
, (1, makeYouSection w)
--, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
, (2, defaultCOSection)
]
updateSection :: String -> Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World
-> SelectionSection ()
-> SelectionSection ()
updateSection morestring mspos sis availablelines w ss = ss
updateSection
:: Maybe Int
-> IM.IntMap (SelectionItem a)
-> Int
-- -> World
-> SelectionSection a
-> SelectionSection a
updateSection mspos sis availablelines ss = ss
{ _ssItems = sis
, _ssCursor = scurs
, _ssRestriction = NoSSRestriction
@@ -109,21 +110,20 @@ updateSection morestring mspos sis availablelines w ss = ss
-- , _ssRegex = ""
-- , _ssRegexInput = False
, _ssMinSize = 5
-- , _ssOffset = 0
, _ssShownItems = shownitems
}
where
moldoffset = ss ^? ssOffset
oldoffset = ss ^. ssOffset
scurs = do
csel <- mspos
si <- sis ^? ix csel
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
csize <- selsize
ccolor <- selcolor
csize = length $ _siPictures si
ccolor = _siColor si
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' mcpos
offset' jselpos
@@ -145,97 +145,20 @@ updateSection morestring mspos sis availablelines w ss = ss
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
theindent = replicate (_ssIndent ss) ' '
hdown = color white . text $ theindent ++ ">>> " ++ morestring
hup = color white . text $ theindent ++ "<<< " ++ morestring
hdown = color white . text $ theindent ++ ">>> MORE " ++ _ssDescriptor ss
hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss
g si = map (_siColor si ,) $ _siPictures si
islastitm = fromMaybe False $ do
i <- cr ^? crInvSel . isel . ispItem
k <- fmap fst $ IM.lookupMax (_crInv cr)
i <- mspos
k <- fst <$> IM.lookupMax sis
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
-- 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 ()
makeYouSection w = SelectionSection
@@ -250,6 +173,7 @@ makeYouSection w = SelectionSection
, _ssMinSize = 1
-- , _ssOffset = 0
, _ssShownItems = [color invDimColor $ text thetext]
, _ssDescriptor = "YOUR STATUS"
}
where
cr = you w
@@ -259,43 +183,3 @@ makeYouSection w = SelectionSection
1 -> " +1 FREE SLOT"
x -> " +" ++ show x ++ " FREE SLOTS"
--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
-- , _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/Reloading.hs
+1 -1
View File
@@ -57,7 +57,7 @@ startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
Just la -> cr & startLoadingStep la
Nothing -> case ic ^? laCycle of
Nothing -> cr
Just [] -> error ("item has empty load cycle")
Just [] -> error "item has empty load cycle"
Just _ | _laLoaded ic >= _laMax ic -> cr
Just (la : las) -> fromMaybe (error "item loading error") $ do
i <- cr ^? crInvSel . isel . ispItem
src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -98,7 +98,7 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
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)
pics = foldMap _ssShownItems (_sssSections sss)
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
src/Dodge/Render/List.hs
+2 -2
View File
@@ -119,8 +119,8 @@ listCursorDisplayParams ::
Int ->
Int ->
Picture
listCursorDisplayParams ldp borders cfig yint xint col cursxsize cursysize =
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize
listCursorDisplayParams ldp borders =
listCursorChooseBorderScale ygap s borders xoff yoff
where
ygap = _ldpVerticalGap ldp
s = _ldpScale ldp
src/Dodge/Update/Input.hs
+4 -4
View File
@@ -133,11 +133,11 @@ spaceAction w = case w ^?! hud . hudElement of
toggleMap :: Universe -> Universe
toggleMap u = case u ^?! uvWorld . hud . hudElement of
DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory {_subInventory = NoSubInventory, _diSections = makeDisplayInventory w cfig}
DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory {_subInventory = NoSubInventory, _diSections = defaultDisplaySections}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
where
w = u ^. uvWorld
cfig = u ^. uvConfig
-- where
-- w = u ^. uvWorld
-- cfig = u ^. uvConfig
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of