Fix inventory swapping equipment bug
This commit is contained in:
@@ -210,12 +210,13 @@ dropExcept cr invid w = foldr (dropItem cr) w . IM.keys
|
|||||||
$ invid `IM.delete` _crInv cr
|
$ invid `IM.delete` _crInv cr
|
||||||
|
|
||||||
dropItem :: Creature -> Int -> World -> World
|
dropItem :: Creature -> Int -> World -> World
|
||||||
dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid . mayberemoveequip
|
dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . mayberemoveequip
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
mayberemoveequip = case _crLeftInvSel cr of
|
-- the following should be done in rmInvItem
|
||||||
Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
|
-- mayberemoveequip = case _crLeftInvSel cr of
|
||||||
_ -> id
|
-- Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
|
||||||
|
-- _ -> id
|
||||||
|
|
||||||
youDropItem :: World -> World
|
youDropItem :: World -> World
|
||||||
youDropItem w
|
youDropItem w
|
||||||
@@ -239,7 +240,6 @@ copyInvItemToFloor cr i = copyItemToFloor (_crPos cr)
|
|||||||
& itIsHeld .~ False
|
& itIsHeld .~ False
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
sizeSelf :: Float -> Creature -> World -> Maybe World
|
sizeSelf :: Float -> Creature -> World -> Maybe World
|
||||||
sizeSelf x cr w
|
sizeSelf x cr w
|
||||||
-- | _crPos cr1 == _crPos cr2 = Just $ w
|
-- | _crPos cr1 == _crPos cr2 = Just $ w
|
||||||
|
|||||||
@@ -28,7 +28,7 @@ crMvAbsolute p' cr = advanceStepCounter (magV p) cr
|
|||||||
strengthFactor :: Int -> Float
|
strengthFactor :: Int -> Float
|
||||||
strengthFactor i
|
strengthFactor i
|
||||||
| i > 9 = 1
|
| i > 9 = 1
|
||||||
| i < 1 = 0.1
|
| i < 1 = 0
|
||||||
| otherwise = 0.1 * fromIntegral i
|
| otherwise = 0.1 * fromIntegral i
|
||||||
|
|
||||||
crMvForward
|
crMvForward
|
||||||
|
|||||||
@@ -71,11 +71,13 @@ eqSiteToPos cr es = case es of
|
|||||||
useLeftItem :: Int -> World -> World
|
useLeftItem :: Int -> World -> World
|
||||||
useLeftItem cid w
|
useLeftItem cid w
|
||||||
| _crInvLock cr = w
|
| _crInvLock cr = w
|
||||||
| itConsumable = useItem cr w
|
| itmShouldBeUsed = useItem cr w
|
||||||
| otherwise = fromMaybe w $ do
|
| otherwise = fromMaybe w $ do
|
||||||
invid <- _crLeftInvSel cr
|
invid <- _crLeftInvSel cr
|
||||||
f <- cr ^? crInv . ix invid . itUse . lUse
|
f <- cr ^? crInv . ix invid . itUse . lUse
|
||||||
return $ f cr invid w
|
return $ f cr invid w
|
||||||
where
|
where
|
||||||
cr = _creatures w IM.! cid
|
cr = _creatures w IM.! cid
|
||||||
itConsumable = isJust $ cr ^? crInv . ix (_crInvSel cr) . itUse . cUse
|
itmShouldBeUsed = isJust (cr ^? crInv . ix (_crInvSel cr) . itUse . cUse)
|
||||||
|
|| isJust (cr ^? crInv . ix (_crInvSel cr) . itUse . eqUse)
|
||||||
|
-- TODO determine itmShouldBeUsed with reference to config options
|
||||||
|
|||||||
@@ -16,7 +16,7 @@ strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
|
|||||||
|
|
||||||
equipmentStrValue :: Item -> Int
|
equipmentStrValue :: Item -> Int
|
||||||
equipmentStrValue itm = case _itType itm of
|
equipmentStrValue itm = case _itType itm of
|
||||||
FRONTARMOUR -> negate 1
|
FRONTARMOUR -> negate 3
|
||||||
POWERLEGS -> 3
|
POWERLEGS -> 3
|
||||||
_ -> 0
|
_ -> 0
|
||||||
|
|
||||||
|
|||||||
@@ -377,6 +377,7 @@ data ItemUse
|
|||||||
{ _lUse :: Creature -> Int -> World -> World
|
{ _lUse :: Creature -> Int -> World -> World
|
||||||
, _useDelay :: UseDelay
|
, _useDelay :: UseDelay
|
||||||
, _useHammer :: HammerType
|
, _useHammer :: HammerType
|
||||||
|
, _eqSite :: EquipSite
|
||||||
}
|
}
|
||||||
| ConsumeUse
|
| ConsumeUse
|
||||||
{ _cUse :: Item -> Creature -> World -> World
|
{ _cUse :: Item -> Creature -> World -> World
|
||||||
|
|||||||
@@ -65,6 +65,7 @@ defaultlUse = LeftUse
|
|||||||
{ _lUse = \_ _ -> id
|
{ _lUse = \_ _ -> id
|
||||||
, _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
|
, _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
|
||||||
, _useHammer = NoHammer
|
, _useHammer = NoHammer
|
||||||
|
, _eqSite = GoesOnWrist
|
||||||
}
|
}
|
||||||
|
|
||||||
luseInstantNoH :: (Creature -> Int -> World -> World) -> ItemUse
|
luseInstantNoH :: (Creature -> Int -> World -> World) -> ItemUse
|
||||||
@@ -72,6 +73,7 @@ luseInstantNoH f = LeftUse
|
|||||||
{ _lUse = f
|
{ _lUse = f
|
||||||
, _useDelay = NoDelay
|
, _useDelay = NoDelay
|
||||||
, _useHammer = NoHammer
|
, _useHammer = NoHammer
|
||||||
|
, _eqSite = GoesOnWrist
|
||||||
}
|
}
|
||||||
defaultAimParams :: AimParams
|
defaultAimParams :: AimParams
|
||||||
defaultAimParams = AimParams
|
defaultAimParams = AimParams
|
||||||
|
|||||||
+20
-5
@@ -50,16 +50,25 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
|
|||||||
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . itAmount %~ subtract 1
|
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . itAmount %~ subtract 1
|
||||||
_ -> w & creatures . ix cid . crInv %~ f
|
_ -> w & creatures . ix cid . crInv %~ f
|
||||||
& creatures . ix cid . crInvSel %~ g
|
& creatures . ix cid . crInvSel %~ g
|
||||||
& creatures . ix cid . crLeftInvSel . _Just %~ g
|
& creatures . ix cid . crLeftInvSel %~ g'
|
||||||
|
& removeAnySlotEquipment
|
||||||
& creatures . ix cid . crInvEquipped %~ IM.delete invid
|
& creatures . ix cid . crInvEquipped %~ IM.delete invid
|
||||||
& creatures . ix cid . crInvEquipped %~ IM.mapKeys g
|
& creatures . ix cid . crInvEquipped %~ IM.mapKeys g
|
||||||
-- TODO check whether this can be mapKeysMonotonic
|
-- TODO check whether this can be mapKeysMonotonic
|
||||||
where
|
where
|
||||||
|
removeAnySlotEquipment = case w ^? creatures . ix cid . crInvEquipped . ix invid of
|
||||||
|
Just epos -> creatures . ix cid . crEquipment . at epos .~ Nothing
|
||||||
|
Nothing -> id
|
||||||
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
|
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
|
||||||
f inv = let (xs,ys) = IM.split invid inv
|
f inv = let (xs,ys) = IM.split invid inv
|
||||||
in xs `IM.union` IM.mapKeys (subtract 1) ys
|
in xs `IM.union` IM.mapKeys (subtract 1) ys
|
||||||
g x | x > invid || Just x == maxk = max 0 $ x - 1
|
g x | x > invid || Just x == maxk = max 0 $ x - 1
|
||||||
| otherwise = x
|
| otherwise = x
|
||||||
|
g' Nothing = Nothing
|
||||||
|
g' (Just x)
|
||||||
|
| x == invid = Nothing
|
||||||
|
| x > invid || Just x == maxk = Just $ max 0 $ x - 1
|
||||||
|
| otherwise = Just x
|
||||||
|
|
||||||
rmSelectedInvItem :: Int -> World -> World
|
rmSelectedInvItem :: Int -> World -> World
|
||||||
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
|
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
|
||||||
@@ -184,17 +193,23 @@ changeSwapInvSel k w
|
|||||||
| otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
|
| otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
|
||||||
& closeObjects %~ swapIndices (i - n) (ico' - n)
|
& closeObjects %~ swapIndices (i - n) (ico' - n)
|
||||||
where
|
where
|
||||||
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
|
updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi )
|
||||||
. (crLeftInvSel . _Just %~ updateLeftInvSel)
|
. (crLeftInvSel . _Just %~ updateLeftInvSel)
|
||||||
. (crInvSel %~ (`mod` n) . subtract k)
|
. (crInvSel %~ (`mod` n) . subtract k)
|
||||||
. (crInvEquipped %~ IM.swapKeys i swapi)
|
. (crInvEquipped %~ IM.safeSwapKeys i swapi)
|
||||||
|
. swapSite i swapi
|
||||||
|
. swapSite swapi i
|
||||||
|
swapSite a b = case cr ^? crInvEquipped . ix a of
|
||||||
|
Just epos -> crEquipment . ix epos .~ b
|
||||||
|
Nothing -> id
|
||||||
|
cr = you w
|
||||||
swapi = (i - k) `mod` n
|
swapi = (i - k) `mod` n
|
||||||
updateLeftInvSel li | i == li = swapi
|
updateLeftInvSel li | i == li = swapi
|
||||||
| swapi == li = i
|
| swapi == li = i
|
||||||
| otherwise = li
|
| otherwise = li
|
||||||
i = _crInvSel $ you w
|
i = _crInvSel cr
|
||||||
ico' = ( (i - (k+n)) `mod` numCO ) + n
|
ico' = ( (i - (k+n)) `mod` numCO ) + n
|
||||||
n = length $ _crInv $ _creatures w IM.! _yourID w
|
n = length $ _crInv cr
|
||||||
numCO = length $ _closeObjects w
|
numCO = length $ _closeObjects w
|
||||||
|
|
||||||
--swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet
|
--swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet
|
||||||
|
|||||||
+10
-3
@@ -3,9 +3,11 @@ module IntMapHelp
|
|||||||
, newKey
|
, newKey
|
||||||
, insertNewKey
|
, insertNewKey
|
||||||
, insertWithNewKeys
|
, insertWithNewKeys
|
||||||
, swapKeys
|
, unsafeSwapKeys
|
||||||
|
, safeSwapKeys
|
||||||
, findIndex
|
, findIndex
|
||||||
) where
|
) where
|
||||||
|
import LensHelp
|
||||||
--import Data.List hiding (foldr,insert)
|
--import Data.List hiding (foldr,insert)
|
||||||
import Data.IntMap.Strict
|
import Data.IntMap.Strict
|
||||||
{- | Find a key value one higher than any key in the map, or zero if the map is
|
{- | Find a key value one higher than any key in the map, or zero if the map is
|
||||||
@@ -21,8 +23,13 @@ insertNewKey x m = case lookupMax m of
|
|||||||
insertWithNewKeys :: [a] -> IntMap a -> IntMap a
|
insertWithNewKeys :: [a] -> IntMap a -> IntMap a
|
||||||
insertWithNewKeys xs m = union m $ fromList $ zip [newKey m..] xs
|
insertWithNewKeys xs m = union m $ fromList $ zip [newKey m..] xs
|
||||||
{- | Swaps two keys. Unsafe: assumes both keys exist. -}
|
{- | Swaps two keys. Unsafe: assumes both keys exist. -}
|
||||||
swapKeys :: Int -> Int -> IntMap a -> IntMap a
|
unsafeSwapKeys :: Int -> Int -> IntMap a -> IntMap a
|
||||||
swapKeys i j m = insert i (m ! j) $ insert j (m ! i) m
|
unsafeSwapKeys i j m = insert i (m ! j) $ insert j (m ! i) m
|
||||||
|
|
||||||
|
safeSwapKeys :: Int -> Int -> IntMap a -> IntMap a
|
||||||
|
safeSwapKeys i j m = m
|
||||||
|
& at i .~ (m ^? ix j)
|
||||||
|
& at j .~ (m ^? ix i)
|
||||||
|
|
||||||
-- ideally this should short circuit, I am not sure whether it does or not
|
-- ideally this should short circuit, I am not sure whether it does or not
|
||||||
-- though
|
-- though
|
||||||
|
|||||||
Reference in New Issue
Block a user