Allow mouse click interaction for nearby objects

2025-01-02 00:32:45 +00:00
parent 3b60ad6023
commit 03b25565f1
4 changed files with 106 additions and 167 deletions
@@ -2,6 +2,7 @@ module Dodge.Creature.YourControl (
    yourControl,
 ) where

+import Dodge.SelectedClose
 import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
@@ -178,13 +179,12 @@ tryClickUse pkeys w = fromMaybe w $ do
    ltime <- pkeys ^? ix SDL.ButtonLeft
    rtime <- pkeys ^? ix SDL.ButtonRight
    guard $ ltime <= rtime
-    invid <-
-        w
-            ^? cWorld . lWorld . creatures . ix 0
+    case w ^? cWorld . lWorld . creatures . ix 0
                . crManipulation
                . manObject
-                . imSelectedItem
-    useItem invid (f ltime) w
+                . imSelectedItem of
+        Just invid -> useItem invid (f ltime) w
+        Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
  where
    f 0 = InitialPress
    f _ = ShortPress
@@ -5,6 +5,7 @@ module Dodge.Update.Input.InGame (
    updateMouseInGame,
 ) where

+import Dodge.SelectedClose
 import Control.Applicative
 import Control.Monad
 import Data.Foldable
@@ -14,7 +15,6 @@ import Data.List (sort)
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
-import Dodge.Button.Event
 import Dodge.Camera
 import Dodge.Creature.Action
 import Dodge.Data.Combine
@@ -40,7 +40,7 @@ import SDL

 updateUseInputInGame :: Universe -> Universe
 updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
--    DisplayCarte -> over uvWorld updatePressedButtonsCarte u
+    --    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, _, _))} ->
@@ -437,7 +437,7 @@ updateInitialPressInGame uv sc = case sc of
    ScancodeSpace -> over uvWorld spaceAction uv
    ScancodeP -> pauseGame uv
    ScancodeF -> over uvWorld youDropItem uv
--    ScancodeM -> toggleMap uv
+    --    ScancodeM -> toggleMap uv
    ScancodeT -> over uvWorld testEvent uv
    ScancodeC -> toggleCombineInv uv
    -- the following should be put in a more sensible place
@@ -538,40 +538,17 @@ pauseGame u = u & uvScreenLayers .~ [pauseMenu u]

 spaceAction :: World -> World
 spaceAction w = case w ^. hud . hudElement of
--    DisplayCarte -> w & hud . carteCenter .~ theLoc
-    DisplayInventory{_subInventory = NoSubInventory{}} -> fromMaybe w $ do
-        cobj <- selCloseObj w
-        return $ case cobj of
-            (Left flit) ->
-                pickUpItem 0 flit w
-                    & worldEventFlags . at InventoryChange ?~ ()
-            (Right but) ->
-                doButtonEvent (_btEvent but) but w
-                    & worldEventFlags . at InventoryChange ?~ ()
+    DisplayInventory{_subInventory = NoSubInventory{}} ->
+        maybe id interactWithCloseObj (getCloseObj w) w
    DisplayInventory{_subInventory = DisplayTerminal{}} ->
        w
            & hud . hudElement . subInventory .~ NoSubInventory
            & worldEventFlags . at InventoryChange ?~ ()
    _ -> w & hud . hudElement . subInventory .~ NoSubInventory
--  where
--    theLoc =
--        doWorldPos
--            (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1)
--            w

-selCloseObj :: World -> Maybe (Either FloorItem Button)
-selCloseObj w = selobj <|> firstcitem <|> firstcbut
+getCloseObj :: World -> Maybe (Either FloorItem Button)
+getCloseObj w = getSelectedCloseObj w <|> firstcitem <|> firstcbut
  where
-    selobj = do
-        (i, j, _) <- w ^? hud . hudElement . diSelection . _Just
-        case i of
-            3 -> do
-                NInt k <- w ^? hud . closeItems . ix j
-                fmap Left $ w ^? cWorld . lWorld . floorItems . unNIntMap . ix k
-            5 -> do
-                k <- w ^? hud . closeButtons . ix j
-                fmap Right $ w ^? cWorld . lWorld . buttons . ix k
-            _ -> Nothing
    firstcitem = do
        k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems) >>= (fmap fst . IM.lookupMin)
        NInt k <- w ^? hud . closeItems . ix k'
