diff --git a/src/Dodge/Data/RightButtonOptions.hs b/src/Dodge/Data/RightButtonOptions.hs index d1f3afce9..d4c127dd1 100644 --- a/src/Dodge/Data/RightButtonOptions.hs +++ b/src/Dodge/Data/RightButtonOptions.hs @@ -12,8 +12,8 @@ import Data.Aeson import Data.Aeson.TH import Dodge.Data.Equipment.Misc -data RightButtonOptions - = NoRightButtonOptions +data RightButtonState + = NoRightButtonState | EquipOptions { _opSel :: Int } --deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -40,7 +40,7 @@ data EquipmentAllocation } --deriving (Eq, Ord, Show, Read) --Generic, Flat) -makeLenses ''RightButtonOptions +makeLenses ''RightButtonState makeLenses ''EquipmentAllocation deriveJSON defaultOptions ''EquipmentAllocation -deriveJSON defaultOptions ''RightButtonOptions +deriveJSON defaultOptions ''RightButtonState diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 21a03559c..c9e30b142 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -41,7 +41,7 @@ data World = World , _playingSounds :: M.Map SoundOrigin Sound , _input :: Input , _testFloat :: Float - , _rbOptions :: RightButtonOptions + , _rbState :: RightButtonState , _hud :: HUD , _worldEventFlags :: Set WorldEventFlag , _crZoning :: IntMap (IntMap IntSet) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 2370da86f..e3e25df79 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -40,7 +40,7 @@ defaultWorld = , _playingSounds = M.empty , _randGen = mkStdGen 2 , _testFloat = 0 - , _rbOptions = NoRightButtonOptions + , _rbState = NoRightButtonState , _hud = defaultHUD , _worldEventFlags = mempty , _crZoning = mempty diff --git a/src/Dodge/Inventory/RBList.hs b/src/Dodge/Inventory/RBList.hs index 5f81f5297..d8131e4dc 100644 --- a/src/Dodge/Inventory/RBList.hs +++ b/src/Dodge/Inventory/RBList.hs @@ -6,7 +6,7 @@ module Dodge.Inventory.RBList ( ) where import NewInt -import qualified Data.IntMap.Strict as IM +--import qualified Data.IntMap.Strict as IM import Dodge.Data.Equipment.Misc import Dodge.Data.EquipType --import Control.Applicative @@ -19,16 +19,16 @@ import Dodge.Data.World import qualified SDL updateRBList :: World -> World -updateRBList w = case w ^. rbOptions of - _ | norightclick -> w & rbOptions .~ NoRightButtonOptions +updateRBList w = case w ^. rbState of + _ | norightclick -> w & rbState .~ NoRightButtonState EquipOptions{} -> w - _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do + _ -> fromMaybe (w & rbState .~ NoRightButtonState) $ do i <- cr ^? crManipulation . manObject . imSelectedItem itid <- cr ^? crInv . ix i - etype <- w ^? cWorld . lWorld . items . ix itid >>= equipType - return $ w & rbOptions - .~ EquipOptions - (chooseEquipPosition (w ^. cWorld . lWorld . items) cr (eqTypeToSites etype)) + 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 @@ -36,33 +36,26 @@ updateRBList w = case w ^. rbOptions of -- want to choose the current position if the item is equipped, otherwise try to -- find a free equipment slot -chooseEquipPosition :: IM.IntMap Item -> Creature -> [EquipSite] -> Int -chooseEquipPosition m cr eps = fromMaybe (chooseFreeSite cr eps) $ do - i <- cr ^? crManipulation . manObject . imSelectedItem - itid <- cr ^? crInv . ix i - ep <- m ^? ix itid . itLocation . ilEquipSite . _Just +chooseEquipPosition :: Item -> Creature -> [EquipSite] -> Int +chooseEquipPosition itm cr eps = fromMaybe (chooseFreeSite cr eps) $ do + ep <- itm ^? itLocation . ilEquipSite . _Just elemIndex ep eps chooseFreeSite :: Creature -> [EquipSite] -> Int chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment where - hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep + 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 ^? rbOptions . opSel --- <|> (uncurry elemIndex =<< (mesite <&> (,eqSiteToPositions etype))) --- <|> Just (chooseFreeSite (you w) (eqSiteToPositions etype)) ----- <|> Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions etype)) + i <- w ^? rbState . opSel es <- eqTypeToSites etype ^? ix i return $ case mesite of - Just epos - | es == epos -> RemoveEquipment{_allocOldPos = epos} - Just epos - | isJust (you w ^? crEquipment . ix es) -> + Just epos | es == epos -> RemoveEquipment{_allocOldPos = epos} + Just epos | isJust (you w ^? crEquipment . ix es) -> SwapEquipment { _allocOldPos = epos , _allocNewPos = es diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index d41324d61..4cbd5ace1 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -252,7 +252,7 @@ drawRBOptions cfig w = fold $ do eslist <- fmap eqTypeToSites $ w ^? cWorld . lWorld . items . ix itid >>= equipType - i <- w ^? rbOptions . opSel + i <- w ^? rbState . opSel let ae = equipmentDesignation invid w sss <- w ^? hud . diSections Sel i' j _ <- w ^? hud . diSelection . _Just diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 3e4e734bf..f96954e78 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -35,9 +35,9 @@ updateBaseWheelEvent :: Int -> World -> World updateBaseWheelEvent yi w -- | Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w | Just True <- w ^? cWorld . lWorld . lInvLock = w - | bdown ButtonRight = case _rbOptions w of - EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax - NoRightButtonOptions -> fromMaybe w (selectedItemScroll yi w) + | bdown ButtonRight = case _rbState w of + EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax + NoRightButtonState -> fromMaybe w (selectedItemScroll yi w) | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w | otherwise = scrollAugInvSel yi w