Refactor

src/Dodge/DisplayInventory.hs

@@ -70,7 +70,7 @@ updateCombineSections w cfig =
 
 regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
 regexCombs inv ci = \case
-    '<' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
+    '#' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
     str -> (regexList str . _siPictures) ci
   where
     g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i)

src/Dodge/Update/Input/InGame.hs

@@ -5,7 +5,6 @@ module Dodge.Update.Input.InGame (
     updateMouseInGame,
 ) where
 
-import Dodge.Item.Display
 import Control.Applicative
 import Control.Monad
 import Data.Foldable
@@ -23,6 +22,7 @@ import Dodge.DisplayInventory
 import Dodge.Event.Test
 import Dodge.Inventory
 import Dodge.Inventory.Add
+import Dodge.Item.Display
 import Dodge.Item.InvSize
 import Dodge.ListDisplayParams
 import Dodge.Menu
@@ -41,7 +41,6 @@ import SDL
 
 updateUseInputInGame :: Universe -> Universe
 updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
-    --    DisplayCarte -> over uvWorld updatePressedButtonsCarte u
     DisplayInventory{_subInventory = si, _diSelection = disel} -> case si of
         DisplayTerminal tmid -> updateKeysInTerminal tmid u
         CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
@@ -197,11 +196,10 @@ updateMouseClickInGame :: Configuration -> World -> World
 updateMouseClickInGame cfig w = case w ^. input . mouseContext of
     MouseInGame -> fromMaybe w $ do
         sss <- w ^? hud . hudElement . diSections
-        ysel <- inverseSelSecYint (posSelSecYint cfig invDP (mpos ^. _y)) sss
+        ysel <- inverseSelSecYint 
+            (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss
         guard (isGroupSelectableSection $ fst ysel)
-        return $
-            w & input . mouseContext
-                .~ OverInvDragSelect ysel Nothing
+        return $ w & input . mouseContext .~ OverInvDragSelect ysel Nothing
     OverInvSelect (-1, _)
         | selsec == Just (-1) ->
             w
@@ -212,14 +210,13 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
             w
                 & hud . hudElement . diSelection %~ endRegex 2 w
                 & hud . hudElement . diCloseFilter .~ Nothing
-    OverInvSelect x | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
-        fromMaybe w $ do
-            guard (isGroupSelectableSection $ fst x)
-            return $ w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
+    OverInvSelect x
+        | ScancodeLShift `M.member` (w ^. input . pressedKeys)
+            && (isGroupSelectableSection $ fst x) ->
+            w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
     OverInvSelect x -> startDrag x cfig w
     OverTerminalReturn tmid -> terminalReturnEffect tmid w
-    OverTerminalEscape ->
-        w & hud . hudElement . subInventory .~ NoSubInventory
+    OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory
     OverCombSelect x ->
         w & hud . hudElement . subInventory . ciSelection ?~ f x
             & worldEventFlags . at CombineInventoryChange ?~ ()
@@ -237,23 +234,18 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
         w
             & worldEventFlags . at InventoryChange ?~ ()
             & hud . hudElement . subInventory .~ NoSubInventory
-    OverCombFiltInv (i, j) -> fromMaybe w $ do
-        guard $ i == 0
+    OverCombFiltInv (0, j) -> fromMaybe w $ do
         str <-
             fmap (take 5) $
                 w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j
                     >>= (listToMaybe . basicItemDisplay)
---                    ^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
         return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
             case w ^? hud . hudElement . subInventory . ciFilter . _Just of
-                Just (_ : xs)
-                    | str == xs ->
-                        w
-                            & hud . hudElement . subInventory . ciFilter .~ Nothing
-                _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str)
+                Just ('#' : xs) | str == xs ->
+                        w & hud . hudElement . subInventory . ciFilter .~ Nothing
+                _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str)
     _ -> w
   where
-    mpos = w ^. input . mousePos
     f (x, y) = (x, y, mempty)
     selsec = w ^? hud . hudElement . diSelection . _Just . _1
 
@@ -283,21 +275,37 @@ endCombineRegex w = fromMaybe id $ do
     return $ ssSetCursor (ssLookupDown 0 j) sss
 
 startDrag :: (Int, Int) -> Configuration -> World -> World
-startDrag (a, b) cfig w = setcontext
-    . fromMaybe (augInvDirectSelect (a, b, IS.singleton b) w)
-    $ do
-        (i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
-        guard $ i == a && b `IS.member` xs
-        return w
+startDrag (a, b) cfig w = setcontext 
+    $ case w ^? hud . hudElement . diSelection . _Just of
+        Just (i,_,xs) | i == a && b `IS.member` xs -> w
+        _ -> augInvDirectSelect (a, b, IS.singleton b) w
   where
     setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath
-    above = do
-        sss <- w ^? hud . hudElement . diSections
-        inverseSelSecYint (yint - 1) sss
-    bneath = do
-        sss <- w ^? hud . hudElement . diSections
-        inverseSelSecYint (yint + 1) sss
+    above = inverseSelSecYint (yint - 1) =<< w ^? hud . hudElement . diSections
+    bneath = inverseSelSecYint (yint + 1) =<< w ^? hud . hudElement . diSections
+    --above = do
+    --    sss <- w ^? hud . hudElement . diSections
+    --    inverseSelSecYint (yint - 1) sss
+    --bneath = do
+    --    sss <- w ^? hud . hudElement . diSections
+    --    inverseSelSecYint (yint + 1) sss
     yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
+--startDrag :: (Int, Int) -> Configuration -> World -> World
+--startDrag (a, b) cfig w = setcontext
+--    . fromMaybe (augInvDirectSelect (a, b, IS.singleton b) w)
+--    $ do
+--        (i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
+--        guard $ i == a && b `IS.member` xs
+--        return w
+--  where
+--    setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath
+--    above = do
+--        sss <- w ^? hud . hudElement . diSections
+--        inverseSelSecYint (yint - 1) sss
+--    bneath = do
+--        sss <- w ^? hud . hudElement . diSections
+--        inverseSelSecYint (yint + 1) sss
+--    yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
 
 concurrentIS :: IS.IntSet -> Bool
 concurrentIS = go . IS.minView
@@ -447,7 +455,6 @@ updateInitialPressInGame uv sc = case sc of
     ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
     _ -> uv
 
-
 updateLongPressInGame :: Universe -> Scancode -> Universe
 updateLongPressInGame uv sc = case sc of
     ScancodeF -> over uvWorld youDropItem uv