Cleanup

2024-11-20 17:24:05 +00:00
parent a05511f6d8
commit b750fe4186
6 changed files with 200 additions and 229 deletions
@@ -23,8 +23,6 @@ data MouseContext
    | MouseMenuClick {_mcoMenuClick :: Int}
    | MouseMenuCursor
    | OverInvDrag {_mcoDragPos :: Maybe Int}
-    | OverInvFiltDrag
-    | OverInvFiltDragDrop
    | OverInvDragSelect { _mcoSelStart :: (Int,Int), _mcoSelEnd :: Maybe (Int,Int) }
    | OverInvSelect { _mcoInvSelect :: (Int,Int)}
    | OverInvFilt { _mcoInvFilt :: (Int,Int)}
@@ -86,8 +86,6 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
    MouseInGame -> drawPlus 5
    OverInvDrag (Just _) -> drawDrag 5
    OverInvDrag Nothing -> drawDragDrop 5
-    OverInvFiltDrag -> drawFiltDrag 5
-    OverInvFiltDragDrop -> drawFiltDragDrop 5
    OverInvDragSelect {} -> drawDragSelect 5
    OverInvSelect {} -> drawSelect 5
    OverInvFilt {} -> drawCombFilter 5
@@ -177,26 +175,15 @@ drawDragDrop x =
    z = 1.5 * x
    y = 0.7 * x

-drawFiltDrag :: Float -> Picture
-drawFiltDrag x = polygonWire
-    [ V2 0 y
-    , V2 x y
-    , V2 0 (-y)
-    , V2 (-x) (-y)
-    ]
-  where
-    y = 0.5 * x
-
-drawFiltDragDrop :: Float -> Picture
-drawFiltDragDrop x = polygonWire
-    [ V2 0 y
-    , V2 x y
-    , V2 0 (-y)
-    , V2 (-x) (-y)
-    ] <> line [V2 (-x) x,V2 0 x,V2 0 (-x)]
-    <> line [V2 (-y) (y-x), V2 0 (-x), V2 y (y-x)]
-  where
-    y = 0.5 * x
+--drawFiltDrag :: Float -> Picture
+--drawFiltDrag x = polygonWire
+--    [ V2 0 y
+--    , V2 x y
+--    , V2 0 (-y)
+--    , V2 (-x) (-y)
+--    ]
+--  where
+--    y = 0.5 * x

 drawSelect :: Float -> Picture
 drawSelect x = polygonWire $ rectWH (0.5 * x) (0.5 * x)
@@ -306,8 +306,6 @@ checkTermDist w = fromMaybe w $ do

 updateMouseContext :: Configuration -> Universe -> Universe
 updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
-    OverInvFiltDrag -> u & uvWorld . input . mouseContext .~ invfiltdrag
-    OverInvFiltDragDrop -> u & uvWorld . input . mouseContext .~ invfiltdrag
    OverInvDrag {} -> u & uvWorld . input . mouseContext .~ invdrag
    OverInvDragSelect{} -> u
    _ -> u & uvWorld . input . mouseContext
