From 3a08cf93f5463b793749bddd05d24d24431e56c5 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 23 Sep 2024 13:12:25 +0100 Subject: [PATCH] Add files --- src/Dodge/Inventory/Location.hs | 59 +++++++++++++++++++++++++++++++++ src/Dodge/SelectUse.hs | 23 +++++++++++++ 2 files changed, 82 insertions(+) create mode 100644 src/Dodge/Inventory/Location.hs create mode 100644 src/Dodge/SelectUse.hs diff --git a/src/Dodge/Inventory/Location.hs b/src/Dodge/Inventory/Location.hs new file mode 100644 index 000000000..73b45e2f8 --- /dev/null +++ b/src/Dodge/Inventory/Location.hs @@ -0,0 +1,59 @@ +module Dodge.Inventory.Location + where +import Dodge.Base.You +import Dodge.Data.SelectionList +import Dodge.Data.Item.Use.Consumption.LoadAction +import Control.Lens +import Dodge.Data.World +import qualified IntMapHelp as IM +import Dodge.Item.Grammar +import Data.Maybe +import Control.Applicative + +tryGetRootItemInvID :: Int -> Creature -> Maybe Int +tryGetRootItemInvID i cr = do + let adj = invAdj (_crInv cr) + thetree <- adj ^? ix i -- to check that the index does point to SOME item in the inventory + thetree ^? _1 . _Just . _1 <|> Just i + +updateRootItemID :: Creature -> Creature +updateRootItemID cr = fromMaybe cr $ do + i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem + j <- tryGetRootItemInvID i cr + return $ cr & crManipulation . manObject . inInventory . imRootItem .~ j + +-- the following assumes that the crManipulation is correct +crUpdateItemLocations :: Int -> LWorld -> LWorld +crUpdateItemLocations crid lw = fromMaybe lw $ do + mo <- lw ^? creatures . ix crid . crManipulation . manObject + crinv <- lw ^? creatures . ix crid . crInv + return $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv + +crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld +crUpdateInvidLocations mo crid lw invid itm = lw + & creatures . ix crid . crInv . ix invid . itLocation .~ newloc + & itemLocations . ix itid .~ newloc + where + itid = itm ^. itID + newloc = InInv crid invid (Just invid == mo ^? inInventory . imSelectedItem) + (Just invid == mo ^? inInventory . imRootItem) + +-- this should be looked at, as it is sometimes used in functions that need not +-- concern the player creature +setInvPosFromSS :: World -> World +setInvPosFromSS w = + w + & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel + where + thesel = fromMaybe SelNothing $ do + sss <- w ^? hud . hudElement . diSections + (i, j) <- sss ^? sssExtra . sssSelPos . _Just + case i of + (-1) -> Just $ InInventory SortInventory + 0 -> do + rootid <- tryGetRootItemInvID j (you w) + return $ InInventory $ SelectedItem j rootid + 1 -> Just SelNothing + 2 -> Just $ InNearby SortNearby + 3 -> Just $ InNearby $ SelCloseObject j + _ -> error "selection out of bounds" diff --git a/src/Dodge/SelectUse.hs b/src/Dodge/SelectUse.hs new file mode 100644 index 000000000..b288be948 --- /dev/null +++ b/src/Dodge/SelectUse.hs @@ -0,0 +1,23 @@ +module Dodge.SelectUse + where + +import Dodge.Payload +import Dodge.Data.ComposedItem +import Dodge.Data.DoubleTree +import Dodge.Data.World +import Data.Maybe +import Control.Lens + +selectUse :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World +selectUse ittree _ w = fromMaybe w $ do + pjid <- ittree ^? ldtValue . itUse . atLinkedProjectile . _Just + thepj <- w ^? cWorld . lWorld . projectiles . ix pjid + return $ w + & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote 69 30 pjid] -- 69 is placeholder, should be removed + & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile +-- & itPoint . itUse . heldUse .~ HeldDoNothing +-- & itPoint . itUse . heldMods .~ DoNothingMod + & usePayload (_prjPayload thepj) (_prjPos thepj) + where +-- itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid +