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/Creature/Action.hs
+1 -11
View File
@@ -15,7 +15,7 @@ module Dodge.Creature.Action (
copyInvItemToFloor,
youDropItem,
pickUpItem,
pickUpItemID,
-- pickUpItemID,
) where
import Control.Applicative
@@ -210,8 +210,6 @@ copyInvItemToFloor :: Creature -> Int -> World -> World
copyInvItemToFloor cr i =
copyItemToFloor (_crPos cr) $
_crInv cr IM.! i
& itIsSelected .~ False
& itIsRoot .~ False
sizeSelf :: Float -> Creature -> World -> Maybe World
sizeSelf x cr w
@@ -236,11 +234,3 @@ sizeSelf x cr w
cid = _crID cr
cpos = _crPos cr
pickUpItemID :: Int -> Int -> World -> World
pickUpItemID cid flid w = pickUpItem cid (w ^?! cWorld . lWorld . floorItems . ix flid) w
-- | Pick up a specific item.
pickUpItem :: Int -> FloorItem -> World -> World
pickUpItem cid flit w =
maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
tryPutItemInInv cid flit w
src/Dodge/Creature/Impulse/UseItem.hs
+1 -1
View File
@@ -47,7 +47,7 @@ itemEffect cr it w = case it ^. ldtValue . itUse of
itm = it ^. ldtValue
doequipmentchange = fromMaybe w $ do
guard (_crHammerPosition cr == HammerUp)
invid <- itm ^? itLocation . ipInvID
invid <- itm ^? itLocation . ilInvID
return $ toggleEquipmentAt invid cr w
toggleEquipmentAt :: Int -> Creature -> World -> World
src/Dodge/Creature/State.hs
+5 -5
View File
@@ -248,10 +248,10 @@ invSideEff cr w =
itemInvSideEffect :: Creature -> Item -> World -> World
itemInvSideEffect cr it
| hastorchattach = createAttachLight cr it
-- | hastorchattach = createAttachLight cr it
| otherwise = id
where
hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsRoot it
-- hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsRoot it
createAttachLight :: Creature -> Item -> World -> World
createAttachLight cr it = createTorchLightOffset cr it attachoff
@@ -262,9 +262,9 @@ itemUpdate :: Creature -> Int -> Item -> Item
itemUpdate cr i =
updateAutoRecharge
. (itUse %~ useUpdate)
. (itLocation .~ InInv (_crID cr) i)
. (itIsRoot .~ itmisroot)
. (itIsSelected .~ itmisselected)
. (itLocation .~ InInv (_crID cr) i itmisselected itmisroot)
-- . (itIsRoot .~ itmisroot)
-- . (itIsSelected .~ itmisselected)
where
itmisroot = Just i == (cr ^? crManipulation . manObject . inInventory . imRootItem)
itmisselected = Just i == (cr ^? crManipulation . manObject . inInventory . imSelectedItem)
src/Dodge/Cuse.hs
+1 -1
View File
@@ -7,7 +7,7 @@ import Data.Maybe
useC :: Cuse -> Item -> Creature -> World -> World
useC cu itm cr = fromMaybe id $ do
i <- itm ^? itLocation . ipInvID
i <- itm ^? itLocation . ilInvID
return $ rmInvItem (_crID cr) i . useC' cu itm cr
useC' :: Cuse -> Item -> Creature -> World -> World
src/Dodge/Data/Item.hs
+2 -2
View File
@@ -35,8 +35,8 @@ data Item = Item
, _itType :: ItemType
, _itID :: Int
, _itLocation :: ItemLocation
, _itIsRoot :: Bool
, _itIsSelected :: Bool
-- , _itIsRoot :: Bool
-- , _itIsSelected :: Bool
, _itEffect :: ItEffect
, _itInvSize :: Float
, _itDimension :: ItemDimension
src/Dodge/Data/Item/Location.hs
+3 -3
View File
@@ -9,9 +9,9 @@ import Data.Aeson
import Data.Aeson.TH
data ItemLocation
= InInv {_ipCrID :: Int, _ipInvID :: Int}
| OnTurret {_ipTuID :: Int}
| OnFloor {_ipFlID :: Int}
= InInv {_ilCrID :: Int, _ilInvID :: Int, _ilIsRoot :: Bool, _ilIsSelected :: Bool}
| OnTurret {_ilTuID :: Int}
| OnFloor {_ilFlID :: Int}
| InVoid
deriving (Eq, Show, Ord, Read) --Generic, Flat)
src/Dodge/Default/Item.hs
-2
View File
@@ -25,8 +25,6 @@ defaultHeldItem = Item
, _itType = ItemType (HELD PISTOL) mempty
, _itEffect = defaultItEffect
, _itID = 0
, _itIsRoot = False
, _itIsSelected = False
, _itInvSize = 1
, _itLocation = InVoid
, _itDimension = defaultItemDimension
src/Dodge/Euse.hs
+1 -1
View File
@@ -102,7 +102,7 @@ setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
where
i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ipInvID (_itLocation itm)
invid = _ilInvID (_itLocation itm)
handtrans = case cr ^? crInvEquipped . ix invid of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
src/Dodge/HeldUse.hs
+3 -3
View File
@@ -138,7 +138,7 @@ loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,(mz, 0,Nothing)) $ do
availableammo <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
let usedammo = min amamount availableammo
return (t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
, (mz, usedammo, mag ^? ldtValue . itLocation . ipInvID)
, (mz, usedammo, mag ^? ldtValue . itLocation . ilInvID)
)
makeMuzzleFlare :: Muzzle -> Item -> Creature -> World -> World
@@ -204,7 +204,7 @@ itemDetectorEffect itm cr w = fromMaybe w $ do
walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
walkNozzle mzid mz itm cr w = fromMaybe w $ do
invid <- itm ^? itLocation . ipInvID
invid <- itm ^? itLocation . ilInvID
return $ w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv
. ix invid . itUse . heldAim . aimMuzzles . ix mzid . mzEffect . nzCurrentWalkAngle .~ wa
@@ -488,7 +488,7 @@ useForceFieldGun itm cr w = fromMaybe w $ do
return $
w
& cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID (_itLocation itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
src/Dodge/Inventory/Add.hs
+26 -8
View File
@@ -2,8 +2,10 @@ module Dodge.Inventory.Add (
tryPutItemInInv,
createPutItem,
createAndSelectItem,
pickUpItem,
) where
import Dodge.SoundLogic
import Dodge.Inventory.FindRoot
--import Dodge.Item.Grammar
import Control.Lens
@@ -16,16 +18,21 @@ import Dodge.FloorItem
import Dodge.Inventory.CheckSlots
import qualified IntMapHelp as IM
putItemInInvID :: Int -> Int -> World -> (Maybe Int, World)
putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
flit <- w ^? cWorld . lWorld . floorItems . ix flid
(i, w') <- tryPutItemInInv cid flit w
return (Just i, w')
--putItemInInvID :: Int -> Int -> World -> (Maybe Int, World)
--putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
-- flit <- w ^? cWorld . lWorld . floorItems . ix flid
-- (i, w') <- tryPutItemInInv cid flit w
-- return (Just i, w')
putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
putItemInInvSlot = IM.insert
--putItemInInvSlot = IM.insertWith (const $ itUse . useAmount +~ 1)
tryPutItemIDInInv :: Int -> Int -> World -> Maybe (Int, World)
tryPutItemIDInInv cid flitid w = do
flit <- w ^? cWorld . lWorld . floorItems . ix flitid
tryPutItemInInv cid flit w
-- | Pick up a specific item.
tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int, World)
tryPutItemInInv cid flit w = case maybeInvSlot of
@@ -41,7 +48,8 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it) .~ InInv cid invid
updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it)
.~ InInv cid invid False False
createAndSelectItem :: Item -> World -> World
createAndSelectItem itm w = case createPutItem itm w of
@@ -53,6 +61,16 @@ createAndSelectItem itm w = case createPutItem itm w of
(Nothing, w') -> w'
createPutItem :: Item -> World -> (Maybe Int, World)
createPutItem it w =
uncurry (putItemInInvID 0) $
createPutItem it w = fromMaybe (Nothing,w) $ do
(i,w') <- uncurry (tryPutItemIDInInv 0) $
copyItemToFloorID (_crPos $ you w) (applyModules it) w
return (Just i, w')
pickUpItemID :: Int -> Int -> World -> World
pickUpItemID cid flid w = pickUpItem cid (w ^?! cWorld . lWorld . floorItems . ix flid) w
-- | Pick up a specific item.
pickUpItem :: Int -> FloorItem -> World -> World
pickUpItem cid flit w =
maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
tryPutItemInInv cid flit w
src/Dodge/ItEffect.hs
+4 -4
View File
@@ -23,7 +23,7 @@ doFloorEffect NoFloorEffect = const id
onOffEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
onOffEff f g it
| _itIsRoot it = doInvEffect f it
| it ^? itLocation . ilIsRoot == Just True = doInvEffect f it
| otherwise = doInvEffect g it
--timeScrollEffect :: Item -> Creature -> World -> World
@@ -37,14 +37,14 @@ setItemCharge :: Int -> Item -> Creature -> World -> World
setItemCharge i itm cr w =
w & ptrWpCharge %~ const i
where
invid = _ipInvID $ _itLocation itm
invid = _ilInvID $ _itLocation itm
ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
chargeIfInInventory :: Item -> Creature -> World -> World
chargeIfInInventory itm cr w =
w & ptrWpCharge %~ (min maxcharge . (+ 1))
where
invid = _ipInvID $ _itLocation itm
invid = _ilInvID $ _itLocation itm
ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
@@ -54,7 +54,7 @@ chargeIfEquipped itm cr
ptrWpCharge %~ (min maxcharge . (+ 1))
| otherwise = ptrWpCharge .~ 0
where
invid = _ipInvID $ _itLocation itm
invid = _ilInvID $ _itLocation itm
ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
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
src/Dodge/Luse.hs
+1 -1
View File
@@ -63,7 +63,7 @@ useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of
Just Shrunk -> tryResize 1 $ f FullSize Uncursed . setMinInvSize defaultInvSize cr
Nothing -> error "useShrinkGun applied to item with incorrect ItParam"
where
invid = _ipInvID $ _itLocation it
invid = _ilInvID $ _itLocation it
tryResize x g = maybe w g $ sizeSelf x cr w
f isInUse cstatus =
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid
src/Dodge/Projectile/Create.hs
+1 -1
View File
@@ -17,7 +17,7 @@ createProjectile mmagid muz itm cr = fromMaybe failsound $ do
ammoitem <- cr ^? crInv . ix magid
matype <- ammoitem ^? itUse . amagType
guard $ matype == ProjectileAmmo
j <- ammoitem ^? itLocation . ipInvID
j <- ammoitem ^? itLocation . ilInvID
pt <- ammoitem ^? itUse . amagParams . ampPjCreation
return $ case pt of
CreateShell -> fireShell ammoitem muz itm cr . extrafuncs j
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -95,7 +95,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj)
newdir
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
&& w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . imSelectedItem
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
== w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
= (w ^. wCam . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
src/Dodge/TestString.hs
+1 -1
View File
@@ -21,7 +21,7 @@ import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = map show $
(IM.toList . IM.filter (\itloc -> itloc ^? ipCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <> IM.toList ( fmap _itLocation (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crInv))
(IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <> IM.toList ( fmap _itLocation (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crInv))
--testStringInit u = fromMaybe mempty $ do
-- inv <- fmap invLDT $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv
-- invitm <- inv ^? ix 1