@@ -341,10 +339,6 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
        sss <- w ^? hud . hudElement . diSections
        (0,j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
        return $ OverInvDrag $ Just j
-    invfiltdrag = fromMaybe OverInvFiltDragDrop $ do
-        sss <- w ^? hud . hudElement . diSections
-        (0,_) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
-        return $ OverInvFiltDrag
    overinv = do
        sss <- w ^? hud . hudElement . diSections
        selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
@@ -359,7 +353,7 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
        let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
        return $ case mpossel of
            Nothing -> OverCombEscape
-            Just (-1, _) -> OverCombFilter
+            Just (-1, i) | (-1,i) == msel -> OverCombFilter
            Just x | x == msel -> OverCombCombine x
            Just x -> OverCombSelect x
    overterm = do
@@ -3,11 +3,10 @@ module Dodge.Update.Input.InGame (
    updateMouseInGame,
 ) where

-import qualified Data.IntSet as IS
-import Dodge.ListDisplayParams
 import Control.Applicative
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
 import Data.List (sort)
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -23,6 +22,7 @@ import Dodge.Event.Test
 import Dodge.InputFocus
 import Dodge.Inventory
 import Dodge.Inventory.Add
+import Dodge.ListDisplayParams
 import Dodge.Menu
 import Dodge.Save
 import Dodge.SelectionSections
@@ -99,10 +99,10 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
        let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
        return $ w & input . mouseContext . mcoSelEnd .~ msel
    OverInvDrag Nothing -> w
-    OverInvDrag {} -> fromMaybe w $ do
+    OverInvDrag{} -> fromMaybe w $ do
        sss <- w ^? hud . hudElement . diSections
        let mpos = w ^. input . mousePos
-        (0,i) <- w ^? hud . hudElement . diSelection . _Just
+        (0, i) <- w ^? hud . hudElement . diSelection . _Just
        x <- w ^? hud . hudElement . diSelectionExtra
        return $ w & dragInvItems (IS.insert i x) cfig mpos ldp sss
    _ -> w
@@ -112,49 +112,50 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
 dropSelected :: World -> World
 dropSelected w = fromMaybe w $ do
    cr <- w ^? cWorld . lWorld . creatures . ix 0
-    (0,j) <- w ^? hud . hudElement . diSelection . _Just
+    (0, j) <- w ^? hud . hudElement . diSelection . _Just
    xs <- w ^? hud . hudElement . diSelectionExtra
    return $ IS.foldr (dropItem cr) w (IS.insert j xs)

 updateMouseReleaseInGame :: World -> World
-updateMouseReleaseInGame w = case w ^. input . mouseContext of 
-    OverInvFiltDrag -> w & input . mouseContext .~ MouseInGame
-    OverInvFiltDragDrop -> w & input . mouseContext .~ MouseInGame
+updateMouseReleaseInGame w = case w ^. input . mouseContext of
    OverInvDrag mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
-            j <- mpos
-            return $ w & input . mouseContext .~ OverInvSelect (0,j)
+        j <- mpos
+        return $ w & input . mouseContext .~ OverInvSelect (0, j)
    OverInvDragSelect _ Nothing ->
-            w & input . mouseContext .~ MouseInGame
-                & hud . hudElement . diSelectionExtra .~ mempty
+        w & input . mouseContext .~ MouseInGame
+            & hud . hudElement . diSelectionExtra .~ mempty
    OverInvDragSelect ssel (Just esel) ->
-            w & input . mouseContext .~ MouseInGame
-                & hud . hudElement . diSelectionExtra
-                    .~ IS.fromAscList [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
-                & augInvDirectSelect (min ssel esel)
+        w & input . mouseContext .~ MouseInGame
+            & hud . hudElement . diSelectionExtra
+                .~ IS.fromAscList [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
+            & augInvDirectSelect (min ssel esel)
    _ -> w

 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 ldp (mpos ^. _y)) sss
-            return $
-                w & input . mouseContext
-                    .~ OverInvDragSelect ysel Nothing
+        sss <- w ^? hud . hudElement . diSections
+        ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
+        return $
+            w & input . mouseContext
+                .~ OverInvDragSelect ysel Nothing
    OverInvSelect x -> startDrag x w
    OverTerminalReturn tmid -> terminalReturnEffect tmid w
-    OverTerminalEscape -> w 
-        & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
+    OverTerminalEscape ->
+        w
+            & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
    OverCombSelect x ->
        w & hud . hudElement . subInventory . ciSelection ?~ x
            & worldEventFlags . at CombineInventoryChange ?~ ()
    OverCombFilter ->
        w & hud . hudElement . subInventory . ciFilter .~ Nothing
            & worldEventFlags . at CombineInventoryChange ?~ ()
-    OverCombCombine (i, j) ->
-        (worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
-            tryCombine (i, j) w
-                & worldEventFlags . at CombineInventoryChange ?~ ()
+    OverCombCombine x ->
+        w
+            & tryCombine x
+            & worldEventFlags . at CombineInventoryChange ?~ ()
+            & worldEventFlags . at InventoryChange ?~ ()
+            & maybeExitCombine
    OverCombEscape ->
        w
            & worldEventFlags . at InventoryChange ?~ ()
@@ -178,13 +179,11 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
    mpos = w ^. input . mousePos

 startDrag :: (Int, Int) -> World -> World
-startDrag (a, b) w = case w ^? hud . hudElement . diInvFilter . _Just of
-    Just {} -> w & input . mouseContext .~ OverInvFiltDrag
-    _ -> fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
-        (i, j) <- w ^? hud . hudElement . diSelection . _Just
-        xs <- w ^? hud . hudElement . diSelectionExtra
-        guard $ i == a && b `IS.member` (IS.insert j xs)
-        return $ setmichosen xs w
+startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
+    (i, j) <- w ^? hud . hudElement . diSelection . _Just
+    xs <- w ^? hud . hudElement . diSelectionExtra
+    guard $ i == a && b `IS.member` (IS.insert j xs)
+    return $ setmichosen xs w
  where
    setmichosen x =
        (input . mouseContext .~ OverInvDrag (Just b))
@@ -198,7 +197,7 @@ dragInvItems ::
    IM.IntMap (SelectionSection a) ->
    World ->
    World
-dragInvItems is cfig mpos ldp sss w 
+dragInvItems is cfig mpos ldp sss w
    | nonconcurrent = collectInvItems is w
    | otherwise = shiftInvItems is cfig mpos ldp sss w
  where
@@ -208,19 +207,18 @@ concurrentIS :: IS.IntSet -> Bool
 concurrentIS = go . IS.minView
  where
    go Nothing = True
-    go (Just (i,is)) = fromMaybe True $ do
-        (j,js) <- IS.minView is
-        return $ i + 1 == j && go (Just (j,js))
+    go (Just (i, is)) = fromMaybe True $ do
+        (j, js) <- IS.minView is
+        return $ i + 1 == j && go (Just (j, js))

 collectInvItems :: IS.IntSet -> World -> World
 collectInvItems is w = fromMaybe w $ do
-    (j,js) <- IS.minView is
+    (j, js) <- IS.minView is
    return $ h j js w
  where
    h j js w' = fromMaybe w' $ do
-        (k,ks) <- IS.minView js
-        return . h (j+1) ks $ swapInvItems (\_ _ -> Just (j+1)) k w'
-    
+        (k, ks) <- IS.minView js
+        return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'

 shiftInvItems ::
    IS.IntSet ->
@@ -231,9 +229,9 @@ shiftInvItems ::
    World ->
    World
 shiftInvItems xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
-    Just p | p < (0,IS.findMin xs) -> shiftInvItemsUp xs w
+    Just p | p < (0, IS.findMin xs) -> shiftInvItemsUp xs w
    _ -> case inverseSelBoundaryDown cfig ldp sss mpos of
-        Just p | p > (0,IS.findMax xs) -> shiftInvItemsDown xs w
+        Just p | p > (0, IS.findMax xs) -> shiftInvItemsDown xs w
        _ -> w

 shiftInvItemsUp :: IS.IntSet -> World -> World
@@ -252,7 +250,6 @@ shiftInvItemsDown is w = fromMaybe w $ do
    f i' w' = swapInvItems g i' w'
    g i' m = fst <$> IM.lookupGT i' m

-
 updateFunctionKeys :: Universe -> Universe
 updateFunctionKeys u =
    M.foldlWithKey'
@@ -342,7 +339,7 @@ doRegexInput ::
    (IM.IntMap (SelectionSection a), Maybe (Int, Int), Maybe String)
 doRegexInput inp i sss msel filts
    | backspacetonothing || escapekey = endregex i 0
-    | endkeys || endmouse = endregex (i + 1) (j -1)
+    | endkeys = endregex (i + 1) (j -1)
    | otherwise =
        ( sss
        , msel
@@ -362,7 +359,6 @@ doRegexInput inp i sss msel filts
        any
            ((== Just InitialPress) . (`M.lookup` pkeys))
            [ScancodeReturn, ScancodeSlash]
-    endmouse = (Just 0 ==) $ inp ^? mouseButtons . ix ButtonLeft
    backspacetonothing =
        filts == Just ""
            && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
@@ -481,7 +477,7 @@ toggleTweakInv w = case w ^? hud . hudElement . subInventory of
    thepointer = hud . hudElement . subInventory

 tryCombine ::
--    IM.IntMap (SelectionSection CombinableItem) ->
+    --    IM.IntMap (SelectionSection CombinableItem) ->
    (Int, Int) ->
    World ->
    World
@@ -498,5 +494,4 @@ maybeExitCombine :: World -> World
 maybeExitCombine w
    | ButtonRight `M.member` (w ^. input . mouseButtons) = w
    | otherwise =
-        w & hud . hudElement . subInventory
-            .~ NoSubInventory --MouseInvNothing
+        w & hud . hudElement . subInventory .~ NoSubInventory