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

Correctly update root status of item in _ilIsRoot

Browse Source
This commit is contained in:
justin
2024-11-05 18:25:30 +00:00
parent 38ab6a35da
commit 9b3518e4eb
16 changed files with 40 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/charMaps/cMap16x32.Custom.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

ghcidOutput
+1 -1
View File
@@ -1 +1 @@
All good (594 modules, at 20:36:32)
All good (594 modules, at 18:20:01)
src/Dodge/Base/You.hs
+1 -1
View File
@@ -25,7 +25,7 @@ yourSelectedItem w = do
yourRootItem :: World -> Maybe Item
yourRootItem w = do
i <- you w ^? crManipulation . manObject . imRootItem
i <- you w ^? crManipulation . manObject . imRootSelectedItem
_crInv (you w) IM.!? i
--yourScrollAttachment :: World -> Maybe (Int,ScrollAttachParams)
src/Dodge/Creature/Impulse/UseItem.hs
+1 -1
View File
@@ -25,7 +25,7 @@ import qualified IntMapHelp as IM
useRootItem :: Int -> World -> World
useRootItem crid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
itRef <- cr ^? crManipulation . manObject . imRootItem
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
it <- invRootTrees (_crInv cr) ^? ix itRef
return $
itemUseEffect' cr it w
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -166,7 +166,7 @@ invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
updateHeldRootItem :: Creature -> World -> World
updateHeldRootItem cr = fromMaybe id $ do
invid <- cr ^? crManipulation . manObject . imRootItem
invid <- cr ^? crManipulation . manObject . imRootSelectedItem
itmtree <- invRootTrees (_crInv cr) ^? ix invid
return $ updateAttachedItems itmtree cr
src/Dodge/Creature/Statistics.hs
+1 -1
View File
@@ -38,6 +38,6 @@ strFromHeldItem :: Creature -> Int
strFromHeldItem cr
--x--- | _posture (_crStance cr) == Aiming || crIsReloading cr = negate $ fromMaybe 0 $ do
| _posture (_crStance cr) == Aiming = negate $ fromMaybe 0 $ do
i <- cr ^? crManipulation . manObject . imRootItem
i <- cr ^? crManipulation . manObject . imRootSelectedItem
cr ^? crInv . ix i . itUse . heldAim . aimWeight
| otherwise = 0
src/Dodge/Creature/Test.hs
+2 -4
View File
@@ -86,12 +86,10 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
--crCanShoot cr = crIsAiming cr && crWeaponReady cr
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr =
crIsAiming cr
&& mitstance == Just as
crInAimStance as cr = crIsAiming cr && mitstance == Just as
where
mitstance = do
i <- cr ^? crManipulation . manObject . imRootItem
i <- cr ^? crManipulation . manObject . imRootSelectedItem
cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
src/Dodge/Creature/YourControl.hs
+2 -2
View File
@@ -114,7 +114,7 @@ wasdAim inp cam cr
wasdTwist :: Creature -> Creature
wasdTwist cr
| _posture (_crStance cr) == Aiming = fromMaybe cr $ do
itRef <- cr ^? crManipulation . manObject . imRootItem
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
case (astance, cr ^. crTwist) of
(TwoHandUnder, 0) ->
@@ -144,7 +144,7 @@ aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . imRootItem
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
{- | Set posture according to mouse presses.
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+1 -1
View File
@@ -22,7 +22,7 @@ data ManipulatedObject
= SortInventory
| SelectedItem
{ _imSelectedItem :: Int
, _imRootItem :: Int
, _imRootSelectedItem :: Int
, _imAttachedItems :: IS.IntSet
}
| SelNothing
src/Dodge/HeldUse.hs
+1 -1
View File
@@ -477,7 +477,7 @@ shootTeslaArc itm cr mz w =
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
where
-- use items item location instead
itRef = cr ^?! crManipulation . manObject . imRootItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change
(w', ip) = makeTeslaArc (_itParams itm) pos dir w
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
dir = _crDir cr + _mzRot mz
src/Dodge/Inventory.hs
+10 -1
View File
@@ -17,6 +17,7 @@ module Dodge.Inventory (
isFilteringInv,
) where
import Dodge.SoundLogic
import Control.Applicative
import Data.Maybe
import Dodge.Base
@@ -188,7 +189,8 @@ swapInvItems f i w = fromMaybe w $ do
Just (0, j) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
_ -> id
return $
w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
w & checkdisconnect k
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k
& updateselection
& worldEventFlags . at InventoryChange ?~ ()
& cWorld . lWorld %~ crUpdateItemLocations 0
@@ -196,6 +198,13 @@ swapInvItems f i w = fromMaybe w $ do
& cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
-- a rethink is maybe in order
where
cpos = fromMaybe 0 $ w ^? cWorld . lWorld . creatures . ix 0 . crPos
checkdisconnect k
| a || b = soundStart InventorySound cpos disconnectItemS Nothing
| otherwise = id
where
a = maybe False not $ w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix i . itLocation . ilIsRoot
b = maybe False not $ w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix k . itLocation . ilIsRoot
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
. (crManipulation . manObject . imSelectedItem .~ k)
src/Dodge/Inventory/Location.hs
+15 -4
View File
@@ -13,6 +13,7 @@ import Dodge.Data.Item.Use.Consumption.LoadAction
import Dodge.Data.World
import Dodge.Item.Grammar
import qualified IntMapHelp as IM
import Data.IntMap.Merge.Strict
import NewInt
-- assumes all item locations inside the items are correct
@@ -35,14 +36,24 @@ updateRootItemID :: Creature -> Creature
updateRootItemID cr = fromMaybe cr $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
j <- tryGetRootItemInvID i cr
return $ cr & crManipulation . manObject . imRootItem .~ j
return $ cr & crManipulation . manObject . imRootSelectedItem .~ 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
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
crSetRoots :: Int -> LWorld -> LWorld
crSetRoots cid w = fromMaybe w $ do
inv <- w ^? creatures . ix cid . crInv
-- invRootTrees inv
return $ w & creatures . ix cid . crInv %~ merge dropMissing preserveMissing
(zipWithMatched f)
(invRootTrees inv)
where
f _ _ = itLocation . ilIsRoot .~ True
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
crUpdateInvidLocations mo crid lw invid itm =
@@ -55,7 +66,7 @@ crUpdateInvidLocations mo crid lw invid itm =
InInv
{ _ilCrID = crid
, _ilInvID = invid
, _ilIsRoot = Just invid == mo ^? imRootItem
, _ilIsRoot = Just invid == mo ^? imRootSelectedItem
, _ilIsSelected = Just invid == mo ^? imSelectedItem
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
}
@@ -77,7 +88,7 @@ setInvPosFromSS w =
return
SelectedItem
{ _imSelectedItem = j
, _imRootItem = rootid
, _imRootSelectedItem = rootid
, _imAttachedItems = aset
}
1 -> Just SelNothing
src/Dodge/Item/Draw.hs
+1
View File
@@ -17,6 +17,7 @@ import ShapePicture
itemEquipPict :: Creature -> LabelDoubleTree ItemLink ComposedItem -> SPic
itemEquipPict cr itmtree = case itm ^. itUse of
UseHeld{} | itm ^? itLocation . ilIsRoot == Just True
&& itm ^? itLocation . ilIsSelected == Just True
-> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree)
ituse -> fromMaybe mempty $ do
attachpos <- ituse ^? uequipEffect . eeAttachPos
src/Dodge/Item/Grammar.hs
+1 -1
View File
@@ -206,7 +206,7 @@ invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x,
fromMaybe (error "in invTrees try to get non-inventory item tree") $
i ^? itLocation . ilInvID
-- returns an intmap with trees for root items, indexed by inventory position
-- returns an intmap with trees for (only!) root items, indexed by inventory position
invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
invRootTrees = IM.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
where
src/Dodge/Item/Location.hs
+1 -1
View File
@@ -41,7 +41,7 @@ pointerYourSelectedItem f w = fromMaybe (pure w) $ do
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 . imRootItem
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
Just $ pointerToItemLocation (InInv 0 itinvid True True True) f w
pointerToItem ::
src/Dodge/TestString.hs
+1 -5
View File
@@ -21,12 +21,8 @@ import Dodge.Data.Universe
import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSelection . _Just
, show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
, show $ u ^? uvWorld . hud . hudElement . diMouseOver . _Just
, show $ fmap fst $ IM.lookupMin =<< (u ^? uvWorld . hud . hudElement . diSections . ix 0 . ssItems)
testStringInit u = fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . each . itLocation . ilIsRoot
-- , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
]
-- <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]
-- <> map show (IM.elems (L.postscan (L.premap _siHeight L.sum)
-- $ fromMaybe mempty $ u ^? uvWorld . hud . hudElement . diSections . sssSections . ix 0 . ssItems)