From 683acf8a054f5827e5a7767dbb2e98210c0ad838 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 23 Feb 2023 14:12:08 +0000 Subject: [PATCH] Allow for swapping inventory items --- src/Dodge/Data/Creature.hs | 3 - src/Dodge/DisplayInventory.hs | 10 --- src/Dodge/Inventory.hs | 133 +++++++++++++++++++++---------- src/Dodge/Reloading.hs | 6 +- src/Dodge/SelectionSections.hs | 57 +++++++------ src/Dodge/TestString.hs | 4 +- src/Dodge/Update/Input/InGame.hs | 40 ++++++---- src/Dodge/Update/Scroll.hs | 2 +- src/IntMapHelp.hs | 10 +++ 9 files changed, 161 insertions(+), 104 deletions(-) diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index ef5651908..6923c8a63 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -97,9 +97,6 @@ data Intention = Intention --deriving (Eq, Show, Read) --Generic, Flat) -crSel :: Creature -> ManipulatedObject -crSel = _manObject . _crManipulation - makeLenses ''Creature makeLenses ''CreatureTargeting makeLenses ''Intention diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index db627ccd9..a98e344e4 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -171,14 +171,6 @@ updateSectionsPositioning mselpos allavailablelines ((k, y) : xs) sss = linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss') previoussections = updateSectionsPositioning mselpos availablelines xs sss ---manObjIndex :: ManipulatedObject -> (Int,Int) ---manObjIndex mo = case mo of --- InInventory SortInventory -> (-1, 0) --- InInventory (SelItem i _) -> (0, i) --- SelNothing -> (1,0) --- InNearby SortNearby -> (2,0) --- InNearby (SelCloseObject i) -> (3,i) - updateSection :: IM.IntMap (SelectionItem a) -> Maybe Int -> @@ -247,8 +239,6 @@ enterCombineInv cfig w = cm' sss where - --(updateCombineSelections w cfig sss) - cm' = IM.fromAscList $ zip [0 ..] $ combineList' w cm | null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0 diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 8760c253c..362930940 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -4,7 +4,6 @@ module Dodge.Inventory ( selSecSelPos, checkInvSlotsYou, rmSelectedInvItem, - selNumPos, selNumTextEndPos, selSecSelCol, selNumEndMidHeight, @@ -13,7 +12,7 @@ module Dodge.Inventory ( updateRBList, updateTerminal, closeObjScrollDir, - changeSwapInvSel, + changeSwapSel, scrollAugInvSel, crNumFreeSlots, crInvSize, @@ -55,8 +54,10 @@ rmInvItem :: World -> World rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of - Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount -~ 1 - & worldEventFlags . at InventoryChange ?~ () + Just x + | x > 1 -> + w & pointcid . crInv . ix invid . itUse . useAmount -~ 1 + & worldEventFlags . at InventoryChange ?~ () _ -> w & pointcid %~ crCancelReloading @@ -112,15 +113,15 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan Just i -> rmInvItem cid i w Nothing -> w -selNumPos :: ManipulatedObject -> World -> Maybe Int -selNumPos mo w = - w ^? hud . hudElement . diSections - >>= case mo of - InInventory SortInventory -> selSecSelPos (-1) 0 - InInventory (SelItem i _) -> selSecSelPos 0 i - SelNothing -> selSecSelPos 1 0 - InNearby SortNearby -> selSecSelPos 2 0 - InNearby (SelCloseObject i) -> selSecSelPos 3 i +--selNumPos :: ManipulatedObject -> World -> Maybe Int +--selNumPos mo w = +-- w ^? hud . hudElement . diSections +-- >>= case mo of +-- InInventory SortInventory -> selSecSelPos (-1) 0 +-- InInventory (SelItem i _) -> selSecSelPos 0 i +-- SelNothing -> selSecSelPos 1 0 +-- InNearby SortNearby -> selSecSelPos 2 0 +-- InNearby (SelCloseObject i) -> selSecSelPos 3 i -- there are still more ListDisplayParams to integrate here selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 @@ -327,37 +328,89 @@ closeObjScrollDir x | x < 0 = over (hud . closeObjects) rotD | otherwise = id -changeSwapInvSel :: Int -> World -> World -changeSwapInvSel k w = case you w ^? crManipulation . manObject of - Just (InInventory (SelItem i _)) -> - w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i - & worldEventFlags . at InventoryChange ?~ () - Just (InNearby (SelCloseObject i)) -> - w - & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject - .~ ((i - k) `mod` numCO) - & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO) - & worldEventFlags . at InventoryChange ?~ () - _ -> w +changeSwapSel :: Int -> World -> World +changeSwapSel yi w + | yi == 0 = w + | yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT) + | otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT) where - updatecreature i = - (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i)) - . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i) - . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k) - . (crInvEquipped %~ IM.safeSwapKeys i (swapi i)) - . swapSite i (swapi i) - . swapSite (swapi i) i + f g i m = fst <$> g i m + +changeSwapClose :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) + -> Int -> World -> World +changeSwapClose f i w = fromMaybe w $ do + ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems + k <- f i ss + return $ w + & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject + .~ k + & hud . closeObjects %~ swapIndices i k + & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k + & worldEventFlags . at InventoryChange ?~ () + +changeSwapInv :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) + -> Int -> World -> World +changeSwapInv f i w = fromMaybe w $ do + ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems + k <- f i ss + return $ + w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k + & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k + & worldEventFlags . at InventoryChange ?~ () + where + updateLeftInvSel k li + | i == li = k + | k == li = i + | otherwise = li + updatecreature k = + (crInv %~ IM.safeSwapKeys i k) + . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k) + . (crManipulation . manObject . inInventory . ispItem .~ k) + . (crInvEquipped %~ IM.safeSwapKeys i k) + . swapSite i k + . swapSite k i + cr = you w swapSite a b = case cr ^? crInvEquipped . ix a of Just epos -> crEquipment . ix epos .~ b Nothing -> id - cr = you w - swapi i = (i - k) `mod` n - updateLeftInvSel i li - | i == li = swapi i - | swapi i == li = i - | otherwise = li - n = length $ _crInv cr - numCO = length $ w ^. hud . closeObjects + +changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World +changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of + Just (0,i) -> w & changeSwapInv f i + Just (3,i) -> w & changeSwapClose f i + _ -> w + +--changeSwapInvSel' :: Int -> World -> World +--changeSwapInvSel' k w = case you w ^? crManipulation . manObject of +-- Just (InInventory (SelItem i _)) -> +-- w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i +-- & worldEventFlags . at InventoryChange ?~ () +-- Just (InNearby (SelCloseObject i)) -> +-- w +-- & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject +-- .~ ((i - k) `mod` numCO) +-- & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO) +-- & worldEventFlags . at InventoryChange ?~ () +-- _ -> w +-- where +-- updatecreature i = +-- (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i)) +-- . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i) +-- . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k) +-- . (crInvEquipped %~ IM.safeSwapKeys i (swapi i)) +-- . swapSite i (swapi i) +-- . swapSite (swapi i) i +-- swapSite a b = case cr ^? crInvEquipped . ix a of +-- Just epos -> crEquipment . ix epos .~ b +-- Nothing -> id +-- cr = you w +-- swapi i = (i - k) `mod` n +-- updateLeftInvSel i li +-- | i == li = swapi i +-- | swapi i == li = i +-- | otherwise = li +-- n = length $ _crInv cr +-- numCO = length $ w ^. hud . closeObjects scrollAugInvSel :: Int -> World -> World scrollAugInvSel yi w diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 823183c2e..2242aa7e2 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -16,9 +16,9 @@ crCancelReloading cr = & updateProgress & crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction where - updateProgress = case crSel cr of - InInventory (SelItem i _) -> crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing - _ -> id + updateProgress = fromMaybe id $ do + InInventory (SelItem i _) <- cr ^? crManipulation . manObject + return $ crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing stepReloading :: Creature -> Creature stepReloading cr = case cr ^? crManipulation . manObject . inInventory of diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index 24112526f..05eb25f6e 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -17,41 +17,37 @@ import Dodge.Data.SelectionList scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a scrollSelectionSections yi sss | yi == 0 = sss - | yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections - | otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections + | yi > 0 = foldr ($) sss $ replicate yi (ssScrollUsing ssLookupUp) + | otherwise = foldr ($) sss $ replicate (negate yi) (ssScrollUsing ssLookupDown) setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a setFirstPosSelectionSections sss = fromMaybe sss $ do (i, j, _) <- ssLookupMin sss return $ sss & sssExtra . sssSelPos ?~ (i, j) -scrollUpSelectionSections :: SelectionSections a -> SelectionSections a -scrollUpSelectionSections sss = sss & sssExtra . sssSelPos .~ - fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) +ssScrollUsing :: + (Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) -> + SelectionSections a -> + SelectionSections a +ssScrollUsing g sss = + sss & sssExtra . sssSelPos + .~ fmap f (ssScrollUsing' g (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) where - f (i,j,_) = (i,j) + f (i, j, _) = (i, j) -ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) -ssScrollUp sss = l <|> ssLookupMin sss +ssScrollUsing' :: + ( Int -> + Int -> + SelectionSections a -> + Maybe (Int, Int, SelectionItem a) + ) -> + SelectionSections a -> + Maybe (Int, Int, SelectionItem a) +ssScrollUsing' f sss = l <|> ssLookupMin sss where l = do - (i,j) <- sss ^? sssExtra . sssSelPos . _Just - ssLookupUp i j sss - -ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) -ssScrollDown sss = l <|> ssLookupMin sss - where - l = do - (i,j) <- sss ^? sssExtra . sssSelPos . _Just - ssLookupDown i j sss - -scrollDownSelectionSections :: SelectionSections a -> SelectionSections a -scrollDownSelectionSections sss = sss & sssExtra . sssSelPos .~ - fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) - where - f (i,j,_) = (i,j) - --- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) + (i, j) <- sss ^? sssExtra . sssSelPos . _Just + f i j sss ssSetCursor :: (SelectionSections a -> Maybe (Int, Int, SelectionItem a)) -> @@ -131,11 +127,12 @@ selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j selSecSelPos :: Int -> Int -> SelectionSections a -> Maybe Int selSecSelPos i j sss = do ss <- sss ^? sssSections . ix i - return . (secpos +) - . subtract (ss ^. ssOffset) - . sum - . fmap (length . _siPictures) - . fst $ IM.split j (ss ^. ssItems) + return . (secpos +) + . subtract (ss ^. ssOffset) + . sum + . fmap (length . _siPictures) + . fst + $ IM.split j (ss ^. ssItems) where secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss ^. sssSections diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index b4e68837e..2f2a48223 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -3,14 +3,14 @@ module Dodge.TestString where import Data.Aeson (ToJSON) import Data.ByteString.Lazy.Char8 (unpack) import qualified Data.Aeson.Encode.Pretty as AEP ---import Control.Lens +import Control.Lens import Dodge.Data.Universe --import Data.Maybe --import ShortShow --import qualified Data.Map.Strict as M --import qualified IntMapHelp as IM testStringInit :: Universe -> [String] -testStringInit _ = [] +testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just] -- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections] getPretty :: ToJSON a => a -> [String] diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 77b01d61b..45b990809 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -1,6 +1,6 @@ -module Dodge.Update.Input.InGame - ( updateUseInputInGame - ) where +module Dodge.Update.Input.InGame ( + updateUseInputInGame, +) where import qualified Data.IntMap.Strict as IM import Data.List (sort) @@ -39,10 +39,13 @@ updateUseInputInGame h u = case h of | lbinitialpress -> u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True CombineInventory{_ciSections = sss} - | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1) - & uvWorld . worldEventFlags . at CombineInventoryChange ?~ () - | lbinitialpress -> (uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $ over uvWorld (tryCombine sss) u + | inSubInvRegex (u ^. uvWorld) -> + u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1) & uvWorld . worldEventFlags . at CombineInventoryChange ?~ () + | lbinitialpress -> + (uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $ + over uvWorld (tryCombine sss) u + & uvWorld . worldEventFlags . at CombineInventoryChange ?~ () -- _ -> case regexFocus w of -- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys -- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput @@ -154,11 +157,16 @@ doRegexInput u i sss updateBackspaceRegex :: World -> World updateBackspaceRegex w = case di ^? subInventory of - Just NoSubInventory | secfocus (-1) 0 -> w & hud . hudElement . diSections %~ trybackspace (-1) - & worldEventFlags . at InventoryChange ?~ () - Just NoSubInventory | secfocus 2 3 -> w & hud . hudElement . diSections %~ trybackspace 2 - & worldEventFlags . at InventoryChange ?~ () - Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1) + Just NoSubInventory + | secfocus (-1) 0 -> + w & hud . hudElement . diSections %~ trybackspace (-1) + & worldEventFlags . at InventoryChange ?~ () + Just NoSubInventory + | secfocus 2 3 -> + w & hud . hudElement . diSections %~ trybackspace 2 + & worldEventFlags . at InventoryChange ?~ () + Just CombineInventory{} -> + w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1) & worldEventFlags . at InventoryChange ?~ () _ -> w where @@ -208,10 +216,12 @@ spaceAction :: World -> World spaceAction w = case w ^. hud . hudElement of DisplayCarte -> w & hud . carteCenter .~ theLoc DisplayInventory{_subInventory = NoSubInventory} -> case selectedCloseObject w of - Just (Left flit) -> pickUpItem 0 flit w - & worldEventFlags . at InventoryChange ?~ () - Just (Right but) -> doButtonEvent (_btEvent but) but w - & worldEventFlags . at InventoryChange ?~ () + Just (Left flit) -> + pickUpItem 0 flit w + & worldEventFlags . at InventoryChange ?~ () + Just (Right but) -> + doButtonEvent (_btEvent but) but w + & worldEventFlags . at InventoryChange ?~ () _ -> w DisplayInventory{_subInventory = DisplayTerminal{}} -> w & hud . hudElement . subInventory .~ NoSubInventory diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 885e13d96..60a428d27 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -31,7 +31,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of (Nothing, _) -> closeObjScrollDir y w (Just f, _) -> doHeldScroll f y (you w) w | lbDown -> w & cWorld . camPos . camZoom +~ y - | invKeyDown -> changeSwapInvSel yi w + | invKeyDown -> changeSwapSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w DisplayInventory {_subInventory = ExamineInventory mi} | invKeyDown && rbDown -> w & moveTweakSel yi diff --git a/src/IntMapHelp.hs b/src/IntMapHelp.hs index 7d05e8011..57544d26a 100644 --- a/src/IntMapHelp.hs +++ b/src/IntMapHelp.hs @@ -15,8 +15,12 @@ module IntMapHelp unsafeSwapKeys, safeSwapKeys, findIndex, + + cycleGT, + cycleLT, ) where +import Control.Applicative import Data.Aeson import Data.IntMap.Strict import GHC.Generics @@ -84,3 +88,9 @@ findIndex t = foldrWithKey f Nothing f k x _ | t x = Just k | otherwise = Nothing + +cycleGT :: Int -> IntMap a -> Maybe (Int, a) +cycleGT i m = lookupGT i m <|> lookupMin m + +cycleLT :: Int -> IntMap a -> Maybe (Int, a) +cycleLT i m = lookupLT i m <|> lookupMax m