@@ -18,7 +18,7 @@ updateWheelEvent :: Int -> World -> World
 updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
    NoSubInventory -> updateBaseWheelEvent yi w
    ExamineInventory -> updateBaseWheelEvent yi w
-    CombineInventory{} -> w & moveCombineSel yi
+    CombineInventory{} -> moveCombineSel yi w
    DisplayTerminal tmid -> terminalWheelEvent yi tmid w

 updateBaseWheelEvent :: Int -> World -> World
@@ -27,17 +27,15 @@ updateBaseWheelEvent yi w
    | bdown ButtonRight = case _rbOptions w of
        EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
        NoRightButtonOptions -> selectedItemScroll yi w
-    | bdown ButtonLeft = w & wCam . camZoom +~ y
-    | invKeyDown = changeSwapSel yi w
+    | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
+    | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
    | otherwise = scrollAugInvSel yi w
  where
-    invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
-    y = fromIntegral yi
-    bdown b = b `M.member` _mouseButtons (_input 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 . itUse . uequipEffect . eeType
-        return $ length $ eqSiteToPositions esite
+        return . length $ eqSiteToPositions esite

 selectedItemScroll :: Int -> World -> World
 selectedItemScroll scrollamount w = fromMaybe w $ do
@@ -116,28 +114,15 @@ moveCombineSel yi =
        sss <- ci ^? ciSections
        return $ ci & ciSelection %~ scrollSelectionSections yi sss

--moveSubSel :: Int -> Int -> World -> World
--moveSubSel yi maxyi =
--    hud . hudElement . subInventory . subInvMSel . _Just
--        %~ ((`mod` maxyi) . subtract yi)
-
-guardDisconnectedID :: Int -> World -> World -> World
-guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
-    Just TerminalReady -> w'
-    _ -> w
-
 terminalWheelEvent :: Int -> Int -> World -> World
 terminalWheelEvent yi tmid w
-    | rbDown =
-        guardDisconnectedID tmid w $
-            w
-                & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
-    | otherwise =
-        guardDisconnectedID tmid w $
-            w
-                & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
+    | w & has (input . mouseButtons . ix ButtonRight)
+    , Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
+            w & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
+    | Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
+            w & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
+    | otherwise = w
  where
-    rbDown = ButtonRight `M.member` _mouseButtons (_input w)
    updatetermsel tm = case tm ^? tmInput . tiSel of
        Nothing -> tm & tmInput . tiSel .~ (0, 0)
        Just (i, _) ->
@@ -151,7 +136,7 @@ terminalWheelEvent yi tmid w
    setInput i j tm =
        tm
            & tmInput . tiSel .~ (i, j)
-            & tmInput . tiText .~ (comstr ++ arg)
+            & tmInput . tiText .~ comstr ++ arg
      where
        comstr = scrollCommandStrings w tm !! i
        tc = scrollCommands tm !! i
@@ -163,23 +148,6 @@ scrollRBOption dy ymax
    | dy > 0 = max 0 . subtract dy
    | otherwise = id

--moveTweakSel :: Int -> World -> World
--moveTweakSel i w = case yourSelectedItem w ^? _Just . itTweaks . tweakParams of
--    Just l -> moveSubSel i (length l) w
--    _ -> w
-
--changeTweakParam :: Maybe Int -> Int -> World -> World
--changeTweakParam mi i w = fromMaybe w $ do
--    curpos <- you w ^? crManipulation . manObject . imSelectedItem
--    paramid <- mi
--    params <- yourSelectedItem w ^? _Just . itTweaks . tweakParams . ix paramid
--    let x = (_tweakVal params + i) `mod` _tweakMax params
--    return $
--        w & cWorld . lWorld . creatures . ix 0 . crInv . ix curpos
--            %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
--                    . doTweak (_tweakType params) x
--               )
-
 scrollCommands :: Terminal -> [TerminalCommand]
 scrollCommands = (nullCommand :) . _tmScrollCommands