Cleanup inventory management, tweak dragging start

This commit is contained in:
2026-05-15 10:35:17 +01:00
parent 17f8707f62
commit e56a953c9b
23 changed files with 70 additions and 180 deletions
+2 -5
View File
@@ -20,16 +20,13 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
yourSelectedItem :: World -> Maybe Item yourSelectedItem :: World -> Maybe Item
yourSelectedItem w = do yourSelectedItem w = do
Sel 0 i <- w ^? hud . diSelection . _Just Sel 0 i <- w ^? hud . diSelection . _Just
--revise2 i <- you w ^? crManipulation . manObject . imSelectedItem j <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt i)
--revise1 i <- you w ^? crManipulation . manObject . imSelectedItem
j <- _crInv (you w) ^? ix (NInt i)
w ^? cWorld . lWorld . items . ix j w ^? cWorld . lWorld . items . ix j
yourRootItem :: World -> Maybe Item yourRootItem :: World -> Maybe Item
yourRootItem w = do yourRootItem w = do
i <- w ^? hud . manObject . hiRootSelectedItem i <- w ^? hud . manObject . hiRootSelectedItem
--revise1 i <- you w ^? crManipulation . manObject . imRootSelectedItem j <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix i
j <- _crInv (you w) ^? ix i
w ^? cWorld . lWorld . items . ix j w ^? cWorld . lWorld . items . ix j
yourRootItemDT :: World -> Maybe (DTree OItem) yourRootItemDT :: World -> Maybe (DTree OItem)
+1 -21
View File
@@ -159,22 +159,6 @@ performTurnToA cr p
dirv = p -.- cpos dirv = p -.- cpos
jit = _mvTurnJit $ crMvType cr jit = _mvTurnJit $ crMvType cr
--setMinInvSize :: Int -> Creature -> World -> World
--setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
--organiseInvKeys :: Int -> World -> World
--organiseInvKeys cid w =
-- w & cWorld . lWorld . creatures . ix cid
-- %~ ( (crInvSel . iselPos .~ newSelKey)
-- . (crInv .~ newInv)
-- . (crInvSel . iselAction .~ NoInvSelAction)
-- )
-- where
-- cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
-- pairs = IM.toList (_crInv cr)
-- newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
-- newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
-- why not a cid (Int)? -- why not a cid (Int)?
dropItem :: Creature -> Int -> World -> World dropItem :: Creature -> Int -> World -> World
dropItem cr invid w = dropItem cr invid w =
@@ -207,11 +191,7 @@ dropItem cr invid w =
-- | Get your creature to drop the item under the cursor. -- | Get your creature to drop the item under the cursor.
youDropItem :: World -> World youDropItem :: World -> World
youDropItem w = fromMaybe w $ do youDropItem w = fromMaybe w $ do
curpos <- curpos <- mi <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
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 guard $ not $ w ^. cWorld . lWorld . lInvLock
return $ case cr ^. crStance . posture of return $ case cr ^. crStance . posture of
Aiming{} -> throwItem w Aiming{} -> throwItem w
-2
View File
@@ -67,7 +67,6 @@ rightHandPQ w cr
| twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qz 1) | twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qz 1)
| twoFlat w cr = (V3 8 (-8) 12, Q.qid) | twoFlat w cr = (V3 8 (-8) 12, Q.qid)
| Just TwoHandTwist <- w ^? hud . manObject . hiAimStance | Just TwoHandTwist <- w ^? hud . manObject . hiAimStance
--revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
= (V3 6 (-6) 10, Q.qid) = (V3 6 (-6) 10, Q.qid)
| Just TwoHandFlat <- w ^? hud . manObject . hiAimStance | Just TwoHandFlat <- w ^? hud . manObject . hiAimStance
= (V3 (8 - twoHandOffY cr) (-8) 12, Q.qid) = (V3 (8 - twoHandOffY cr) (-8) 12, Q.qid)
@@ -121,7 +120,6 @@ leftHandPQ w cr
| twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4) | twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
| twoFlat w cr = (V3 8 8 12, Q.qid) | twoFlat w cr = (V3 8 8 12, Q.qid)
| Just TwoHandTwist <- w ^? hud . manObject . hiAimStance | Just TwoHandTwist <- w ^? hud . manObject . hiAimStance
--revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
= (V3 (10 + twoHandOffY cr) 6 20, Q.qid) = (V3 (10 + twoHandOffY cr) 6 20, Q.qid)
| Just TwoHandFlat <- w ^? hud . manObject . hiAimStance | Just TwoHandFlat <- w ^? hud . manObject . hiAimStance
= (V3 (8 + twoHandOffY cr) 6 12, Q.qid) = (V3 (8 + twoHandOffY cr) 6 12, Q.qid)
-1
View File
@@ -74,7 +74,6 @@ strFromHeldItem :: World -> Creature -> Int
strFromHeldItem w cr = fromMaybe 0 $ do strFromHeldItem w cr = fromMaybe 0 $ do
Aiming {} <- cr ^? crStance . posture Aiming {} <- cr ^? crStance . posture
is <- w^?hud . manObject . hiAttachedItems is <- w^?hud . manObject . hiAttachedItems
--revise1 is <- cr ^? crManipulation . manObject . imAttachedItems
let js = IM.elems $ IM.restrictKeys (cr ^. crInv . unNIntMap) is let js = IM.elems $ IM.restrictKeys (cr ^. crInv . unNIntMap) is
return . negate . sum . fmap itemWeight $ IM.restrictKeys (w ^.cWorld.lWorld. items) $ IS.fromList js return . negate . sum . fmap itemWeight $ IM.restrictKeys (w ^.cWorld.lWorld. items) $ IS.fromList js
-1
View File
@@ -87,7 +87,6 @@ crAwayFromPost cr = case _apGoal $ _crActionPlan cr of
crInAimStance :: AimStance -> World -> Creature -> Bool crInAimStance :: AimStance -> World -> Creature -> Bool
crInAimStance as w cr = cr ^? crStance . posture == Just Aiming crInAimStance as w cr = cr ^? crStance . posture == Just Aiming
&& w ^? hud . manObject . hiAimStance == Just as && w ^? hud . manObject . hiAimStance == Just as
--revise1 && cr ^? crManipulation . manObject . imAimStance == Just as
oneH :: World -> Creature -> Bool oneH :: World -> Creature -> Bool
oneH = crInAimStance OneHand oneH = crInAimStance OneHand
+4 -12
View File
@@ -39,8 +39,6 @@ handleHotkeys w
| ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift | ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
, (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys , (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
, Just (Sel 0 invid) <- w ^. hud .diSelection , 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 (NInt invid) = , Just itid <- lw ^? creatures . ix 0 . crInv . ix (NInt invid) =
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
@@ -118,18 +116,15 @@ wasdWithAiming w cr
wasdAim :: Input -> World -> Creature -> Creature wasdAim :: Input -> World -> Creature -> Creature
wasdAim inp w cr wasdAim inp w cr
| SDL.ButtonRight `M.member` _mouseButtons inp | SDL.ButtonRight `M.member` _mouseButtons inp
, AtEase <- cr ^. crStance . posture = , AtEase <- cr ^. crStance . posture = setposture Aiming (-twistAmount)
setposture Aiming (-twoHandTwistAmount)
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn w mousedir cr | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn w mousedir cr
| Aiming{} <- cr ^. crStance . posture = setposture AtEase twoHandTwistAmount | Aiming{} <- cr ^. crStance . posture = setposture AtEase twistAmount
-- | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
| otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr | otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr
where where
setposture x r = setposture x r =
cr cr
& crStance . posture .~ x & crStance . posture .~ x
& doAimTwist (w ^? hud . manObject . hiAimStance) r & doAimTwist (w ^? hud . manObject . hiAimStance) r
--revise1 & doAimTwist (cr ^? crManipulation . manObject . imAimStance) r
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy) mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)
doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature
@@ -137,8 +132,8 @@ doAimTwist as x
| as == Just TwoHandTwist = crDir +~ x | as == Just TwoHandTwist = crDir +~ x
| otherwise = id | otherwise = id
twoHandTwistAmount :: Float twistAmount :: Float
twoHandTwistAmount = 1.6 * pi twistAmount = 1.6 * pi
wasdMovement :: World -> Input -> Camera -> Float -> Creature -> Creature wasdMovement :: World -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement w inp cam speed = theMovement -- . setMvAim wasdMovement w inp cam speed = theMovement -- . setMvAim
@@ -157,7 +152,6 @@ aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
where where
x = fromMaybe 1 $ do x = fromMaybe 1 $ do
itRef <- lw ^? hud . manObject . hiRootSelectedItem itRef <- lw ^? hud . manObject . hiRootSelectedItem
--revise1 itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^?cWorld.lWorld. items . ix k . itType fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^?cWorld.lWorld. items . ix k . itType
itemBulkiness :: ItemType -> Float itemBulkiness :: ItemType -> Float
@@ -214,7 +208,5 @@ tryClickUse pkeys w = fromMaybe w $ do
rtime <- pkeys ^? ix SDL.ButtonRight rtime <- pkeys ^? ix SDL.ButtonRight
guard $ ltime <= rtime guard $ ltime <= rtime
case w ^.hud.diSelection 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 (Sel 0 invid) -> useItem invid ltime w Just (Sel 0 invid) -> useItem invid ltime w
_ -> interactWithCloseObj <$> getSelectedCloseObj w ?? w _ -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
+1 -1
View File
@@ -146,7 +146,7 @@ data LWorld = LWorld
, _hotkeys :: M.Map Hotkey (NewInt ItmInt) , _hotkeys :: M.Map Hotkey (NewInt ItmInt)
, _imHotkeys :: NewIntMap ItmInt Hotkey , _imHotkeys :: NewIntMap ItmInt Hotkey
, _lAimPos :: Point2 , _lAimPos :: Point2
, _lInvLock :: Bool , _lInvLock :: Bool -- used eg burstRifle fire
, _respawnPos :: (Point2, Float) , _respawnPos :: (Point2, Float)
} }
-1
View File
@@ -321,7 +321,6 @@ showMuzzlePositions :: Universe -> Picture
showMuzzlePositions u = fold $ do showMuzzlePositions u = fold $ do
cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
invid <- u ^?uvWorld.hud . manObject . hiRootSelectedItem . unNInt invid <- u ^?uvWorld.hud . manObject . hiRootSelectedItem . unNInt
--revise1 invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2 ^? ix invid . _2
return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
+8 -9
View File
@@ -1417,19 +1417,18 @@ useInventoryPath ::
World -> World ->
World World
useInventoryPath pt i ip loc cr w = case ip of useInventoryPath pt i ip loc cr w = case ip of
ABSOLUTE -> fromMaybe w $ do ABSOLUTE -> fromMaybe w $ useat i
guard $ i `IM.member` (cr ^. crInv . unNIntMap)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
RELCURS -> fromMaybe w $ do RELCURS -> fromMaybe w $ do
Sel 0 j <- w ^? hud .diSelection._Just Sel 0 j <- w ^? hud .diSelection._Just
--revise2 j <- w ^? hud . manObject . imSelectedItem . unNInt useat $ i + j
--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)
RELITEM -> fromMaybe w $ do RELITEM -> fromMaybe w $ do
j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap) useat $ i + j
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt) where
useat k = do
guard $ k `IM.member` (cr ^. crInv . unNIntMap)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem k pt)
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
-- [w'] -> w & cwTime . maybeWorld .~ Just' w' -- [w'] -> w & cwTime . maybeWorld .~ Just' w'
+9 -19
View File
@@ -81,6 +81,7 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
-- note rmInvItem does not fully destroy the item, other updates to the item -- note rmInvItem does not fully destroy the item, other updates to the item
-- location are required -- location are required
-- note if this gets called ssInvPosFromSS might be necessary elsewhere
rmInvItem :: Int -> NewInt InvInt -> World -> World rmInvItem :: Int -> NewInt InvInt -> World -> World
rmInvItem cid invid w = rmInvItem cid invid w =
w w
@@ -89,20 +90,15 @@ rmInvItem cid invid w =
& removeAnySlotEquipment & removeAnySlotEquipment
& cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
& updateselection & updateselection
-- & uprootitem
--revise1 & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
where where
-- uprootitem w' = updateRootItemID (w ^. cWorld . lWorld . items) (w'^?!cWorld.lWorld.creatures.ix 0) w'
pointcid = cWorld . lWorld . creatures . ix cid pointcid = cWorld . lWorld . creatures . ix cid
updateselection updateselection
| cid == 0 && (w ^? hud .diSelection._Just) == Just (Sel 0 (invid^.unNInt)) = | cid == 0 && (w ^? hud .diSelection._Just) == Just (Sel 0 (invid^.unNInt)) =
--revise2 | cid == 0 && w ^? hud . manObject . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1 scrollAugInvSel (-1) . scrollAugInvSel 1
| otherwise = id -- hud . manObject . imSelectedItem %~ g | otherwise = id
--revise2 | otherwise = hud . manObject . imSelectedItem %~ g
cr = w ^?! cWorld . lWorld . creatures . ix cid cr = w ^?! cWorld . lWorld . creatures . ix cid
itid = _crInv cr ^?! ix invid itid = cr ^?! crInv . ix invid
itm = w ^?! cWorld . lWorld . items . ix itid itm = w ^?! cWorld . lWorld . items . ix itid
dounequipfunction = effectOnRemove itm cr dounequipfunction = effectOnRemove itm cr
removeAnySlotEquipment = fromMaybe id $ do removeAnySlotEquipment = fromMaybe id $ do
@@ -235,13 +231,11 @@ multiSelScroll' f w = fromMaybe w $ do
& hud . diSelection . _Just . slInt .~ k & hud . diSelection . _Just . slInt .~ k
changeSwapOther :: changeSwapOther ::
--revise3 ((Int -> Identity Int) -> ManipulatedObject -> Identity ManipulatedObject) ->
Int -> Int ->
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
Int -> Int ->
World -> World ->
World World
--revise3 changeSwapOther manlens n f i w = fromMaybe w $ do
changeSwapOther n f i w = fromMaybe w $ do changeSwapOther n f i w = fromMaybe w $ do
ss <- w ^? hud . diSections . ix n . ssItems ss <- w ^? hud . diSections . ix n . ssItems
k <- f i ss k <- f i ss
@@ -252,8 +246,6 @@ changeSwapOther n f i w = fromMaybe w $ do
return $ return $
w w
& swapAnyExtraSelection 3 i k & swapAnyExtraSelection 3 i k
-- &hud. manObject . manlens %~ doswap
--revise1 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens %~ doswap
& hud . closeItems %~ swapIndices i k & hud . closeItems %~ swapIndices i k
& hud . diSelection . _Just . slInt %~ doswap & hud . diSelection . _Just . slInt %~ doswap
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
@@ -267,8 +259,6 @@ swapItemWith f (j, i) = case j of
0 -> swapInvItems f i 0 -> swapInvItems f i
3 -> changeSwapOther 3 f i 3 -> changeSwapOther 3 f i
5 -> changeSwapOther 5 f i 5 -> changeSwapOther 5 f i
--revise3 3 -> changeSwapOther ispCloseItem 3 f i
--revise3 5 -> changeSwapOther ispCloseButton 5 f i
_ -> id _ -> id
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
@@ -281,9 +271,9 @@ invSetSelection sel w =
w w
& hud . diSelection ?~ sel & hud . diSelection ?~ sel
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
& crUpdateItemLocations
& setInvPosFromSS -- is this necessary here? & setInvPosFromSS -- is this necessary here?
& crUpdateItemLocations 0 & crUpdateItemLocations
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
invSetSelectionPos :: Int -> Int -> World -> World invSetSelectionPos :: Int -> Int -> World -> World
invSetSelectionPos i j = invSetSelection (Sel i j) invSetSelectionPos i j = invSetSelection (Sel i j)
@@ -295,9 +285,9 @@ scrollAugInvSel yi w
w w
& hud %~ doscroll & hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
& crUpdateItemLocations
& setInvPosFromSS & setInvPosFromSS
& crUpdateItemLocations 0 & crUpdateItemLocations
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
where where
doscroll he = fromMaybe he $ do doscroll he = fromMaybe he $ do
sss <- he ^? diSections sss <- he ^? diSections
@@ -308,9 +298,9 @@ scrollAugNextInSection w =
w w
& hud %~ doscroll & hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
& crUpdateItemLocations
& setInvPosFromSS & setInvPosFromSS
& crUpdateItemLocations 0 & crUpdateItemLocations
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
where where
doscroll he = fromMaybe he $ do doscroll he = fromMaybe he $ do
sss <- he ^? diSections sss <- he ^? diSections
+3 -3
View File
@@ -36,8 +36,9 @@ tryPutItemInInv mcipos cid itid w = do
} }
return $ (invid,) $ return $ (invid,) $
w w
& crUpdateItemLocations cid & crUpdateItemLocations
--revise1 & cWorld . lWorld %~ crUpdateItemLocations cid & setInvPosFromSS
& crUpdateItemLocations
-- not sure about the order of these... -- not sure about the order of these...
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid & cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
& cWorld . lWorld . items . ix itid . itLocation .~ itloc & cWorld . lWorld . items . ix itid . itLocation .~ itloc
@@ -56,7 +57,6 @@ tryPutItemInInv mcipos cid itid w = do
i <- mcipos i <- mcipos
return $ hud . diSections . ix 3 . ssSet %~ IS.deleteShift i return $ hud . diSections . ix 3 . ssSet %~ IS.deleteShift i
updateselectionextra i updateselectionextra i
-- | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
| cid == 0 = (hud . diSections . ix 0 . ssSet %~ IS.map (f i)) | cid == 0 = (hud . diSections . ix 0 . ssSet %~ IS.map (f i))
. (hud . diSelection . _Just . slInt %~ f i) . (hud . diSelection . _Just . slInt %~ f i)
| otherwise = id | otherwise = id
+27 -60
View File
@@ -1,10 +1,8 @@
module Dodge.Inventory.Location ( module Dodge.Inventory.Location (
-- updateRootItemID,
crUpdateItemLocations, crUpdateItemLocations,
setInvPosFromSS, setInvPosFromSS,
) where ) where
import Dodge.Item.AimStance
import Control.Lens import Control.Lens
import Data.Foldable import Data.Foldable
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
@@ -14,6 +12,7 @@ import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree import Dodge.Data.DoubleTree
import Dodge.Data.Item.Use.Consumption.LoadAction import Dodge.Data.Item.Use.Consumption.LoadAction
import Dodge.Data.World import Dodge.Data.World
import Dodge.Item.AimStance
import Dodge.Item.Grammar import Dodge.Item.Grammar
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import NewInt import NewInt
@@ -29,87 +28,55 @@ tryGetRootAttachedFromInvID (NInt invid) im = do
t <- imroots ^? ix theroot . _2 t <- imroots ^? ix theroot . _2
return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t) return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t)
---- this assumes the creature inventory is well formed, specifically the
---- location ids
---- note the item intmap is all items
--getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int
--getRootItemInvID m i cr = fromMaybe i $ do
-- let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
-- theroot <- adj ^? ix i
-- theroot ^? _1 . _Just . _1
--updateRootItemID :: IM.IntMap Item -> Creature -> World -> World
--updateRootItemID m cr w = fromMaybe w $ do
-- Sel 0 i <- w^?hud.diSelection._Just
----revise2 i <- w^?hud . manObject . imSelectedItem . unNInt
-- let j = getRootItemInvID m i cr
-- return $ w & hud . manObject . hiRootSelectedItem .~ NInt j
-- the following assumes that the crManipulation is correct -- the following assumes that the crManipulation is correct
crUpdateItemLocations :: Int -> World -> World crUpdateItemLocations :: World -> World
crUpdateItemLocations crid lw = fromMaybe lw $ do crUpdateItemLocations lw = fromMaybe lw $ do
mo <- lw ^? hud . manObject mo <- lw ^? hud . manObject
cinv <- lw ^? cWorld.lWorld.creatures . ix crid . crInv cinv <- lw ^? cWorld . lWorld . creatures . ix 0 . crInv
let crinv = fmap (\k -> lw ^?! cWorld.lWorld.items . ix k) cinv let crinv = fmap (\k -> lw ^?! cWorld . lWorld . items . ix k) cinv
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv return $ crSetRoots $ IM.foldlWithKey' (crUpdateInvidLocations mo) lw $ _unNIntMap crinv
crSetRoots :: Int -> World -> World crSetRoots :: World -> World
crSetRoots cid w = fromMaybe w $ do crSetRoots w = fromMaybe w $ do
inv <- w ^? cWorld .lWorld. creatures . ix cid . crInv inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
let cinv = invIMDT $ fmap (\i -> w ^?! cWorld.lWorld.items . ix i) inv let cinv = invIMDT $ fmap (\i -> w ^?! cWorld . lWorld . items . ix i) inv
return $ foldl' f (foldl' g w inv) cinv return $ foldl' f (foldl' g w inv) cinv
where where
g w' i = w' &cWorld.lWorld.items . ix i . itLocation . ilIsRoot .~ False g w' i = w' & cWorld . lWorld . items . ix i . itLocation . ilIsRoot .~ False
f :: World -> DTree OItem -> World f :: World -> DTree OItem -> World
f w' x = f w' x =
w' &cWorld.lWorld.items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True w' & cWorld . lWorld . items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
crUpdateInvidLocations :: ManipulatedObject -> Int -> World -> Int -> Item -> World crUpdateInvidLocations :: ManipulatedObject -> World -> Int -> Item -> World
crUpdateInvidLocations mo crid lw invid itm = crUpdateInvidLocations mo w invid itm =
lw w
&cWorld.lWorld.creatures . ix crid . crInv . ix (NInt invid) .~ itid & cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt invid) .~ itid
&cWorld.lWorld.items . ix itid .~ (itm & itLocation .~ newloc) & cWorld . lWorld . items . ix itid .~ (itm & itLocation .~ newloc)
where where
itid = itm ^. itID . unNInt itid = itm ^. itID . unNInt
newloc = newloc =
InInv InInv
{ _ilCrID = crid { _ilCrID = 0
, _ilInvID = NInt invid , _ilInvID = NInt invid
, _ilIsRoot = Just (NInt invid) == mo ^? hiRootSelectedItem , _ilIsRoot = Just (NInt invid) == mo ^? hiRootSelectedItem
, _ilIsSelected = Just (NInt invid) == lw ^? hud.diSelection._Just.slInt.to NInt -- this may match with the wrong sections, not sure if this is possible , _ilIsSelected = Just (Sel 0 invid) == w ^? hud . diSelection . _Just
--revise1 , _ilIsSelected = Just (NInt i2vid) == mo ^? imSelectedItem
, _ilIsAttached = invid `IS.member` (mo ^. hiAttachedItems) , _ilIsAttached = invid `IS.member` (mo ^. hiAttachedItems)
, _ilEquipSite = lw ^? cWorld .lWorld. items . ix itid . itLocation . ilEquipSite . _Just , _ilEquipSite = w ^? cWorld . lWorld . items . ix itid . itLocation . ilEquipSite . _Just
--revise1 , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
} }
-- this should be looked at, as it is sometimes used in functions that need not
-- concern the player creature
-- this might not work if the selpos is in the inventory but too large
setInvPosFromSS :: World -> World setInvPosFromSS :: World -> World
setInvPosFromSS w = w &hud . manObject .~ thesel setInvPosFromSS w = w & hud . manObject .~ thesel
--revise1 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where where
invitemmap =
(\k -> w ^?! cWorld . lWorld . items . ix k)
<$> you w ^. crInv
thesel = fromMaybe HandsFree $ do thesel = fromMaybe HandsFree $ do
--Sel i j _ <- w ^? hud . diSelection . _Just
Sel 0 j <- w ^? hud . diSelection . _Just Sel 0 j <- w ^? hud . diSelection . _Just
(rootid, aset) <- (rootid, aset) <- tryGetRootAttachedFromInvID (NInt j) invitemmap
tryGetRootAttachedFromInvID dt <- invIMDT invitemmap ^? ix rootid
(NInt j)
( fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $
you w ^. crInv
)
dt <- invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix rootid
-- there is redundancy above
return return
HeldItem HeldItem
{ _hiRootSelectedItem = NInt rootid { _hiRootSelectedItem = NInt rootid
, _hiAimStance = itemAimStance ((\(x,y,_) -> (x,y)) <$> dt) , _hiAimStance = itemAimStance ((\(x, y, _) -> (x, y)) <$> dt)
, _hiAttachedItems = aset , _hiAttachedItems = aset
} }
-- 1 -> Just SelNothing
-- 2 -> Just SortCloseItem
-- 3 -> Just $ SelCloseItem j
-- 4 -> Just SortCloseButton
-- 5 -> Just $ SelCloseButton j
-- _ -> error "selection out of bounds"
-2
View File
@@ -11,8 +11,6 @@ getInventoryPath w x ip itid cr = case ip of
ABSOLUTE -> checkinvid x ABSOLUTE -> checkinvid x
RELCURS -> do RELCURS -> do
Sel 0 selid <- w ^? hud .diSelection._Just Sel 0 selid <- w ^? hud .diSelection._Just
--revise2 selid <- w ^? hud . manObject . imSelectedItem . unNInt
--revise1 selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
checkinvid (x + selid) checkinvid (x + selid)
RELITEM -> checkinvid (itid + x) RELITEM -> checkinvid (itid + x)
where where
+2 -6
View File
@@ -37,13 +37,11 @@ swapInvItems f i w = fromMaybe w $ do
& swapAnyExtraSelection 0 i k & swapAnyExtraSelection 0 i k
& checkConnection InventorySound disconnectItemS i k & checkConnection InventorySound disconnectItemS i k
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
-- & updatecreature' k
& updateselection & updateselection
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
& crUpdateItemLocations 0 & crUpdateItemLocations
--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0
& setInvPosFromSS & setInvPosFromSS
& crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes & crUpdateItemLocations
-- a rethink is maybe in order -- a rethink is maybe in order
& checkConnection InventoryConnectSound connectItemS i k & checkConnection InventoryConnectSound connectItemS i k
where where
@@ -51,8 +49,6 @@ swapInvItems f i w = fromMaybe w $ do
(crInv . unNIntMap %~ IM.safeSwapKeys i k) (crInv . unNIntMap %~ IM.safeSwapKeys i k)
. swapSite i k . swapSite i k
. swapSite k i . swapSite k i
-- updatecreature' k = (hud . manObject . imSelectedItem .~ NInt k)
--revise2 updatecreature' k = (hud . manObject . imSelectedItem .~ NInt k)
cr = you w cr = you w
swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of 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 Just epos -> crEquipment . ix epos .~ NInt b
-1
View File
@@ -21,7 +21,6 @@ itemEquipPict w cr itmtree
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip = , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip =
equipPosition esite w cr attachpos (itemSPic itm) equipPosition esite w cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == w ^? hud . manObject . hiRootSelectedItem = | itm ^? itLocation . ilInvID == w ^? hud . manObject . hiRootSelectedItem =
--revise1 | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem =
overPosSP (Q.apply $ handHandleOrient w loc cr) (itemTreeSPic itmtree) overPosSP (Q.apply $ handHandleOrient w loc cr) (itemTreeSPic itmtree)
| otherwise = mempty | otherwise = mempty
where where
-4
View File
@@ -26,16 +26,12 @@ import Dodge.Data.World
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourSelectedItem f w = fromMaybe (pure w) $ do pointerYourSelectedItem f w = fromMaybe (pure w) $ do
Sel 0 itinvid <- w ^? hud.diSelection._Just 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 (NInt itinvid) itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt itinvid)
Just $ (cWorld . lWorld . items . ix itid) f w Just $ (cWorld . lWorld . items . ix itid) f w
-- note the ilIsRoot/Selected/Attached booleans are irrelevant
pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourRootItem f w = fromMaybe (pure w) $ do pointerYourRootItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? hud. manObject . hiRootSelectedItem itinvid <- w ^? hud. manObject . hiRootSelectedItem
--revise1 itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
Just $ (cWorld . lWorld . items . ix itid) f w Just $ (cWorld . lWorld . items . ix itid) f w
+2 -9
View File
@@ -197,8 +197,6 @@ doBarrelSpin cid i pj w =
pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World
pjRemoteSetDirection ph pj w = case ph of pjRemoteSetDirection ph pj w = case ph of
HomeUsingRemoteScreen screenid HomeUsingRemoteScreen screenid
--revise2 | w ^? hud . manObject . imSelectedItem
--revise1 | w ^? hud . manObject . imSelectedItem
| w ^. hud .diSelection | w ^. hud .diSelection
== fmap (\i -> Sel 0 (i^.unNInt)) (lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID) -> == fmap (\i -> Sel 0 (i^.unNInt)) (lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID) ->
w w
@@ -207,13 +205,8 @@ pjRemoteSetDirection ph pj w = case ph of
HomeUsingTargeting itid HomeUsingTargeting itid
| Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just -> | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
w w
& pjlens & pjlens . pjDir %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
. pjDir & pjlens . pjSpin .~ 0.5 * diffAngles
%~ turnTo 0.2 (pj ^. pjPos . _xy) tp
& pjlens
. pjSpin
.~ 0.5
* diffAngles
(turnTo 0.2 (pj ^. pjPos . _xy) tp pjdir) (turnTo 0.2 (pj ^. pjPos . _xy) tp pjdir)
pjdir pjdir
_ -> w _ -> w
-2
View File
@@ -259,8 +259,6 @@ drawRBOptions cfig w = fold $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w) guard $ ButtonRight `M.member` _mouseButtons (_input w)
Sel 0 invid' <- w^.hud.diSelection Sel 0 invid' <- w^.hud.diSelection
let invid = NInt invid' let invid = NInt invid'
--revise2 invid <- w ^? hud . manObject . imSelectedItem
--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem
itid <- you w ^? crInv . ix invid itid <- you w ^? crInv . ix invid
eslist <- eslist <-
fmap eqTypeToSites $ fmap eqTypeToSites $
+4 -5
View File
@@ -58,10 +58,10 @@ crs :: Universe -> [Creature]
crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
testStringInit :: Universe -> [String] testStringInit :: Universe -> [String]
testStringInit u = testStringInit u = [u ^. uvWorld . input . mouseContext . to show]
u ^. uvWorld . hud . manObject . to prettyShort -- u ^. uvWorld . hud . manObject . to prettyShort
<> -- <>
u ^.. uvWorld . hud . diSections . each . ssSet . to show -- u ^.. uvWorld . hud . diSections . each . ssSet . to show
--testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort --testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
--[show . getSum $ foldMap (Sum . crslime) (crs u)] --[show . getSum $ foldMap (Sum . crslime) (crs u)]
-- u ^.. tocrs . each . crType . slimeSplitTimer . to show -- u ^.. tocrs . each . crType . slimeSplitTimer . to show
@@ -126,7 +126,6 @@ testStringInit u =
topTestPart :: Universe -> [String] topTestPart :: Universe -> [String]
topTestPart u = topTestPart u =
[ maybe "" showManObj $ u ^? uvWorld . hud . manObject [ maybe "" showManObj $ u ^? uvWorld . hud . manObject
--revise1 [ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
] ]
showManObj :: ManipulatedObject -> String showManObj :: ManipulatedObject -> String
-1
View File
@@ -352,7 +352,6 @@ pushYouOutFromWalls u
muzzleWallCheck :: World -> Creature -> Creature muzzleWallCheck :: World -> Creature -> Creature
muzzleWallCheck w cr = fromMaybe cr $ do muzzleWallCheck w cr = fromMaybe cr $ do
invid <- w ^? hud . manObject . hiRootSelectedItem . unNInt invid <- w ^? hud . manObject . hiRootSelectedItem . unNInt
--revise1 invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
loc <- loc <-
invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr) invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2 ^? ix invid . _2
-6
View File
@@ -103,8 +103,6 @@ moveZoomCamera cfig theinput cr w campos =
where where
mremotepos = do mremotepos = do
Sel 0 i <- w^?hud .diSelection._Just Sel 0 i <- w^?hud .diSelection._Just
--revise1 i <- cr ^? crManipulation . manObject . imSelectedItem
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i) itid <- cr ^? crInv . ix (NInt i)
j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0 j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0
guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach
@@ -113,7 +111,6 @@ moveZoomCamera cfig theinput cr w campos =
offset = fromMaybe noscopeoffset $ do offset = fromMaybe noscopeoffset $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput) guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
Sel 0 i <- w^?hud.diSelection._Just Sel 0 i <- w^?hud.diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i) itid <- cr ^? crInv . ix (NInt i)
fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos) fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos)
noscopeoffset = noscopeoffset =
@@ -121,19 +118,16 @@ moveZoomCamera cfig theinput cr w campos =
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
Sel 0 i <- w^?hud .diSelection._Just Sel 0 i <- w^?hud .diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i) itid <- cr ^? crInv . ix (NInt i)
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealDefaultZoom = clipZoom wallZoom idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
Sel 0 i <- w^?hud .diSelection._Just Sel 0 i <- w^?hud .diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i) itid <- cr ^? crInv . ix (NInt i)
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
idealItemZoom = fromMaybe 1 $ do idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr guard $ crIsAiming cr
Sel 0 i <- w^?hud .diSelection._Just Sel 0 i <- w^?hud .diSelection._Just
--revise2 i <- w^?hud . manObject . imSelectedItem
itid <- cr ^? crInv . ix (NInt i) itid <- cr ^? crInv . ix (NInt i)
getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid) getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
+2 -2
View File
@@ -301,9 +301,9 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
return (k - 1) return (k - 1)
startDrag :: (Int, Int) -> World -> World startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext $ fromMaybe (invSetSelection (Sel a b) w) $ do startDrag (a, b) w = setcontext $ fromMaybe (invSetSelection (Sel a b) w & hud.diSections.ix a.ssSet.~ mempty) $ do
i <- w ^? hud . diSelection . _Just . slSec i <- w ^? hud . diSelection . _Just . slSec
xs <- w ^? hud . diSections . ix i . ssSet xs <- w ^? hud . diSections . ix a . ssSet
guard $ i == a && b `IS.member` xs guard $ i == a && b `IS.member` xs
return w return w
where where
+5 -7
View File
@@ -34,24 +34,22 @@ updateBaseWheelEvent yi w
EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax
NoRightButtonState -> fromMaybe w (selectedItemScroll yi w) NoRightButtonState -> fromMaybe w (selectedItemScroll yi w)
| bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
| ScancodeCapsLock `M.member` _pressedKeys (_input w) | kdown ScancodeCapsLock
, ScancodeLShift `M.member` (w ^. input . pressedKeys) = changeSwapSel yi w , kdown ScancodeLShift = changeSwapSel yi w
| ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSelSet yi w | kdown ScancodeCapsLock = changeSwapSelSet yi w
| ScancodeLShift `M.member` (w ^. input . pressedKeys) = multiSelScroll yi w | kdown ScancodeLShift = multiSelScroll yi w
| otherwise = scrollAugInvSel yi w | otherwise = scrollAugInvSel yi w
where where
kdown k = k `M.member` (w ^. input . pressedKeys)
bdown b = w & has (input . mouseButtons . ix b) bdown b = w & has (input . mouseButtons . ix b)
rbscrollmax = fromMaybe 1 $ do rbscrollmax = fromMaybe 1 $ do
Sel 0 invid <- w ^. hud.diSelection Sel 0 invid <- w ^. hud.diSelection
--revise2 invid <- w ^? hud . manObject . imSelectedItem
--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem
etype <- you w ^? crInv . ix (NInt 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 return . length $ eqTypeToSites etype
selectedItemScroll :: Int -> World -> Maybe World selectedItemScroll :: Int -> World -> Maybe World
selectedItemScroll yi w = do selectedItemScroll yi w = do
Sel 0 i <- w ^.hud.diSelection 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 itm <- you w ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
return $ itemScroll yi itm w return $ itemScroll yi itm w