84 lines
3.0 KiB
Haskell
84 lines
3.0 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.Inventory.RBList (
|
|
updateRBList,
|
|
equipmentDesignation,
|
|
eqTypeToSites,
|
|
) where
|
|
|
|
--import qualified Data.IntMap.Strict as IM
|
|
|
|
--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.EquipType
|
|
import Dodge.Data.World
|
|
import NewInt
|
|
import qualified SDL
|
|
|
|
updateRBList :: World -> World
|
|
updateRBList w = case w ^. rbState of
|
|
_ | norightclick -> w & rbState .~ NoRightButtonState
|
|
EquipOptions{} -> w
|
|
_ -> fromMaybe (w & rbState .~ NoRightButtonState) $ do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
itid <- cr ^? crInv . ix i
|
|
itm <- w ^? cWorld . lWorld . items . ix itid
|
|
etype <- equipType itm
|
|
return $
|
|
w & rbState
|
|
.~ EquipOptions (chooseEquipPosition itm cr (eqTypeToSites etype))
|
|
where
|
|
--norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
|
|
norightclick = null $ w ^. input . mouseButtons . at SDL.ButtonRight
|
|
cr = you w
|
|
|
|
-- want to choose the current position if the item is equipped, otherwise try to
|
|
-- find a free equipment slot
|
|
chooseEquipPosition :: Item -> Creature -> [EquipSite] -> Int
|
|
chooseEquipPosition itm cr eps = fromMaybe (chooseFreeSite cr eps) $ do
|
|
ep <- itm ^? itLocation . ilEquipSite . _Just
|
|
elemIndex ep eps
|
|
-- (elemIndex <$> (itm ^? itLocation . ilEquipSite . _Just)) ?? eps
|
|
|
|
chooseFreeSite :: Creature -> [EquipSite] -> Int
|
|
chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
|
|
where
|
|
hasnoequipment es = isNothing $ cr ^? crEquipment . ix es
|
|
|
|
equipmentDesignation :: NewInt InvInt -> World -> EquipmentAllocation
|
|
equipmentDesignation invid w = fromMaybe DoNotMoveEquipment $ do
|
|
itid <- you w ^? crInv . ix invid
|
|
etype <- w ^? cWorld . lWorld . items . ix itid >>= equipType
|
|
let mesite = w ^? cWorld . lWorld . items . ix itid . itLocation . ilEquipSite . _Just
|
|
i <- w ^? rbState . opSel
|
|
new <- eqTypeToSites etype ^? ix i
|
|
return $ case mesite of
|
|
Just old | new == old -> RemoveEquipment{_allocOldPos = old}
|
|
Just old
|
|
| isJust (you w ^? crEquipment . ix new) ->
|
|
SwapEquipment
|
|
{ _allocOldPos = old
|
|
, _allocNewPos = new
|
|
, _allocSwapID = _crEquipment (you w) M.! new
|
|
}
|
|
Just old -> MoveEquipment{_allocOldPos = old, _allocNewPos = new}
|
|
Nothing
|
|
| isJust (you w ^? crEquipment . ix new) ->
|
|
ReplaceEquipment
|
|
{ _allocNewPos = new
|
|
, _allocRemoveID = _crEquipment (you w) M.! new
|
|
}
|
|
Nothing -> PutOnEquipment{_allocNewPos = new}
|
|
|
|
eqTypeToSites :: EquipType -> [EquipSite]
|
|
eqTypeToSites es = case es of
|
|
GoesOnHead -> [OnHead]
|
|
GoesOnChest -> [OnChest]
|
|
GoesOnBack -> [OnBack]
|
|
GoesOnWrist -> [OnLeftWrist, OnRightWrist]
|
|
GoesOnLeg -> [OnLeftLeg,OnRightLeg]
|