From 0e450f7bc75969b671aa9172e500a7746bfedb5c Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 15 May 2023 11:06:28 +0100 Subject: [PATCH] Add file --- src/Dodge/Inventory/RBList.hs | 80 +++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 src/Dodge/Inventory/RBList.hs diff --git a/src/Dodge/Inventory/RBList.hs b/src/Dodge/Inventory/RBList.hs new file mode 100644 index 000000000..cf0b7d0ee --- /dev/null +++ b/src/Dodge/Inventory/RBList.hs @@ -0,0 +1,80 @@ +module Dodge.Inventory.RBList ( + updateRBList, + getEquipmentAllocation, +) where + +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 + | not (SDL.ButtonRight `M.member` (w ^. input . mouseButtons)) = + w & rbOptions .~ NoRightButtonOptions + | otherwise = case w ^. rbOptions of + EquipOptions{} -> w & rbOptions . opAllocateEquipment .~ (getEquipmentAllocation w) + _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do + i <- cr ^? crManipulation . manObject . inInventory . ispItem + esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite + return $ + w + & rbOptions + .~ EquipOptions + { _opEquip = equipSiteToPositions esite + , _opSel = chooseEquipmentPosition cr (equipSiteToPositions esite) + , _opAllocateEquipment = DoNotMoveEquipment + } + & rbOptions . opAllocateEquipment .~ (getEquipmentAllocation w) + where + cr = you w + +getEquipmentAllocation :: World -> EquipmentAllocation +getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do + curpos <- you w ^? crManipulation . manObject . inInventory . ispItem + i <- w ^? rbOptions . opSel + es <- w ^? rbOptions . opEquip . ix i + return $ case you w ^? crInvEquipped . ix curpos 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} + +equipSiteToPositions :: EquipSite -> [EquipPosition] +equipSiteToPositions es = case es of + GoesOnHead -> [OnHead] + GoesOnChest -> [OnChest] + GoesOnBack -> [OnBack] + GoesOnWrist -> [OnLeftWrist, OnRightWrist] + GoesOnLegs -> [OnLegs] + +chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int +chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do + i <- cr ^? crManipulation . manObject . inInventory . ispItem + ep <- cr ^? crInvEquipped . ix i + elemIndex ep eps + +chooseFreeSite :: Creature -> [EquipPosition] -> Int +chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment + where + hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep