Cleanup

src/Dodge/Creature/Impulse/UseItem.hs

@@ -64,7 +64,7 @@ activateDetonator det = fromMaybe id $ do
     return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
 
 toggleEquipmentAt :: NewInt InvInt -> Creature -> World -> World
-toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
+toggleEquipmentAt invid cr w = case equipmentDesignation invid w of
     DoNotMoveEquipment -> w
     PutOnEquipment{_allocNewPos = newp} ->
         w

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]

src/Dodge/Render/HUD.hs

@@ -248,11 +248,12 @@ drawRBOptions :: Config -> World -> Picture
 drawRBOptions cfig w = fold $ do
     guard $ ButtonRight `M.member` _mouseButtons (_input w)
     invid <- you w ^? crManipulation . manObject . imSelectedItem
+    itid <- you w ^? crInv . ix invid
     eslist <-
-        fmap eqSiteToPositions $
-            you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
+        fmap eqTypeToSites $
+            w ^? cWorld . lWorld . items . ix itid >>= equipType
     i <- w ^? rbOptions . opSel
-    let ae = getEquipmentAllocation invid w
+    let ae = equipmentDesignation invid w
     sss <- w ^? hud . diSections
     Sel i' j _ <- w ^? hud . diSelection . _Just
     curpos <- selSecYint i' j sss

src/Dodge/Update/Scroll.hs

@@ -45,8 +45,8 @@ updateBaseWheelEvent yi w
     bdown b = w & has (input . mouseButtons . ix b)
     rbscrollmax = fromMaybe 1 $ do
         invid <- you w ^? crManipulation . manObject . imSelectedItem
-        esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
-        return . length $ eqSiteToPositions esite
+        etype <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType
+        return . length $ eqTypeToSites etype
 
 selectedItemScroll :: Int -> World -> Maybe World
 selectedItemScroll yi w = do