justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Extend inv item location information to include "attached" items

Browse Source
This commit is contained in:
justin
2024-09-24 21:26:26 +01:00
parent fbb60bf358
commit fe00af0e73
17 changed files with 184 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse.hs
+1 -1
View File
@@ -48,7 +48,7 @@ followImpulse cr w imp = case imp of
TurnTo p -> crup $ creatureTurnTo p cr
ChangePosture post -> crup $ cr & crStance . posture .~ post
UseItem -> (useRootItem $ _crID cr, cr)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ InInventory (SelectedItem i i)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ InInventory (SelectedItem i i mempty)
Melee cid' ->
( hitCr cid'
, crMvAbsolute (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
src/Dodge/Data/Item/Effect.hs
+2 -2
View File
@@ -21,11 +21,11 @@ data ItInvEffect
| ChargeIfEquipped
| ChargeIfInInventory
| SetCharge Int
| EffectIfHeld ItInvEffect ItInvEffect
| EffectRootNotroot ItInvEffect ItInvEffect
| CreateHeldLight
| CreateShieldWall
| RemoveShieldWall
| EffectWhileHeld ItInvEffect
| EffectWhileRoot ItInvEffect
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ItFloorEffect = NoFloorEffect
src/Dodge/Data/Item/Location.hs
+7 -1
View File
@@ -23,7 +23,13 @@ data CrInt = CrInt
deriving (Eq,Ord,Show,Read)
data ItemLocation
= InInv {_ilCrID :: Int, _ilInvID :: Int, _ilIsRoot :: Bool, _ilIsSelected :: Bool}
= InInv
{ _ilCrID :: Int
, _ilInvID :: Int
, _ilIsRoot :: Bool
, _ilIsSelected :: Bool
, _ilIsAttached :: Bool
}
| OnTurret {_ilTuID :: Int}
| OnFloor {_ilFlID :: NewInt FloorInt}
| InVoid
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+6 -1
View File
@@ -5,6 +5,7 @@
module Dodge.Data.Item.Use.Consumption.LoadAction where
import qualified Data.IntSet as IS
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -30,7 +31,11 @@ data NearbyManipulation
data InventoryManipulation
= SortInventory
| SelectedItem { _imSelectedItem :: Int, _imRootItem :: Int}
| SelectedItem
{ _imSelectedItem :: Int
, _imRootItem :: Int
, _imAttachedItems :: IS.IntSet
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data InvSelAction
src/Dodge/DoubleTree.hs
+8
View File
@@ -32,6 +32,14 @@ dtToAdjacency f (DT x l r) = IM.insert (f x) (map g l <> map g r)
where
g = f . _dtValue
dtToIntMapWithRoot :: (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe Int, DoubleTree a)
dtToIntMapWithRoot f t@(DT x l r) = IM.insert (f x) (Nothing, t) $
foldMap (dtToRootIntMap' (f x) f) $ l <> r
dtToRootIntMap' :: Int -> (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe Int, DoubleTree a)
dtToRootIntMap' root f t@(DT x l r) = IM.insert (f x) (Just root, t) $
foldMap (dtToRootIntMap' root f) $ l <> r
dtToUpDownAdj :: (a -> Int) -> DoubleTree a -> IM.IntMap ([Int],[Int])
dtToUpDownAdj f (DT x l r) = IM.insert (f x) (map g l , map g r)
. IM.unions $ map (dtToUpDownAdj f) $ l <> r
src/Dodge/Inventory/Add.hs
+8 -1
View File
@@ -47,8 +47,15 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
-- not sure if the following is necessary
updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it)
.~ InInv cid invid False False
.~ InInv
{_ilCrID = cid
, _ilInvID = invid
, _ilIsRoot = False
, _ilIsSelected = False
, _ilIsAttached = False
}
---- should select the item on the floor if no inventory space?
--createAndSelectItem :: Item -> World -> World
src/Dodge/Inventory/Location.hs
+26 -6
View File
@@ -5,6 +5,8 @@ module Dodge.Inventory.Location
, tryGetRootItemInvID
)
where
import qualified Data.IntSet as IS
import Dodge.Base.You
import Dodge.Data.SelectionList
import Dodge.Data.Item.Use.Consumption.LoadAction
@@ -15,6 +17,15 @@ import Dodge.Item.Grammar
import Data.Maybe
import Control.Applicative
-- assumes all item locations inside the items are correct
tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
tryGetRootAttachedFromInvID invid im = do
let imroots = invRootMap im
theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
t <- imroots ^? ix theroot . _2
return (theroot, foldMap (IS.singleton . (^?! _1 . itLocation . ilInvID)) t)
-- this assumes the creature inventory is well formed, specifically the
-- location ids
tryGetRootItemInvID :: Int -> Creature -> Maybe Int
@@ -22,8 +33,8 @@ tryGetRootItemInvID i cr = do
let adj = case invAdj' (_crInv cr) of
Left str -> error $ "tryToGetRootItemInvID: "++ str
Right x -> x
thetree <- adj ^? ix i -- to check that the index does point to SOME item in the inventory
thetree ^? _1 . _Just . _1 <|> Just i
theroot <- adj ^? ix i
theroot ^? _1 . _Just . _1 <|> Just i
updateRootItemID :: Creature -> Creature
updateRootItemID cr = fromMaybe cr $ do
@@ -44,8 +55,13 @@ crUpdateInvidLocations mo crid lw invid itm = lw
& itemLocations %~ IM.insert itid newloc
where
itid = itm ^. itID
newloc = InInv crid invid (Just invid == mo ^? inInventory . imSelectedItem)
(Just invid == mo ^? inInventory . imRootItem)
newloc = InInv
{ _ilCrID = crid
, _ilInvID = invid
, _ilIsRoot = Just invid == mo ^? inInventory . imSelectedItem
, _ilIsSelected = Just invid == mo ^? inInventory . imRootItem
, _ilIsAttached = invid `IS.member` (mo ^. inInventory . imAttachedItems)
}
-- this should be looked at, as it is sometimes used in functions that need not
-- concern the player creature
@@ -61,8 +77,12 @@ setInvPosFromSS w =
case i of
(-1) -> Just $ InInventory SortInventory
0 -> do
rootid <- tryGetRootItemInvID j (you w)
return $ InInventory $ SelectedItem j rootid
(rootid,aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
return $ InInventory $ SelectedItem
{ _imSelectedItem = j
, _imRootItem = rootid
, _imAttachedItems = aset
}
1 -> Just SelNothing
2 -> Just $ InNearby SortNearby
3 -> Just $ InNearby $ SelCloseObject j
src/Dodge/ItEffect.hs
+4 -4
View File
@@ -12,17 +12,17 @@ doInvEffect iie = case iie of
ChargeIfEquipped -> chargeIfEquipped
ChargeIfInInventory -> chargeIfInInventory
SetCharge i -> setItemCharge i
EffectIfHeld f g -> onOffEff f g
EffectRootNotroot f g -> rootNotrootEff f g
CreateHeldLight -> createHeldLight
CreateShieldWall -> createShieldWall
RemoveShieldWall -> removeShieldWall
EffectWhileHeld f -> onOffEff f NoInvEffect
EffectWhileRoot f -> rootNotrootEff f NoInvEffect
doFloorEffect :: ItFloorEffect -> Int -> World -> World
doFloorEffect NoFloorEffect = const id
onOffEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
onOffEff f g it
rootNotrootEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
rootNotrootEff f g it
| it ^? itLocation . ilIsRoot == Just True = doInvEffect f it
| otherwise = doInvEffect g it
src/Dodge/Item/Grammar.hs
+11
View File
@@ -2,6 +2,7 @@ module Dodge.Item.Grammar
(invTrees
, invIndentIM
, invAdj'
, invRootMap
)
where
import Control.Applicative
@@ -101,6 +102,16 @@ invLDT = joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentComb
-- (error ("invAdj item " ++ show (_itID itm) ++ " location:" ++ show (itm ^? itLocation . ilInvID)) )
-- $ itm ^? itLocation . ilInvID
-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
-- should be done upstream anyway in the actually creature inventory)
invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree ComposedItemStructure)
invRootMap = foldMap (dtToIntMapWithRoot (^?! _1 . itLocation . ilInvID) . ldtToDT) . invLDT
--invRootMap = foldMap (dtToRootIntMap g . ldtToDT) . invLDT
-- where
-- g = _
-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
src/Dodge/Item/Held/Utility.hs
+2 -2
View File
@@ -9,7 +9,7 @@ import Dodge.Data.Item
flatShield :: Item
flatShield =
defaultHeldItem
& itEffect . ieInv .~ EffectIfHeld CreateShieldWall RemoveShieldWall
& itEffect . ieInv .~ EffectRootNotroot CreateShieldWall RemoveShieldWall
& itUse . heldAim . aimWeight .~ 5
& itUse . heldAim . aimTurnSpeed .~ 0.5
& itUse . heldAim . aimStance .~ TwoHandFlat
@@ -26,7 +26,7 @@ latchkey _ = defaultHeldItem
torch :: Item
torch =
defaultHeldItem
& itEffect . ieInv .~ EffectWhileHeld CreateHeldLight
& itEffect . ieInv .~ EffectWhileRoot CreateHeldLight
& itType . iyBase .~ HELD TORCH
-- & itUse . heldAim . aimHandlePos .~ 5
& itUse . heldAim . aimMuzzles . ix 0 . mzPos . _x .~ 10
src/Dodge/Item/Location.hs
+3 -2
View File
@@ -35,12 +35,13 @@ pointerToItemLocation _ = const pure
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourSelectedItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imSelectedItem
Just $ pointerToItemLocation (InInv 0 itinvid True True) f w
Just $ pointerToItemLocation (InInv 0 itinvid True True True) f w
-- note the ilIsRoot/Selected/Attached booleans are irrelevant
pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourRootItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imRootItem
Just $ pointerToItemLocation (InInv 0 itinvid True True) f w
Just $ pointerToItemLocation (InInv 0 itinvid True True True) f w
pointerToItem ::
Applicative f =>
src/Dodge/Item/Location/Initialize.hs
+8 -1
View File
@@ -37,13 +37,20 @@ initCrItemLocations w cr = (w', cr & crInv .~ newinv)
where
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
-- does not worry about creature manipulation for now
initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
,it & itID .~ locid
& itLocation .~ loc)
where
locid = IM.newKey ( w ^. itemLocations)
loc = InInv (_crID cr) invid False False
loc = InInv
{ _ilCrID = _crID cr
, _ilInvID = invid
, _ilIsRoot = False
, _ilIsSelected = False
, _ilIsAttached = False
}
initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
src/Dodge/Item/Weapon/Remote.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Geometry
setRemoteScope :: Int -> Point2 -> World -> World
setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of
Just (InInv cid' invid _ _) ->
Just (InInv cid' invid _ _ _) ->
w
& cWorld . lWorld . creatures . ix cid' . crInv . ix invid . itScope
. remotePos
src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -125,7 +125,7 @@ floorItemPickupInfo n itm
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (InInventory (SelectedItem i _)) -> f $ yourInv w ^?! ix i
Just (InInventory (SelectedItem i _ _)) -> f $ yourInv w ^?! ix i
Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
_ -> x
src/Dodge/TestString.hs
+3 -2
View File
@@ -25,7 +25,8 @@ testStringInit u = (topTestPart u
(IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <> ( IM.elems $ fmap h (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crInv))
where
h itm = (_itID itm, _itLocation itm)
showh (x,(InInv a b c d)) = show x ++ "," ++ show a ++ "," ++ show b ++"," ++ show c ++"," ++ show d
showh (x,(InInv a b c d e)) = show x ++ "," ++ show a ++ "," ++ show b ++"," ++ show c ++"," ++ show d
++ "," ++ show e
showh _ = ""
topTestPart :: Universe -> [String]
@@ -35,7 +36,7 @@ topTestPart u = [show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra
showManObj :: ManipulatedObject -> String
showManObj (InInventory SortInventory) = "SortInventory"
showManObj (InInventory (SelectedItem x y)) = "SelItem: "++ show x++ " Root: "++show y
showManObj (InInventory (SelectedItem x y z)) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z
showManObj (SelNothing) = "SelNothing"
showManObj ((InNearby SortNearby)) = "SortNearby"
showManObj (InNearby (SelCloseObject x)) = "Close " ++ show x