Refactor code for initial mouse click in game

2024-11-18 11:00:41 +00:00
parent afddcae6d1
commit 3c5e5b92b1
5 changed files with 217 additions and 139 deletions
@@ -294,9 +294,13 @@ runTerminalString s tm w =
           )

 doTerminalEffectLB :: Terminal -> World -> World
-doTerminalEffectLB tm w = fromMaybe w $ do
-    guard (_tmStatus tm == TerminalReady)
-    s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
-    return $ if null (words s) && null (_tmPartialCommand tm)
-        then w
-        else terminalReturnEffect tm w
+doTerminalEffectLB tm w = case w ^. input . mouseContext of
+    OverTerminalReturn -> fromMaybe w $ do
+        guard (_tmStatus tm == TerminalReady)
+        s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
+        return $ if null (words s) && null (_tmPartialCommand tm)
+            then w
+            else terminalReturnEffect tm w
+    OverTerminalEscape -> w 
+        & hud . hudElement . subInventory .~ NoSubInventory MouseInvNothing
+    _ -> w
@@ -6,7 +6,6 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where

-import Dodge.Update.Input.ScreenLayer
 import Color
 import Control.Applicative
 import Control.Monad
@@ -54,6 +53,7 @@ import Dodge.TractorBeam.Update
 import Dodge.Update.Camera
 import Dodge.Update.Cloud
 import Dodge.Update.Input.InGame
+import Dodge.Update.Input.ScreenLayer
 import Dodge.Update.Scroll
 import Dodge.Update.WallDamage
 import Dodge.WallCreatureCollisions
@@ -165,7 +165,7 @@ updateUniverseMid u = case _uvScreenLayers u of
                    . updateClouds
               )
    (sl : _) -> u & updateUseInputOnScreen sl
-    [] -> timeFlowUpdate $ updateUseInputInGame u
+    [] -> timeFlowUpdate . updateUseInputInGame $ over uvWorld updateMouseClickInGame u

 timeFlowUpdate :: Universe -> Universe
 timeFlowUpdate u = case u ^. uvWorld . timeFlow of
@@ -399,18 +399,19 @@ updateMouseContext cfig u =
        screen <- u ^? uvScreenLayers . ix 0
        return $ case screen ^. scOptions of
            [] -> NoMouseContext
-            _ -> fromMaybe MouseMenuCursor $ do 
+            _ -> fromMaybe MouseMenuCursor $ do
                ldps <- screen ^? scListDisplayParams
                let ymax = maybe 0 length $ screen ^? scSelectionList
                yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
                guard (yi >= 0 && yi < ymax)
-                return $ if isselectable yi
-                    then MouseMenuClick yi
-                    else NoMouseContext
+                return $
+                    if isselectable yi
+                        then MouseMenuClick yi
+                        else NoMouseContext
    isselectable yi =
        fromMaybe False $
            u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable
--    mmoving = u ^. uvWorld . input . mouseMoving
+    --    mmoving = u ^. uvWorld . input . mouseMoving
    w = u ^. uvWorld
    aimcontext
        | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
@@ -438,9 +439,10 @@ updateMouseContext cfig u =
        tm <- w ^? cWorld . lWorld . terminals . ix tmid
        return $
            if isOverTerminalScreen cfig tm mpos
-                then if null $ tm ^. tmInput . tiText
-                    then NoMouseContext
-                    else OverTerminalReturn
+                then
+                    if null $ tm ^. tmInput . tiText
+                        then NoMouseContext
+                        else OverTerminalReturn
                else OverTerminalEscape

 isOverTerminalScreen :: Configuration -> Terminal -> Point2 -> Bool
@@ -1,10 +1,10 @@
 module Dodge.Update.Input.InGame (
    updateUseInputInGame,
+    updateMouseClickInGame,
 ) where

-import Dodge.Terminal
-import Control.Monad
 import Control.Applicative
+import Control.Monad
 import qualified Data.IntMap.Strict as IM
 import Data.List (sort)
 import qualified Data.Map.Strict as M
@@ -25,6 +25,7 @@ import Dodge.Menu
 import Dodge.Save
 import Dodge.SelectionSections
 import Dodge.SoundLogic
+import Dodge.Terminal
 import Dodge.Update.Input.Text
 import Dodge.WorldPos
 import Geometry
@@ -35,30 +36,33 @@ updateUseInputInGame :: Universe -> Universe
 updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
    DisplayCarte -> over uvWorld updatePressedButtonsCarte u
    DisplayInventory{_subInventory = si} -> case si of
-        DisplayTerminal tmid
-            | lbinitialpress -> u & uvWorld 
-                %~ doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)
-            | otherwise -> updateKeysInTerminal tmid u
-        CombineInventory{_ciSections = sss, _ciSelection = msel} 
-            | lbinitialpress -> u & uvWorld %~ updateCombineInvClick sss
+        DisplayTerminal tmid -> updateKeysInTerminal tmid u
+--            | lbinitialpress ->
+--                u & uvWorld
+--                    %~ doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)
+--            | otherwise -> updateKeysInTerminal tmid u
+        CombineInventory{_ciSections = sss, _ciSelection = msel}
+--            | lbinitialpress -> u & uvWorld %~ updateCombineInvClick sss
            | inSubInvRegex (u ^. uvWorld) ->
                u
                    & uvWorld . hud . hudElement . subInventory
                        %~ docombineregexinput sss msel
                    & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
