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

Improve item location code

Browse Source
This commit is contained in:
justin
2024-09-22 14:29:02 +01:00
parent 236f7c7750
commit 4f6431968c
25 changed files with 218 additions and 186 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Draw.hs
+3 -2
View File
@@ -16,10 +16,11 @@ import ShapePicture
itemEquipPict :: Creature -> Item -> SPic
itemEquipPict cr it = case it ^. itUse of
HeldUse{} | _itIsRoot it -> overPosSP (heldItemOffset it cr) (itemSPic it)
HeldUse{} | it ^? itLocation . ilIsRoot == Just True
-> overPosSP (heldItemOffset it cr) (itemSPic it)
ituse -> fromMaybe mempty $ do
attachpos <- ituse ^? equipEffect . eeAttachPos
i <- it ^? itLocation . ipInvID
i <- it ^? itLocation . ilInvID
epos <- cr ^? crInvEquipped . ix i
return $ equipPosition epos cr attachpos (itemSPic it)
src/Dodge/Item/Grammar.hs
+2 -2
View File
@@ -96,7 +96,7 @@ invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
invAdj = IM.unions . fmap (dtToLRAdj getid . ldtToDT) . invLDT
where
getid (itm, _,_,_) = fromMaybe (error "invAdj attempt to find item not in inventory") $
itm ^? itLocation . ipInvID
itm ^? itLocation . ilInvID
invIndentIM :: IM.IntMap Item -> IM.IntMap (Item,Int, LabelDoubleTreeNodeType ComposeLinkType )
invIndentIM = IM.fromAscList . zip [0..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT
@@ -106,7 +106,7 @@ invTrees = IM.unions . map (ldtToIM getindex) . map (fmap cisToItem) . invLDT
where
getindex :: Item -> Int
getindex i = fromMaybe (error "in invTrees try to get non-inventory item tree") $
i ^? itLocation . ipInvID
i ^? itLocation . ilInvID
--indentInv :: IM.IntMap Item -> [String]
--indentInv = concat . fmap (flattenDT . indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap const "")
src/Dodge/Item/HeldOffset.hs
+1 -1
View File
@@ -44,7 +44,7 @@ heldItemOffset itm cr
| otherwise = id
where
handD = 15
isroot = _itIsRoot itm
isroot = _ilIsRoot $ _itLocation itm -- should make safe?
handPos = case cr ^? crStance . carriage of
Just (Walking x LeftForward) -> f x * 50
_ -> 0
src/Dodge/Item/Location.hs
+6 -4
View File
@@ -15,7 +15,8 @@ getItem itid w = do
itpos <- w ^? cWorld . lWorld . itemLocations . ix itid
case itpos of
OnFloor flitid -> w ^? cWorld . lWorld . floorItems . ix flitid . flIt
InInv cid invid -> w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
InInv {_ilCrID = cid, _ilInvID = invid}
-> w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
OnTurret mcid -> w ^? cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuWeapon
InVoid -> Nothing
@@ -25,19 +26,20 @@ pointerToItemLocation ::
(Item -> f Item) ->
World ->
f World
pointerToItemLocation (InInv cid invid) = cWorld . lWorld . creatures . ix cid . crInv . ix invid
pointerToItemLocation InInv {_ilCrID = cid, _ilInvID = invid}
= cWorld . lWorld . creatures . ix cid . crInv . ix invid
pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt
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) f w
Just $ pointerToItemLocation (InInv 0 itinvid True True) f w
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) f w
Just $ pointerToItemLocation (InInv 0 itinvid True True) f w
pointerToItem ::
Applicative f =>
src/Dodge/Item/Location/Initialize.hs
+1 -1
View File
@@ -42,7 +42,7 @@ initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
& itLocation .~ loc)
where
locid = IM.newKey ( w ^. itemLocations)
loc = InInv (_crID cr) invid
loc = InInv (_crID cr) invid False False
initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
src/Dodge/Item/Weapon/ExtraEffect.hs
+2 -2
View File
@@ -19,7 +19,7 @@ autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item ->
autoEffect eff t sid itm cr w
| _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 =
eff itm cr w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. equipEffect
. eeParams
@@ -28,7 +28,7 @@ autoEffect eff t sid itm cr w
& soundStart OnceSound (_crPos cr) sid Nothing
| otherwise =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. equipEffect
. eeParams
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/Item/Weapon/TriggerType.hs
+2 -2
View File
@@ -366,7 +366,7 @@ useAmmoAmount amAmount eff item cr = fromMaybe id $ do
atype <- item ^? ldtValue . itUse . heldAmmoTypes . ix 0
leftitms <- item ^? ldtLeft
mag <- lookup (AmmoInLink 0 atype) leftitms
magid <- mag ^? ldtValue . itLocation . ipInvID
magid <- mag ^? ldtValue . itLocation . ilInvID
-- invid <- ams ^? ix 0 . itLocation . ipInvID
return $ eff item cr
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ amAmount)
@@ -443,7 +443,7 @@ shootL f item cr w
| otherwise = w
where
cid = _crID cr
invid = _ipInvID $ _itLocation item
invid = _ilInvID $ _itLocation item
fireCondition =
_rateTime (_leftDelay (_itUse item)) == 0
&& _arLoaded (_leftConsumption (_itUse item)) > 0