Add files

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"

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
+