diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index cdb01c45b..ed900bd72 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -210,12 +210,13 @@ dropExcept cr invid w = foldr (dropItem cr) w . IM.keys $ invid `IM.delete` _crInv cr 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 cid = _crID cr - mayberemoveequip = case _crLeftInvSel cr of - Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing - _ -> id +-- the following should be done in rmInvItem +-- mayberemoveequip = case _crLeftInvSel cr of +-- Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing +-- _ -> id youDropItem :: World -> World youDropItem w @@ -239,7 +240,6 @@ copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) & itIsHeld .~ False ) - sizeSelf :: Float -> Creature -> World -> Maybe World sizeSelf x cr w -- | _crPos cr1 == _crPos cr2 = Just $ w diff --git a/src/Dodge/Creature/Impulse/Movement.hs b/src/Dodge/Creature/Impulse/Movement.hs index d3d443c7c..b4882579a 100644 --- a/src/Dodge/Creature/Impulse/Movement.hs +++ b/src/Dodge/Creature/Impulse/Movement.hs @@ -28,7 +28,7 @@ crMvAbsolute p' cr = advanceStepCounter (magV p) cr strengthFactor :: Int -> Float strengthFactor i | i > 9 = 1 - | i < 1 = 0.1 + | i < 1 = 0 | otherwise = 0.1 * fromIntegral i crMvForward diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index e97c15217..e9dc12b6b 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -71,11 +71,13 @@ eqSiteToPos cr es = case es of useLeftItem :: Int -> World -> World useLeftItem cid w | _crInvLock cr = w - | itConsumable = useItem cr w + | itmShouldBeUsed = useItem cr w | otherwise = fromMaybe w $ do invid <- _crLeftInvSel cr f <- cr ^? crInv . ix invid . itUse . lUse return $ f cr invid w where 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 diff --git a/src/Dodge/Creature/Statistics.hs b/src/Dodge/Creature/Statistics.hs index b5a2a726f..1079a85ea 100644 --- a/src/Dodge/Creature/Statistics.hs +++ b/src/Dodge/Creature/Statistics.hs @@ -16,7 +16,7 @@ strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment equipmentStrValue :: Item -> Int equipmentStrValue itm = case _itType itm of - FRONTARMOUR -> negate 1 + FRONTARMOUR -> negate 3 POWERLEGS -> 3 _ -> 0 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ea1ece92a..902395bee 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -377,6 +377,7 @@ data ItemUse { _lUse :: Creature -> Int -> World -> World , _useDelay :: UseDelay , _useHammer :: HammerType + , _eqSite :: EquipSite } | ConsumeUse { _cUse :: Item -> Creature -> World -> World diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 15117cf55..781ff56af 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -65,6 +65,7 @@ defaultlUse = LeftUse { _lUse = \_ _ -> id , _useDelay = FixedRate {_rateMax = 8, _rateTime = 0} , _useHammer = NoHammer + , _eqSite = GoesOnWrist } luseInstantNoH :: (Creature -> Int -> World -> World) -> ItemUse @@ -72,6 +73,7 @@ luseInstantNoH f = LeftUse { _lUse = f , _useDelay = NoDelay , _useHammer = NoHammer + , _eqSite = GoesOnWrist } defaultAimParams :: AimParams defaultAimParams = AimParams diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 8041f097c..4137c9650 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -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 _ -> w & creatures . ix cid . crInv %~ f & 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.mapKeys g + & creatures . ix cid . crInvEquipped %~ IM.mapKeys g -- TODO check whether this can be mapKeysMonotonic 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 f inv = let (xs,ys) = IM.split invid inv in xs `IM.union` IM.mapKeys (subtract 1) ys g x | x > invid || Just x == maxk = max 0 $ x - 1 | 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 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' & closeObjects %~ swapIndices (i - n) (ico' - n) where - updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi ) + updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi ) . (crLeftInvSel . _Just %~ updateLeftInvSel) . (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 updateLeftInvSel li | i == li = swapi | swapi == li = i | otherwise = li - i = _crInvSel $ you w + i = _crInvSel cr ico' = ( (i - (k+n)) `mod` numCO ) + n - n = length $ _crInv $ _creatures w IM.! _yourID w + n = length $ _crInv cr numCO = length $ _closeObjects w --swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet diff --git a/src/IntMapHelp.hs b/src/IntMapHelp.hs index 00d358a6c..c68985086 100644 --- a/src/IntMapHelp.hs +++ b/src/IntMapHelp.hs @@ -3,9 +3,11 @@ module IntMapHelp , newKey , insertNewKey , insertWithNewKeys - , swapKeys + , unsafeSwapKeys + , safeSwapKeys , findIndex ) where +import LensHelp --import Data.List hiding (foldr,insert) import Data.IntMap.Strict {- | 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 xs m = union m $ fromList $ zip [newKey m..] xs {- | Swaps two keys. Unsafe: assumes both keys exist. -} -swapKeys :: Int -> Int -> IntMap a -> IntMap a -swapKeys i j m = insert i (m ! j) $ insert j (m ! i) m +unsafeSwapKeys :: Int -> Int -> IntMap a -> IntMap a +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 -- though