Start collapsing manipulated item code with selection code

This commit is contained in:
2026-05-14 14:24:57 +01:00
parent 59d128f87a
commit 06b984c2e5
21 changed files with 86 additions and 64 deletions
+3 -2
View File
@@ -19,9 +19,10 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
yourSelectedItem :: World -> Maybe Item
yourSelectedItem w = do
i <- w ^? hud . manObject . imSelectedItem
Sel 0 i <- w ^? hud . diSelection . _Just
--revise2 i <- you w ^? crManipulation . manObject . imSelectedItem
--revise1 i <- you w ^? crManipulation . manObject . imSelectedItem
j <- _crInv (you w) ^? ix i
j <- _crInv (you w) ^? ix (NInt i)
w ^? cWorld . lWorld . items . ix j
yourRootItem :: World -> Maybe Item
+5 -1
View File
@@ -208,7 +208,8 @@ dropItem cr invid w =
youDropItem :: World -> World
youDropItem w = fromMaybe w $ do
curpos <-
w ^? hud . manObject . imSelectedItem . unNInt
mi
--revise2 w ^? hud . manObject . imSelectedItem . unNInt
--revise1 cr ^? crManipulation . manObject . imSelectedItem . unNInt
<|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
guard $ not $ w ^. cWorld . lWorld . lInvLock
@@ -217,6 +218,9 @@ youDropItem w = fromMaybe w $ do
AtEase -> dropItem cr curpos w
where
cr = you w
mi = do
Sel 0 i <- w^?hud.diSelection._Just
return i
-- placeholder, remember to deal with two handed weapon twist
-- should throw all attached items?
-1
View File
@@ -22,7 +22,6 @@ import qualified Data.IntMap.Strict as IM
import Linear
import Control.Lens
import Dodge.Creature.Test
import Dodge.Data.Creature
import Dodge.Data.Equipment.Misc
import Geometry
import qualified Quaternion as Q
-1
View File
@@ -10,7 +10,6 @@ import Dodge.Data.World
import Dodge.Data.Equipment.Misc
import qualified Data.Map.Strict as M
import NewInt
import Dodge.Data.LWorld
import Data.Maybe
--import qualified IntMapHelp as IM
import qualified Data.IntMap.Strict as IM
+7 -5
View File
@@ -38,9 +38,10 @@ handleHotkeys :: World -> World
handleHotkeys w
| ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
, (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
, Just invid <- w ^? hud . manObject . imSelectedItem
, Just (Sel 0 invid) <- w ^. hud .diSelection
--revise2 , Just invid <- w ^? hud . manObject . imSelectedItem
--revise1 , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
, Just itid <- lw ^? creatures . ix 0 . crInv . ix (NInt invid) =
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
, (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
@@ -212,7 +213,8 @@ tryClickUse pkeys w = fromMaybe w $ do
ltime <- pkeys ^? ix SDL.ButtonLeft
rtime <- pkeys ^? ix SDL.ButtonRight
guard $ ltime <= rtime
case w ^?hud. manObject . imSelectedItem . unNInt of
case w ^.hud.diSelection of
--revise2 case w ^?hud. manObject . imSelectedItem . unNInt of
--revise1 case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem . unNInt of
Just invid -> useItem invid ltime w
Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
Just (Sel 0 invid) -> useItem invid ltime w
_ -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
+1
View File
@@ -38,6 +38,7 @@ data HUD = HUD
}
data Selection = Sel {_slSec :: Int, _slInt :: Int}
deriving (Eq)
makeLenses ''HUD
makeLenses ''Selection
@@ -20,8 +20,7 @@ import Data.Aeson.TH
data ManipulatedObject
= SortInventory
| SelectedItem
{ _imSelectedItem :: NewInt InvInt
, _imRootSelectedItem :: NewInt InvInt
{ _imRootSelectedItem :: NewInt InvInt
, _imAimStance :: AimStance
, _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
}
+2 -1
View File
@@ -1421,7 +1421,8 @@ useInventoryPath pt i ip loc cr w = case ip of
guard $ i `IM.member` (cr ^. crInv . unNIntMap)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
RELCURS -> fromMaybe w $ do
j <- w ^? hud . manObject . imSelectedItem . unNInt
Sel 0 j <- w ^? hud .diSelection._Just
--revise2 j <- w ^? hud . manObject . imSelectedItem . unNInt
--revise1 j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
+4 -2
View File
@@ -103,9 +103,11 @@ rmInvItem cid invid w =
-- | i < _unNInt invid = IS.insert i x
-- | otherwise = x
updateselection
| cid == 0 && w ^? hud . manObject . imSelectedItem == Just invid =
| cid == 0 && (w ^? hud .diSelection._Just) == Just (Sel 0 (invid^.unNInt)) =
--revise2 | cid == 0 && w ^? hud . manObject . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1
| otherwise = hud . manObject . imSelectedItem %~ g
| otherwise = id -- hud . manObject . imSelectedItem %~ g
--revise2 | otherwise = hud . manObject . imSelectedItem %~ g
cr = w ^?! cWorld . lWorld . creatures . ix cid
itid = _crInv cr ^?! ix invid
itm = w ^?! cWorld . lWorld . items . ix itid
+5 -4
View File
@@ -41,7 +41,8 @@ getRootItemInvID m i cr = fromMaybe i $ do
updateRootItemID :: IM.IntMap Item -> Creature -> World -> World
updateRootItemID m cr w = fromMaybe w $ do
i <- w^?hud . manObject . imSelectedItem . unNInt
Sel 0 i <- w^?hud.diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem . unNInt
let j = getRootItemInvID m i cr
return $ w & hud . manObject . imRootSelectedItem .~ NInt j
@@ -76,7 +77,8 @@ crUpdateInvidLocations mo crid lw invid itm =
{ _ilCrID = crid
, _ilInvID = NInt invid
, _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
, _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
, _ilIsSelected = Just (NInt invid) == lw ^? hud.diSelection._Just.slInt.to NInt -- this may match with the wrong sections, not sure if this is possible
--revise1 , _ilIsSelected = Just (NInt i2vid) == mo ^? imSelectedItem
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
, _ilEquipSite = lw ^? cWorld .lWorld. items . ix itid . itLocation . ilEquipSite . _Just
--revise1 , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
@@ -105,8 +107,7 @@ setInvPosFromSS w = w &hud . manObject .~ thesel
-- there is redundancy above
return
SelectedItem
{ _imSelectedItem = NInt j
, _imRootSelectedItem = NInt rootid
{ _imRootSelectedItem = NInt rootid
, _imAimStance = itemAimStance ((\(x,y,_) -> (x,y)) <$> dt)
, _imAttachedItems = aset
}
+2 -2
View File
@@ -2,7 +2,6 @@ module Dodge.Inventory.Path (getInventoryPath) where
import Dodge.Data.World
import NewInt
import Dodge.Data.Creature
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Control.Monad
@@ -11,7 +10,8 @@ getInventoryPath :: World -> Int -> InventoryPathing -> Int -> Creature -> Maybe
getInventoryPath w x ip itid cr = case ip of
ABSOLUTE -> checkinvid x
RELCURS -> do
selid <- w ^? hud . manObject . imSelectedItem . unNInt
Sel 0 selid <- w ^? hud .diSelection._Just
--revise2 selid <- w ^? hud . manObject . imSelectedItem . unNInt
--revise1 selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
checkinvid (x + selid)
RELITEM -> checkinvid (itid + x)
+3 -2
View File
@@ -24,8 +24,9 @@ updateRBList w = case w ^. rbState of
_ | norightclick -> w & rbState .~ NoRightButtonState
EquipOptions{} -> w
_ -> fromMaybe (w & rbState .~ NoRightButtonState) $ do
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
Sel 0 i <- w^?hud .diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i)
itm <- w ^? cWorld . lWorld . items . ix itid
etype <- equipType itm
return $
+3 -3
View File
@@ -37,7 +37,7 @@ swapInvItems f i w = fromMaybe w $ do
& swapAnyExtraSelection 0 i k
& checkConnection InventorySound disconnectItemS i k
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k
& updatecreature' k
-- & updatecreature' k
& updateselection
& worldEventFlags . at InventoryChange ?~ ()
& crUpdateItemLocations 0
@@ -51,8 +51,8 @@ swapInvItems f i w = fromMaybe w $ do
(crInv . unNIntMap %~ IM.safeSwapKeys i k)
. swapSite i k
. swapSite k i
updatecreature' k =
(hud . manObject . imSelectedItem .~ NInt k)
-- updatecreature' k = (hud . manObject . imSelectedItem .~ NInt k)
--revise2 updatecreature' k = (hud . manObject . imSelectedItem .~ NInt k)
cr = you w
swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just epos -> crEquipment . ix epos .~ NInt b
-1
View File
@@ -7,7 +7,6 @@ import Dodge.Item.Draw.SPicTree
import Control.Lens
import Dodge.Creature.HandPos
import Dodge.Data.ComposedItem
import Dodge.Data.Creature
import Dodge.Data.DoubleTree
import Dodge.Data.Equipment.Misc
import Dodge.Item.Draw.SPic
-3
View File
@@ -10,11 +10,8 @@ module Dodge.Item.HeldOffset (
import Dodge.Data.World
import Dodge.Creature.HandPos
import Linear
import Dodge.Data.AimStance
import Dodge.Data.ComposedItem
import Dodge.Data.Creature
import Dodge.Data.DoubleTree
import Dodge.Data.Machine
import Dodge.DoubleTree
import Dodge.Item.AimStance
import Geometry
+3 -2
View File
@@ -25,9 +25,10 @@ import Dodge.Data.World
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourSelectedItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? hud. manObject . imSelectedItem
Sel 0 itinvid <- w ^? hud.diSelection._Just
--revise2 itinvid <- w ^? hud. manObject . imSelectedItem
--revise1 itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt itinvid)
Just $ (cWorld . lWorld . items . ix itid) f w
-- note the ilIsRoot/Selected/Attached booleans are irrelevant
+5 -9
View File
@@ -197,17 +197,13 @@ doBarrelSpin cid i pj w =
pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World
pjRemoteSetDirection ph pj w = case ph of
HomeUsingRemoteScreen screenid
| w ^? hud . manObject . imSelectedItem
--revise2 | w ^? hud . manObject . imSelectedItem
--revise1 | w ^? hud . manObject . imSelectedItem
== lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID ->
| w ^. hud .diSelection
== fmap (\i -> Sel 0 (i^.unNInt)) (lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID) ->
w
& pjlens
. pjDir
.~ mousedir
& pjlens
. pjSpin
.~ 0.5
* diffAngles mousedir pjdir
& pjlens . pjDir .~ mousedir
& pjlens . pjSpin .~ 0.5 * diffAngles mousedir pjdir
HomeUsingTargeting itid
| Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
w
+18 -5
View File
@@ -231,22 +231,35 @@ floorItemPickupInfo n itm
-- note the use of ^?!
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either Item Button -> a) -> World -> a
yourAugmentedItem f x g w = case w ^? hud . manObject of
Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
Just (SelCloseItem i) -> fromMaybe x $ do
yourAugmentedItem f x g w = case w ^. hud .diSelection of
Just (Sel 0 i) -> f $ yourInv w ^?! ix (NInt i)
Just (Sel 3 i) -> fromMaybe x $ do
j <- w ^? hud . closeItems . ix i . unNInt
flit <- w ^? cWorld . lWorld . items . ix j
return . g $ Left flit
Just (SelCloseButton i) -> fromMaybe x $ do
Just (Sel 5 i) -> fromMaybe x $ do
j <- w ^? hud . closeButtons . ix i
but <- w ^? cWorld . lWorld . buttons . ix j
return . g $ Right but
_ -> x
--revise2 yourAugmentedItem f x g w = case w ^? hud . manObject of
--revise2 Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
--revise2 Just (SelCloseItem i) -> fromMaybe x $ do
--revise2 j <- w ^? hud . closeItems . ix i . unNInt
--revise2 flit <- w ^? cWorld . lWorld . items . ix j
--revise2 return . g $ Left flit
--revise2 Just (SelCloseButton i) -> fromMaybe x $ do
--revise2 j <- w ^? hud . closeButtons . ix i
--revise2 but <- w ^? cWorld . lWorld . buttons . ix j
--revise2 return . g $ Right but
--revise2 _ -> x
drawRBOptions :: Config -> World -> Picture
drawRBOptions cfig w = fold $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- w ^? hud . manObject . imSelectedItem
Sel 0 invid' <- w^.hud.diSelection
let invid = NInt invid'
--revise2 invid <- w ^? hud . manObject . imSelectedItem
--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem
itid <- you w ^? crInv . ix invid
eslist <-
+2 -4
View File
@@ -128,10 +128,8 @@ topTestPart u =
showManObj :: ManipulatedObject -> String
showManObj SortInventory = "SortInventory"
showManObj (SelectedItem x y as z) =
"SelItem: "
++ show x
++ " Root: "
showManObj (SelectedItem y as z) =
" Root: "
++ show y
++ " Attached: "
++ show z
+16 -10
View File
@@ -6,6 +6,7 @@ module Dodge.Update.Camera (
updateCamera,
) where
import NewInt
import Dodge.Update.Camera.Rotate
import Linear.V3
import Dodge.Creature.Radius
@@ -101,34 +102,39 @@ moveZoomCamera cfig theinput cr w campos =
& camItemZoom .~ newItemZoom
where
mremotepos = do
i <- w^?hud . manObject . imSelectedItem
Sel 0 i <- w^?hud .diSelection._Just
--revise1 i <- cr ^? crManipulation . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i)
j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0
guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach
w ^? cWorld . lWorld . projectiles . ix j . pjPos . _xy
docamrot = rotateV (campos ^. camRot)
offset = fromMaybe noscopeoffset $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
Sel 0 i <- w^?hud.diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i)
fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos)
noscopeoffset =
docamrot $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
Sel 0 i <- w^?hud .diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i)
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
Sel 0 i <- w^?hud .diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i)
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr
i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix i
Sel 0 i <- w^?hud .diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i)
getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
changeZoom curZoom idealZoom
+6 -4
View File
@@ -42,15 +42,17 @@ updateBaseWheelEvent yi w
where
bdown b = w & has (input . mouseButtons . ix b)
rbscrollmax = fromMaybe 1 $ do
invid <- w ^? hud . manObject . imSelectedItem
Sel 0 invid <- w ^. hud.diSelection
--revise2 invid <- w ^? hud . manObject . imSelectedItem
--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem
etype <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType
etype <- you w ^? crInv . ix (NInt invid) >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType
return . length $ eqTypeToSites etype
selectedItemScroll :: Int -> World -> Maybe World
selectedItemScroll yi w = do
i <- w ^? hud . manObject . imSelectedItem
itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
Sel 0 i <- w ^.hud.diSelection
--revise2 i <- w ^? hud . manObject . imSelectedItem
itm <- you w ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
return $ itemScroll yi itm w
itemScroll :: Int -> Item -> World -> World