Cleanup

src/Dodge/Inventory/RBList.hs

@@ -1,14 +1,15 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.Inventory.RBList (
     updateRBList,
-    getEquipmentAllocation,
-    eqSiteToPositions,
+    equipmentDesignation,
+    eqTypeToSites,
 ) where
 
 import NewInt
 import qualified Data.IntMap.Strict as IM
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.EquipType
-import Control.Applicative
+--import Control.Applicative
 import Control.Lens
 import Data.List (elemIndex, findIndex)
 import qualified Data.Map.Strict as M
@@ -23,14 +24,14 @@ updateRBList w = case w ^. rbOptions of
     EquipOptions{} -> w
     _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
         i <- cr ^? crManipulation . manObject . imSelectedItem
-        esite <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
-        return $
-            w & rbOptions
-                .~ EquipOptions
-                    { _opSel = chooseEquipPosition (w ^. cWorld . lWorld . items) cr (eqSiteToPositions esite)
-                    }
+        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))
   where
-    norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
+    --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
@@ -47,14 +48,17 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
   where
     hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
 
-getEquipmentAllocation :: NewInt InvInt -> World -> EquipmentAllocation
-getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
+equipmentDesignation :: NewInt InvInt -> World -> EquipmentAllocation
+equipmentDesignation invid w = fromMaybe DoNotMoveEquipment $ do
     itid <- you w ^? crInv . ix invid
-    esite <- w ^? cWorld . lWorld . items . ix itid >>= equipType
+    etype <- w ^? cWorld . lWorld . items . ix itid >>= equipType
+    let mesite = w ^? cWorld . lWorld . items . ix itid . itLocation . ilEquipSite . _Just
     i <- w ^? rbOptions . opSel
-            <|> Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions esite))
-    es <- eqSiteToPositions esite ^? ix i
-    return $ case you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
+--            <|> (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
             | es == epos -> RemoveEquipment{_allocOldPos = epos}
         Just epos
@@ -76,10 +80,9 @@ getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
                     , _allocRemoveID = _crEquipment (you w) M.! es
                     }
         Nothing -> PutOnEquipment{_allocNewPos = es}
-  where
 
-eqSiteToPositions :: EquipType -> [EquipSite]
-eqSiteToPositions es = case es of
+eqTypeToSites :: EquipType -> [EquipSite]
+eqTypeToSites es = case es of
     GoesOnHead -> [OnHead]
     GoesOnChest -> [OnChest]
     GoesOnBack -> [OnBack]