Cleanup various equipment/right button code

src/Dodge/Data/RightButtonOptions.hs

@@ -12,8 +12,8 @@ import Data.Aeson
 import Data.Aeson.TH
 import Dodge.Data.Equipment.Misc
 
-data RightButtonOptions
+data RightButtonState
-    = NoRightButtonOptions
+    = 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

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)

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

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
+updateRBList w = case w ^. rbState of
-    _ | norightclick -> w & rbOptions .~ NoRightButtonOptions
+    _ | 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
+        itm <- w ^? cWorld . lWorld . items . ix itid
-        return $ w & rbOptions
+        etype <- equipType itm
-         .~ EquipOptions 
+        return $ w & rbState
-            (chooseEquipPosition (w ^. cWorld . lWorld . items) cr (eqTypeToSites etype))
+         .~ 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 :: Item -> Creature -> [EquipSite] -> Int
-chooseEquipPosition m cr eps = fromMaybe (chooseFreeSite cr eps) $ do
+chooseEquipPosition itm cr eps = fromMaybe (chooseFreeSite cr eps) $ do
-    i <- cr ^? crManipulation . manObject . imSelectedItem
+    ep <- itm ^? itLocation . ilEquipSite . _Just
-    itid <- cr ^? crInv . ix i
-    ep <- m ^? ix itid . 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
+    i <- w ^? rbState . opSel
---            <|> (uncurry elemIndex =<< (mesite <&> (,eqSiteToPositions etype)))
---            <|>  Just (chooseFreeSite (you w) (eqSiteToPositions etype))
-----            <|>  Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions etype))
     es <- eqTypeToSites etype ^? ix i
     return $ case mesite of
-        Just epos
+        Just epos | es == epos -> RemoveEquipment{_allocOldPos = epos}
-            | es == epos -> RemoveEquipment{_allocOldPos = epos}
+        Just epos | isJust (you w ^? crEquipment . ix es) ->
-        Just epos
-            | isJust (you w ^? crEquipment . ix es) ->
                 SwapEquipment
                     { _allocOldPos = epos
                     , _allocNewPos = es

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

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
+    | bdown ButtonRight = case _rbState w of
-        EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
+        EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax
-        NoRightButtonOptions -> fromMaybe w (selectedItemScroll yi w)
+        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