Refactor, try to limit dependencies
This commit is contained in:
+213
-170
@@ -1,90 +1,90 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Inventory
|
||||
( checkInvSlotsYou
|
||||
, rmSelectedInvItem
|
||||
, invSelPos
|
||||
, invSelSize
|
||||
, selNumPos
|
||||
, selNumTextPos
|
||||
, selNumCol
|
||||
, selNumSlots
|
||||
, selNumMidHeight
|
||||
, augmentedInvSizes
|
||||
, rmInvItem
|
||||
, updateCloseObjects
|
||||
, updateRBList
|
||||
, updateTerminal
|
||||
, closeObjScrollDir
|
||||
, closeObjectCol
|
||||
, changeInvSel
|
||||
, changeSwapInvSel
|
||||
, changeAugInvSel
|
||||
, crNumFreeSlots
|
||||
, crInvSize
|
||||
, selectedCloseObject
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.ItEffect
|
||||
import Dodge.Euse
|
||||
import Dodge.Inventory.CloseObject
|
||||
import Dodge.Inventory.CheckSlots
|
||||
import Dodge.Inventory.ItemSpace
|
||||
import Dodge.Base
|
||||
import Geometry
|
||||
--import FoldableHelp
|
||||
import Padding
|
||||
import Color
|
||||
import qualified IntMapHelp as IM
|
||||
import ListHelp
|
||||
import LensHelp
|
||||
|
||||
--import qualified Data.IntSet as IS
|
||||
module Dodge.Inventory (
|
||||
checkInvSlotsYou,
|
||||
rmSelectedInvItem,
|
||||
invSelPos,
|
||||
invSelSize,
|
||||
selNumPos,
|
||||
selNumTextPos,
|
||||
selNumCol,
|
||||
selNumSlots,
|
||||
selNumMidHeight,
|
||||
augmentedInvSizes,
|
||||
rmInvItem,
|
||||
updateCloseObjects,
|
||||
updateRBList,
|
||||
updateTerminal,
|
||||
closeObjScrollDir,
|
||||
closeObjectCol,
|
||||
changeInvSel,
|
||||
changeSwapInvSel,
|
||||
changeAugInvSel,
|
||||
crNumFreeSlots,
|
||||
crInvSize,
|
||||
selectedCloseObject,
|
||||
) where
|
||||
|
||||
import Color
|
||||
import qualified Data.Map.Strict as M
|
||||
--import qualified Data.Set as S
|
||||
import Data.Maybe
|
||||
--import qualified Data.Text as T
|
||||
--import SDL
|
||||
--import Data.List
|
||||
--import System.Random
|
||||
import Dodge.Base
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.Euse
|
||||
import Dodge.Inventory.CheckSlots
|
||||
import Dodge.Inventory.CloseObject
|
||||
import Dodge.Inventory.ItemSpace
|
||||
import Dodge.ItEffect
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
import ListHelp
|
||||
import Padding
|
||||
|
||||
-- | after this the item at the inventory position will no longer exist
|
||||
rmInvItem :: Int -- ^ Creature id
|
||||
-> Int -- ^ Inventory position
|
||||
-> World
|
||||
-> World
|
||||
rmInvItem ::
|
||||
-- | Creature id
|
||||
Int ->
|
||||
-- | Inventory position
|
||||
Int ->
|
||||
World ->
|
||||
World
|
||||
rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of
|
||||
Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1
|
||||
_ -> w
|
||||
& cWorld . creatures . ix cid . crInv %~ f
|
||||
& cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
|
||||
& cWorld . creatures . ix cid . crInvSel . iselPos %~ g
|
||||
& cWorld . creatures . ix cid . crLeftInvSel %~ g'
|
||||
& removeAnySlotEquipment
|
||||
& dounequipfunction
|
||||
& doanyitemeffect
|
||||
& cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
|
||||
& cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
|
||||
-- TODO check whether this can be mapKeysMonotonic
|
||||
_ ->
|
||||
w
|
||||
& cWorld . creatures . ix cid . crInv %~ f
|
||||
& cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
|
||||
& cWorld . creatures . ix cid . crInvSel . iselPos %~ g
|
||||
& cWorld . creatures . ix cid . crLeftInvSel %~ g'
|
||||
& removeAnySlotEquipment
|
||||
& dounequipfunction
|
||||
& doanyitemeffect
|
||||
& cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
|
||||
& cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
|
||||
where
|
||||
-- TODO check whether this can be mapKeysMonotonic
|
||||
|
||||
stopCrInvSelAction (InvSel i a)
|
||||
| i == invid = InvSel i NoInvSelAction
|
||||
| otherwise = InvSel i a
|
||||
| otherwise = InvSel i a
|
||||
cr = _creatures (_cWorld w) IM.! cid
|
||||
itm = _crInv cr IM.! invid
|
||||
dounequipfunction = fromMaybe id $ do
|
||||
rmf <- itm ^? itUse . eqEq . eqOnRemove
|
||||
rmf <- itm ^? itUse . equipEffect . eeOnRemove
|
||||
return $ useE rmf itm cr
|
||||
doanyitemeffect = fromMaybe id $ do
|
||||
rmf <- itm ^? itEffect . ieOnDrop
|
||||
return $ doInvEffect rmf itm cr
|
||||
removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of
|
||||
Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
|
||||
Nothing -> id
|
||||
Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
|
||||
Nothing -> id
|
||||
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld 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
|
||||
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)
|
||||
@@ -99,9 +99,10 @@ augmentedInvSizes :: World -> IM.IntMap Int
|
||||
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
|
||||
|
||||
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
|
||||
bimapAugmentInv f g w = IM.union
|
||||
(f <$> yourInv w)
|
||||
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w))
|
||||
bimapAugmentInv f g w =
|
||||
IM.union
|
||||
(f <$> yourInv w)
|
||||
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w))
|
||||
|
||||
invSelSize :: Int -> World -> Int
|
||||
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
|
||||
@@ -109,11 +110,12 @@ invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
|
||||
closeObjectSize :: Either FloorItem Button -> Int
|
||||
closeObjectSize e = case e of
|
||||
Left flit -> itSlotsTaken $ _flIt flit
|
||||
Right _ -> 1
|
||||
Right _ -> 1
|
||||
|
||||
closeObjectCol :: Either FloorItem Button -> Color
|
||||
closeObjectCol e = case e of
|
||||
Left flit -> _itInvColor $ _flIt flit
|
||||
Right _ -> yellow
|
||||
Right _ -> yellow
|
||||
|
||||
selNumSlots :: Int -> World -> Int
|
||||
selNumSlots i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
|
||||
@@ -126,17 +128,17 @@ selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w
|
||||
| otherwise = 1
|
||||
|
||||
selNumTextPos :: Configuration -> World -> Int -> Point2
|
||||
selNumTextPos cfig w i = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 20))
|
||||
selNumTextPos cfig w i = V2 (150 - hw) (hh - (20 * fromIntegral ipos + 20))
|
||||
where
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
hw = halfWidth cfig
|
||||
ipos = selNumPos i w
|
||||
|
||||
selNumMidHeight :: Configuration -> World -> Int -> Point2
|
||||
selNumMidHeight cfig w i = V2 (150 - hw) ( hh + bump - (20 * fromIntegral ipos + 7.5))
|
||||
selNumMidHeight cfig w i = V2 (150 - hw) (hh + bump - (20 * fromIntegral ipos + 7.5))
|
||||
where
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
hw = halfWidth cfig
|
||||
ipos = selNumPos i w
|
||||
bump = negate $ 10 * fromIntegral (selNumSlots i w)
|
||||
|
||||
@@ -157,47 +159,54 @@ updateTerminal = checkTermDist
|
||||
checkTermDist :: World -> World
|
||||
checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of
|
||||
Just tmid -> fromMaybe (w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do
|
||||
btid <- w ^? cWorld . terminals . ix tmid . tmButtonID
|
||||
btpos <- w ^? cWorld . buttons . ix btid . btPos
|
||||
btid <- w ^? cWorld . terminals . ix tmid . tmButtonID
|
||||
btpos <- w ^? cWorld . buttons . ix btid . btPos
|
||||
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
|
||||
Nothing -> w
|
||||
|
||||
-- this looks ugly...
|
||||
updateCloseObjects :: World -> World
|
||||
updateCloseObjects w = w
|
||||
& cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel
|
||||
updateCloseObjects w =
|
||||
w
|
||||
& cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel
|
||||
where
|
||||
updateinvsel curinvsel
|
||||
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
|
||||
| otherwise = curinvsel
|
||||
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
|
||||
ypos = _crPos $ you w
|
||||
activeButtons = map Right
|
||||
. filter ( (/=) BtNoLabel . _btState)
|
||||
. IM.elems
|
||||
$ _buttons (_cWorld w)
|
||||
activeButtons =
|
||||
map Right
|
||||
. filter ((/=) BtNoLabel . _btState)
|
||||
. IM.elems
|
||||
$ _buttons (_cWorld w)
|
||||
currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons
|
||||
oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w)
|
||||
oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w)
|
||||
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
|
||||
updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid)
|
||||
updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid)
|
||||
|
||||
updateRBList :: World -> World
|
||||
updateRBList w
|
||||
| w ^? rbOptions . opCurInvPos == Just curinvid
|
||||
= w & setEquipAllocation & setEquipActivation
|
||||
| otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of
|
||||
Just esite -> w
|
||||
& rbOptions .~ EquipOptions (equipSiteToPositions esite)
|
||||
(chooseEquipmentPosition cr (equipSiteToPositions esite))
|
||||
curinvid
|
||||
DoNotMoveEquipment
|
||||
NoChangeActivateEquipment
|
||||
& setEquipAllocation & setEquipActivation
|
||||
updateRBList w
|
||||
| w ^? rbOptions . opCurInvPos == Just curinvid =
|
||||
w & setEquipAllocation & setEquipActivation
|
||||
| otherwise = case cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite of
|
||||
Just esite ->
|
||||
w
|
||||
& rbOptions
|
||||
.~ EquipOptions
|
||||
(equipSiteToPositions esite)
|
||||
(chooseEquipmentPosition cr (equipSiteToPositions esite))
|
||||
curinvid
|
||||
DoNotMoveEquipment
|
||||
NoChangeActivateEquipment
|
||||
& setEquipAllocation
|
||||
& setEquipActivation
|
||||
Nothing -> w & rbOptions .~ NoRightButtonOptions
|
||||
-- | otherwise = w & rbOptions .~ NoRightButtonOptions
|
||||
where
|
||||
-- | otherwise = w & rbOptions .~ NoRightButtonOptions
|
||||
|
||||
curinvid = crSel cr
|
||||
cr = you w
|
||||
|
||||
@@ -213,121 +222,155 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
|
||||
|
||||
setEquipAllocation :: World -> World
|
||||
setEquipAllocation w = case _rbOptions w of
|
||||
EquipOptions {_opEquip = es,_opSel=i} ->
|
||||
EquipOptions{_opEquip = es, _opSel = i} ->
|
||||
case you w ^? crInvEquipped . ix (crSel (you w)) of
|
||||
Just epos | es !! i == epos
|
||||
-> w & rbOptions . opAllocateEquipment .~ RemoveEquipment
|
||||
{_allocOldPos = epos}
|
||||
Just epos | isJust (you w ^? crEquipment . ix (es !! i))
|
||||
-> w & rbOptions . opAllocateEquipment .~ SwapEquipment
|
||||
{_allocOldPos = epos
|
||||
,_allocNewPos = es !! i
|
||||
,_allocSwapID = _crEquipment (you w) M.! (es !! i)
|
||||
Just epos
|
||||
| es !! i == epos ->
|
||||
w & rbOptions . opAllocateEquipment
|
||||
.~ RemoveEquipment
|
||||
{ _allocOldPos = epos
|
||||
}
|
||||
Just epos
|
||||
| isJust (you w ^? crEquipment . ix (es !! i)) ->
|
||||
w & rbOptions . opAllocateEquipment
|
||||
.~ SwapEquipment
|
||||
{ _allocOldPos = epos
|
||||
, _allocNewPos = es !! i
|
||||
, _allocSwapID = _crEquipment (you w) M.! (es !! i)
|
||||
}
|
||||
Just epos ->
|
||||
w & rbOptions . opAllocateEquipment
|
||||
.~ MoveEquipment
|
||||
{ _allocOldPos = epos
|
||||
, _allocNewPos = es !! i
|
||||
}
|
||||
Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment
|
||||
{_allocOldPos = epos
|
||||
,_allocNewPos = es !! i
|
||||
Nothing
|
||||
| isJust (you w ^? crEquipment . ix (es !! i)) ->
|
||||
w & rbOptions . opAllocateEquipment
|
||||
.~ ReplaceEquipment
|
||||
{ _allocNewPos = es !! i
|
||||
, _allocRemoveID = _crEquipment (you w) M.! (es !! i)
|
||||
}
|
||||
Nothing ->
|
||||
w & rbOptions . opAllocateEquipment
|
||||
.~ PutOnEquipment
|
||||
{ _allocNewPos = es !! i
|
||||
}
|
||||
Nothing | isJust (you w ^? crEquipment . ix (es !! i))
|
||||
-> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment
|
||||
{_allocNewPos = es !! i
|
||||
,_allocRemoveID = _crEquipment (you w) M.! (es !! i)
|
||||
}
|
||||
Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment
|
||||
{_allocNewPos = es !! i}
|
||||
_ -> w
|
||||
|
||||
-- where
|
||||
-- curpos = invSelPos w
|
||||
|
||||
setEquipActivation :: World -> World
|
||||
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
|
||||
Just DoNotMoveEquipment -> w
|
||||
Just RemoveEquipment { }
|
||||
-> case _crLeftInvSel (you w) of
|
||||
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment
|
||||
{_deactivateEquipment = i}
|
||||
Just RemoveEquipment{} ->
|
||||
case _crLeftInvSel (you w) of
|
||||
Just i
|
||||
| i == invsel ->
|
||||
w & rbOptions . opActivateEquipment
|
||||
.~ DeactivateEquipment
|
||||
{ _deactivateEquipment = i
|
||||
}
|
||||
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||
Just rbos
|
||||
-> case _crLeftInvSel (you w) of
|
||||
Just rbos ->
|
||||
case _crLeftInvSel (you w) of
|
||||
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||
Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
|
||||
{_activateEquipment = invsel,_deactivateEquipment = i}
|
||||
Just i | Just i == rbos ^? allocRemoveID
|
||||
-> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
|
||||
Just i
|
||||
| invselcanactivate ->
|
||||
w & rbOptions . opActivateEquipment
|
||||
.~ ActivateDeactivateEquipment
|
||||
{ _activateEquipment = invsel
|
||||
, _deactivateEquipment = i
|
||||
}
|
||||
Just i
|
||||
| Just i == rbos ^? allocRemoveID ->
|
||||
w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
|
||||
Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||
Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment
|
||||
{_activateEquipment = invsel}
|
||||
Nothing
|
||||
| invselcanactivate ->
|
||||
w & rbOptions . opActivateEquipment
|
||||
.~ ActivateEquipment
|
||||
{ _activateEquipment = invsel
|
||||
}
|
||||
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||
where
|
||||
invsel = crSel (you w)
|
||||
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)
|
||||
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . leftUse)
|
||||
|
||||
equipSiteToPositions :: EquipSite -> [EquipPosition]
|
||||
equipSiteToPositions es = case es of
|
||||
GoesOnHead -> [OnHead]
|
||||
GoesOnChest -> [OnChest]
|
||||
GoesOnBack -> [OnBack]
|
||||
GoesOnWrist -> [OnLeftWrist,OnRightWrist]
|
||||
GoesOnLegs -> [OnLegs]
|
||||
GoesOnHead -> [OnHead]
|
||||
GoesOnChest -> [OnChest]
|
||||
GoesOnBack -> [OnBack]
|
||||
GoesOnWrist -> [OnLeftWrist, OnRightWrist]
|
||||
GoesOnLegs -> [OnLegs]
|
||||
GoesOnSpecial -> [OnSpecial]
|
||||
|
||||
|
||||
closeObjScrollDir :: Float -> World -> World
|
||||
closeObjScrollDir x
|
||||
closeObjScrollDir x
|
||||
| x > 0 = over (cWorld . closeObjects) rotU
|
||||
| x < 0 = over (cWorld . closeObjects) rotD
|
||||
| otherwise = id
|
||||
|
||||
changeInvSel :: Int -> World -> World
|
||||
changeInvSel i w
|
||||
| n == 0 = w
|
||||
| yourInvSel w < n = w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
||||
| otherwise = w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n))
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
||||
changeInvSel i w
|
||||
| n == 0 = w
|
||||
| yourInvSel w < n =
|
||||
w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
||||
| otherwise =
|
||||
w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n))
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
||||
where
|
||||
-- arguably this should jump the invpos into the inventory proper
|
||||
where
|
||||
|
||||
n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w)
|
||||
numCO = length $ _closeObjects (_cWorld w)
|
||||
|
||||
changeSwapInvSel :: Int -> World -> World
|
||||
changeSwapInvSel k w
|
||||
| n == 0 = w
|
||||
| yourInvSel w < n = w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature
|
||||
| otherwise = w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico'
|
||||
& cWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
|
||||
where
|
||||
updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi )
|
||||
. (crLeftInvSel . _Just %~ updateLeftInvSel)
|
||||
. (crInvSel . iselPos %~ (`mod` n) . subtract k)
|
||||
. (crInvEquipped %~ IM.safeSwapKeys i swapi)
|
||||
. swapSite i swapi
|
||||
. swapSite swapi i
|
||||
changeSwapInvSel k w
|
||||
| n == 0 = w
|
||||
| yourInvSel w < n =
|
||||
w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature
|
||||
| otherwise =
|
||||
w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico'
|
||||
& cWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
|
||||
where
|
||||
updatecreature =
|
||||
(crInv %~ IM.safeSwapKeys (i `mod` n) swapi)
|
||||
. (crLeftInvSel . _Just %~ updateLeftInvSel)
|
||||
. (crInvSel . iselPos %~ (`mod` n) . subtract k)
|
||||
. (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
|
||||
updateLeftInvSel li
|
||||
| i == li = swapi
|
||||
| swapi == li = i
|
||||
| otherwise = li
|
||||
i = crSel cr
|
||||
ico' = ( (i - (k+n)) `mod` numCO ) + n
|
||||
ico' = ((i - (k + n)) `mod` numCO) + n
|
||||
n = length $ _crInv cr
|
||||
numCO = length $ _closeObjects (_cWorld w)
|
||||
|
||||
changeAugInvSel :: Int -> World -> World
|
||||
changeAugInvSel i w
|
||||
| n == 0 = w
|
||||
| otherwise = w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
||||
where
|
||||
changeAugInvSel i w
|
||||
| n == 0 = w
|
||||
| otherwise =
|
||||
w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
||||
where
|
||||
n = length (yourInv w) + length (_closeObjects (_cWorld w))
|
||||
|
||||
bestCloseObjectIndex :: World -> Maybe Int
|
||||
@@ -337,7 +380,7 @@ bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w)
|
||||
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
|
||||
ycr = you w
|
||||
|
||||
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
|
||||
selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button)
|
||||
selectedCloseObject w
|
||||
| invsel >= length inv = selectNthCloseObject w (invsel - length inv)
|
||||
| otherwise = selectNthCloseObject w =<< bestCloseObjectIndex w
|
||||
@@ -346,5 +389,5 @@ selectedCloseObject w
|
||||
cr = you w
|
||||
inv = _crInv cr
|
||||
|
||||
selectNthCloseObject :: World -> Int -> Maybe (Int,Either FloorItem Button)
|
||||
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
|
||||
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n)
|
||||
|
||||
Reference in New Issue
Block a user