From 24825728f559743c74872efd53c595beccbd2204 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 11 Feb 2023 13:10:10 +0000 Subject: [PATCH] Unify inventory sections further (slow?) --- src/Dodge/Creature/Impulse/UseItem.hs | 3 +- src/Dodge/Data/SelectionList.hs | 1 + src/Dodge/DisplayInventory.hs | 212 ++++++-------------------- src/Dodge/Reloading.hs | 2 +- src/Dodge/Render/HUD.hs | 2 +- src/Dodge/Render/List.hs | 4 +- src/Dodge/Update/Input.hs | 8 +- 7 files changed, 58 insertions(+), 174 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 52abaae1a..1aeb9f95a 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -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 diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index abd756061..1ab1332b5 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -60,6 +60,7 @@ data SelectionSection a = SelectionSection , _ssRestriction :: SSRestriction , _ssShownItems :: [Picture] , _ssIndent :: Int + , _ssDescriptor :: String } diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 94b3508a4..947c2acca 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -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 - - diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 9e49c86d9..0e5a83d5f 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 8be76a5f0..4a2846680 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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 diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 0a9f38bbe..35bc761a1 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -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 diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index cacb6967a..536900e9d 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -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