-        _   | inInvRegex (u ^. uvWorld) ->
+        _
+            | inInvRegex (u ^. uvWorld) ->
                u & uvWorld . hud . hudElement %~ dodisplayregexinput (-1)
                    & uvWorld . worldEventFlags . at InventoryChange ?~ ()
                    & uvWorld %~ setInvPosFromSS
-        _   | inCloseRegex (u ^. uvWorld) ->
+        _
+            | inCloseRegex (u ^. uvWorld) ->
                u & uvWorld . hud . hudElement %~ dodisplayregexinput' 2
                    & uvWorld . worldEventFlags . at InventoryChange ?~ ()
                    & uvWorld %~ setInvPosFromSS
        _ -> M.foldlWithKey' updateKeyInGame u pkeys
  where
-    w = u ^. uvWorld
+--    w = u ^. uvWorld
    pkeys = u ^. uvWorld . input . pressedKeys
-    lbinitialpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft == Just 0
+--    lbinitialpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft == Just 0
    dodisplayregexinput x di = fromMaybe di $ do
        sss <- di ^? diSections
        msel <- di ^? diSelection
@@ -85,9 +89,58 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
                & ciSelection .~ msel'
                & ciFilter .~ filts'

+updateMouseClickInGame :: World -> World
+updateMouseClickInGame w = if w ^? input . mouseButtons . ix ButtonLeft == Just 0
+    then updateMouseClickInGame' w
+    else w
+
+updateMouseClickInGame' :: World -> World
+updateMouseClickInGame' w = case w ^. input . mouseContext of
+    OverTerminalReturn -> fromMaybe w $ do
+        tmid <- w ^? hud . hudElement . subInventory . termID
+        tm <- w ^? cWorld . lWorld . terminals . ix tmid
+        guard (_tmStatus tm == TerminalReady)
+        s <- tm ^? tmInput . tiText
+        return $ if null (words s) && null (_tmPartialCommand tm)
+            then w
+            else terminalReturnEffect tm w
+    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 ?~ ()
+    OverCombEscape ->
+        w
+            & worldEventFlags . at InventoryChange ?~ ()
+            & hud . hudElement . subInventory .~ NoSubInventory MouseInvNothing
+    OverInvFilt (i, j) -> fromMaybe w $ do
+        guard $ i == 0
+        str <-
+            fmap (take 5) $
+                w
+                    ^? 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)
+    _ -> w
+
 updateFunctionKeys :: Universe -> Universe
-updateFunctionKeys u = M.foldlWithKey' updateFunctionKey u 
-    (u ^. uvWorld . input . pressedKeys)
+updateFunctionKeys u =
+    M.foldlWithKey'
+        updateFunctionKey
+        u
+        (u ^. uvWorld . input . pressedKeys)

 updateFunctionKey :: Universe -> Scancode -> PressType -> Universe
 updateFunctionKey uv sc InitialPress = case sc of
@@ -103,33 +156,40 @@ updateCombineInvClick ::
    IM.IntMap (SelectionSection CombinableItem) ->
    World ->
    World
-updateCombineInvClick sss w = fromMaybe trydocombination $ do
-    (i,j) <- w ^? input . mouseContext . mcoInvFilt
-    guard $ i == 0
-    str <- fmap (take 5) $ w 
-        ^? 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)
-  where
-    trydocombination = case w ^. input . mouseContext of
-        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 sss (i,j) w
-                    & worldEventFlags . at CombineInventoryChange ?~ ()
-        OverCombEscape -> w
+updateCombineInvClick sss w = case w ^. input . mouseContext of
+    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 ?~ ()
+    OverCombEscape ->
+        w
            & worldEventFlags . at InventoryChange ?~ ()
            & hud . hudElement . subInventory .~ NoSubInventory MouseInvNothing
-        x -> error $ "while combining this mouse context should not be possible: "
-            ++ show x
- 
--        x@(Just (i,_)) 
+    OverInvFilt (i, j) -> fromMaybe w $ do
+        guard $ i == 0
+        str <-
+            fmap (take 5) $
+                w
+                    ^? 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)
+    x ->
+        error $
+            "while combining this mouse context should not be possible: "
+                ++ show x
+
+--        x@(Just (i,_))
 --            | x /= msel -> w & hud . hudElement . subInventory . ciSelection .~ x
 --                    & worldEventFlags . at CombineInventoryChange ?~ ()
 --            | i == -1 -> w & hud . hudElement . subInventory . ciFilter .~ Nothing
@@ -353,11 +413,12 @@ 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
-tryCombine sss (i,j) w = fromMaybe w $ do
+tryCombine (i, j) w = fromMaybe w $ do
+    sss <- w ^? hud . hudElement . subInventory . ciSections
    CombinableItem is it _ <- sss ^? ix i . ssItems . ix j . siPayload
    p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
    return $