84 lines
3.0 KiB
Haskell
84 lines
3.0 KiB
Haskell
module Dodge.Inventory.RBList (
|
|
updateRBList,
|
|
getEquipmentAllocation,
|
|
eqSiteToPositions,
|
|
) where
|
|
|
|
import Dodge.Data.Equipment.Misc
|
|
import Dodge.Data.EquipType
|
|
import Control.Applicative
|
|
import Control.Lens
|
|
import Data.List (elemIndex, findIndex)
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Dodge.Base.You
|
|
import Dodge.Data.World
|
|
import qualified SDL
|
|
|
|
updateRBList :: World -> World
|
|
updateRBList w = case w ^. rbOptions of
|
|
_ | norightclick -> w & rbOptions .~ NoRightButtonOptions
|
|
EquipOptions{} -> w
|
|
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
esite <- cr ^? crInv . ix i >>= equipType -- . itUse . uequipEffect . eeType
|
|
return $
|
|
w & rbOptions
|
|
.~ EquipOptions
|
|
{ _opSel = chooseEquipPosition cr (eqSiteToPositions esite)
|
|
}
|
|
where
|
|
norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
|
|
cr = you w
|
|
|
|
-- want to choose the current position if the item is equipped, otherwise try to
|
|
-- find a free equipment slot
|
|
chooseEquipPosition :: Creature -> [EquipSite] -> Int
|
|
chooseEquipPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
ep <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
|
|
elemIndex ep eps
|
|
|
|
chooseFreeSite :: Creature -> [EquipSite] -> Int
|
|
chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
|
|
where
|
|
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
|
|
|
|
getEquipmentAllocation :: Int -> World -> EquipmentAllocation
|
|
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
|
|
esite <- you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType
|
|
i <-
|
|
w ^? rbOptions . opSel
|
|
<|> Just (chooseEquipPosition (you w) (eqSiteToPositions esite))
|
|
es <- eqSiteToPositions esite ^? ix i
|
|
return $ case you w ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
|
|
Just epos
|
|
| es == epos -> RemoveEquipment{_allocOldPos = epos}
|
|
Just epos
|
|
| isJust (you w ^? crEquipment . ix es) ->
|
|
SwapEquipment
|
|
{ _allocOldPos = epos
|
|
, _allocNewPos = es
|
|
, _allocSwapID = _crEquipment (you w) M.! es
|
|
}
|
|
Just epos ->
|
|
MoveEquipment
|
|
{ _allocOldPos = epos
|
|
, _allocNewPos = es
|
|
}
|
|
Nothing
|
|
| isJust (you w ^? crEquipment . ix es) ->
|
|
ReplaceEquipment
|
|
{ _allocNewPos = es
|
|
, _allocRemoveID = _crEquipment (you w) M.! es
|
|
}
|
|
Nothing -> PutOnEquipment{_allocNewPos = es}
|
|
|
|
eqSiteToPositions :: EquipType -> [EquipSite]
|
|
eqSiteToPositions es = case es of
|
|
GoesOnHead -> [OnHead]
|
|
GoesOnChest -> [OnChest]
|
|
GoesOnBack -> [OnBack]
|
|
GoesOnWrist -> [OnLeftWrist, OnRightWrist]
|
|
GoesOnLegs -> [OnLegs]
|