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

Cleanup inventory management, tweak dragging start

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