From 90370e54875b1f02a627f989bd221ec02d880ce6 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 17 Feb 2023 18:37:55 +0000 Subject: [PATCH] Continue inventory work --- src/Dodge/DisplayInventory.hs | 13 ++++++----- src/Dodge/Inventory.hs | 2 +- src/Dodge/Inventory/SelectionList.hs | 28 ++++++----------------- src/Dodge/Render/HUD.hs | 33 +++++----------------------- 4 files changed, 20 insertions(+), 56 deletions(-) diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index d85019f8d..a7dbab4b6 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -50,7 +50,8 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0) Nothing -> mempty filtclose = (2,(filtclosesec,filtcloseitems)) - filtclosesec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix 2 + filtclosesec = fromMaybe (defaultFiltSection & ssIndent .~ 2) + $ sss ^? sssSections . ix 2 filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0) Nothing -> mempty @@ -67,7 +68,7 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of 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) + $ map closeObjectToSelectionItem (w ^. hud . closeObjects) coitems = case cr ^? crManipulation . closeRegex . _Just of Just str -> IM.filter (regexList str . _siPictures) coitems' Nothing -> coitems' @@ -81,9 +82,9 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of displayFreeSlots :: Int -> String displayFreeSlots x = case x of - 0 -> " INVENTORY FULL" - 1 -> " +1 FREE SLOT" - _ -> " +" ++ show x ++ " FREE SLOTS" + 0 -> "INVENTORY FULL" + 1 -> "1 FREE SLOT" + _ -> show x ++ " FREE SLOTS" updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))] -> IM.IntMap (SelectionSection a) @@ -169,7 +170,7 @@ updateSection mspos sis' availablelines ss = ss allstrings = foldMap g sis mustrestrict = length allstrings > availablelines shownstrings = drop offset allstrings - h (col,str) = color col . text $ str + h (col,str) = color col . text $ theindent ++ str theindent = replicate (_ssIndent ss) ' ' hdown = color white . text $ theindent ++ ">>> MORE " ++ _ssDescriptor ss hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 0bb2cd9f3..c920641ca 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -157,7 +157,7 @@ selSecSelPos i j sss = do . fmap (length . _siPictures) . fst $ IM.split j (ss ^. ssItems) where - secpos = sum . fmap (length . _ssItems) . fst $ IM.split i $ sss ^. sssSections + secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss ^. sssSections selNumPos :: ManipulatedObject -> World -> Maybe Int selNumPos mo w = w ^? hud . hudElement . diSections >>= diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 98224ad3b..1712c9b48 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -5,8 +5,6 @@ module Dodge.Inventory.SelectionList ) where ---import Dodge.Default.SelectionList -import Dodge.Inventory.Color import Dodge.Item.Display import Dodge.Inventory.ItemSpace import Picture.Base @@ -54,8 +52,8 @@ invSelectionItem cr (i,it) = SelectionItem _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it _ -> itemDisplay it -- -closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem () -closeObjectToSelectionItem n e = SelectionItem +closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem () +closeObjectToSelectionItem e = SelectionItem { _siPictures = pics , _siHeight = length pics , _siIsSelectable = True @@ -65,21 +63,9 @@ closeObjectToSelectionItem n e = SelectionItem , _siPayload = () } where - (pics,col) = closeObjectToTextPictures' n e + (pics,col) = closeObjectToTextPictures e -- -closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([String],Color) -closeObjectToTextPictures' nfreeslots e = case e of - Left flit -> let it = _flIt flit - in (map textindent $ itemDisplay it, thecol it) - Right bt -> ([textindent $ _btText bt], yellow) - where - textindent = (replicate clObjIntIn ' ' ++) - thecol it - | nfreeslots >= itSlotsTaken it = _itInvColor it - | otherwise = invDimColor --- -clObjIntIn :: Int -clObjIntIn = 2 --- ---clObjFloatIn :: Float ---clObjFloatIn = fromIntegral clObjIntIn * 9 +closeObjectToTextPictures :: Either FloorItem Button -> ([String],Color) +closeObjectToTextPictures e = case e of + Left flit -> let it = _flIt flit in ( itemDisplay it, _itInvColor it) + Right bt -> ([_btText bt], yellow) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index c4c7f0bf8..ddc72cc7d 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -77,25 +77,12 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff cfig 0 pics - <> color thecolor thecursor + <> thecursor' where - thecolor = fromMaybe white $ do - spos <- _sssSelPos sss - sss ^? sssSections . ix spos . ssCursor . _Just . scurColor - thecursor = fromMaybe mempty $ do - sectype <- you w ^? crManipulation . manObject - let secnum = case sectype of - InInventory SortInventory -> negate 1 - InInventory {} -> 0 - SelNothing{} -> 1 - InNearby SortNearby -> 2 - InNearby{} -> 3 - 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 . ssCursor . _Just . scurPos - csize <- sss ^? sssSections . ix spos . ssCursor . _Just . scurSize - return $ listCursorDisplayParams ldps [North,South,West] cfig (yint + y) xint white 15 csize + thecursor' = fromMaybe mempty $ do + i <- sss ^? sssSelPos . _Just + j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel + return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j ldps = invDisplayParams w pics = foldMap _ssShownItems (_sssSections sss) @@ -331,16 +318,6 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig hh = halfHeight cfig hw = halfWidth cfig -topCursorTypeWidth :: - (Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture) -> - Int -> - Configuration -> - World -> - Int -> - Picture -topCursorTypeWidth ctype width cfig w i = - ctype 0 0 cfig (fromMaybe 0 (selNumPos (InInventory (SelItem i NoInvSelAction)) w)) 0 (selNumCol i w) width (invSelSize (InInventory (SelItem i NoInvSelAction)) w) - determineInvSelCursorWidth :: World -> Int determineInvSelCursorWidth w = case _rbOptions w of NoRightButtonOptions -> topInvW