justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup, delete hotkeys when deleting item from inventory

Browse Source
This commit is contained in:
justin
2025-01-01 14:04:25 +00:00
parent 0915e04b56
commit 7dd379d4bc
12 changed files with 497 additions and 492 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input/InGame.hs
+126 -101
View File
@@ -1,13 +1,10 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Update.Input.InGame (
updateUseInputInGame,
updateMouseInGame,
) where
import Dodge.Update.Input.DebugTest
import Dodge.Item.InvSize
import Data.Monoid
import NewInt
import Control.Applicative
import Control.Monad
import Data.Foldable
@@ -16,6 +13,7 @@ import qualified Data.IntSet as IS
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
@@ -25,16 +23,19 @@ import Dodge.DisplayInventory
import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Inventory.Add
import Dodge.Item.InvSize
import Dodge.ListDisplayParams
import Dodge.Menu
import Dodge.Save
import Dodge.SelectionSections
import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.Update.Input.DebugTest
import Dodge.Update.Input.Text
import Dodge.WorldPos
import Geometry
import LensHelp
import NewInt
import SDL
updateUseInputInGame :: Universe -> Universe
@@ -42,18 +43,22 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
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,_,_))} ->
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
u
& uvWorld . hud . hudElement . subInventory
%~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_
| disel ^? _Just . _1 == Just (-1) ->
u
& uvWorld . hud . hudElement . subInventory
%~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_ | disel ^? _Just . _1 == Just (-1) ->
u & uvWorld . hud . hudElement
& uvWorld . hud . hudElement
%~ dodisplayregexinput diInvFilter diInvFilter (-1)
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
_ | disel ^? _Just . _1 == Just 2 ->
u & uvWorld . hud . hudElement
_
| disel ^? _Just . _1 == Just 2 ->
u
& uvWorld . hud . hudElement
%~ dodisplayregexinput diCloseFilter diCloseFilter 2
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
@@ -78,12 +83,14 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
& ciFilter .~ filts'
updateMouseInGame :: Configuration -> World -> World
updateMouseInGame cfig w = case w ^? input . mouseButtons . ix ButtonLeft of
Just 0 -> updateMouseClickInGame cfig w
Just _ -> updateMouseHeldInGame cfig w
Nothing -> case w ^? input . mouseButtonsReleased . ix ButtonLeft of
Just 0 -> updateMouseReleaseInGame w
_ -> w
updateMouseInGame cfig w
| Just 0 <- lbpress = updateMouseClickInGame cfig w
| Just _ <- lbpress = updateMouseHeldInGame cfig w
| Just 0 <- lbrelease = updateMouseReleaseInGame w
| otherwise = w
where
lbpress = w ^? input . mouseButtons . ix ButtonLeft
lbrelease = w ^? input . mouseButtonsReleased . ix ButtonLeft
updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
@@ -95,34 +102,35 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDrag k mmouseover ab bn -> doDrag 30 k mmouseover ab bn w
_ -> w
doDrag :: Int
-> Int
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> World
-> World
doDrag ::
Int ->
Int ->
Maybe (Int, Int) ->
Maybe (Int, Int) ->
Maybe (Int, Int) ->
World ->
World
doDrag 0 _ _ _ _ w = w
doDrag n k mmouseover ab bn w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
return $ if concurrentIS is
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
return $
if concurrentIS is
then shiftInvItems n k x ab bn is ss w
else collectInvItems k is w
tryDropSelected :: Maybe (Int,Int) -> World -> Maybe World
tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
tryDropSelected mpos w = do
guard $ maybe True (\(i,_) -> i == 3) mpos
guard $ maybe True (\(i, _) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, _, xs) <- w ^? hud . hudElement . diSelection . _Just
return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
tryPickupSelected :: Int -> Maybe (Int,Int) -> World -> Maybe World
tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
tryPickupSelected k mpos w = do
guard $ k == 3
guard $ maybe True (\(i,_) -> i == 0 || i == 1) mpos
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
let nfreeslots = crNumFreeSlots cr
xs <- w ^? hud . hudElement . diSelection . _Just . _3
@@ -130,11 +138,16 @@ tryPickupSelected k mpos w = do
let slotsneeded = alaf Sum foldMap (itInvHeight . _flIt) itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Just (0,j) -> foldr (pickUpItemAt j 0) w itmstopickup
& hud . hudElement . diSelection ?~ (0,j
, IS.fromDistinctAscList [j..j+IS.size xs-1])
_ -> foldl' (flip $ pickUpItem 0) w itmstopickup
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
Just (0, j) ->
foldr (pickUpItemAt j 0) w itmstopickup
& hud . hudElement . diSelection
?~ ( 0
, j
, IS.fromDistinctAscList [j .. j + IS.size xs -1]
)
_ ->
foldl' (flip $ pickUpItem 0) w itmstopickup
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
where
g i = do
NInt j <- w ^? hud . closeItems . ix i
@@ -142,26 +155,32 @@ tryPickupSelected k mpos w = do
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDrag k mpos _ _ ->
OverInvDrag k mpos _ _ ->
input . mouseContext .~ MouseInGame $
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect ssel mesel | ScancodeLShift `M.member` (w ^. input . pressedKeys)
-> w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ getuniques
(maybe mempty (h ssel)
(guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1)
>> mesel ^? _Just))
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect ssel mesel
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3
%~ getuniques
( maybe
mempty
(h ssel)
( guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1)
>> mesel ^? _Just
)
)
OverInvDragSelect _ Nothing ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
OverInvDragSelect ssel (Just esel) ->
w & input . mouseContext .~ MouseInGame
& augInvDirectSelect (f (fst ssel,esel) (h ssel esel))
& augInvDirectSelect (f (fst ssel, esel) (h ssel esel))
_ -> w
where
getuniques x y = IS.union x y IS.\\ IS.intersection x y
f (x,y) z = (x,y,z)
h (k,i) j = fold $ do
f (x, y) z = (x, y, z)
h (k, i) j = fold $ do
sss <- w ^? hud . hudElement . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
(yss, _) = IM.split (max i j + 1) xss
@@ -182,14 +201,18 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
return $
w & input . mouseContext
.~ OverInvDragSelect ysel Nothing
OverInvSelect (-1,_) | selsec == Just (-1) -> w
& hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing
OverInvSelect (2,_) | selsec == Just 2 -> w
& hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diCloseFilter .~ Nothing
OverInvSelect x | ScancodeLShift `M.member` (w ^. input . pressedKeys )
-> fromMaybe w $ do
OverInvSelect (-1, _)
| selsec == Just (-1) ->
w
& hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing
OverInvSelect (2, _)
| selsec == Just 2 ->
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 -> startDrag x cfig w
@@ -229,34 +252,38 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
_ -> w
where
mpos = w ^. input . mousePos
f (x,y) = (x,y,mempty)
f (x, y) = (x, y, mempty)
selsec = w ^? hud . hudElement . diSelection . _Just . _1
endRegex :: Int -> World
-> Maybe (Int,Int,IS.IntSet)
-> Maybe (Int,Int,IS.IntSet)
endRegex ::
Int ->
World ->
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
endRegex i w = fromMaybe id $ do
sss <- w ^? hud . hudElement . diSections
let j = fromMaybe 0 $ do
itms <- sss ^? ix i . ssItems
(k,_) <- IM.lookupMin itms
(k, _) <- IM.lookupMin itms
return k
return $ ssSetCursor (ssLookupDown i j) sss
endCombineRegex ::World
-> Maybe (Int,Int,IS.IntSet)
-> Maybe (Int,Int,IS.IntSet)
endCombineRegex ::
World ->
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
endCombineRegex w = fromMaybe id $ do
sss <- w ^? hud . hudElement . subInventory . ciSections
let j = fromMaybe 0 $ do
itms <- sss ^? ix 0 . ssItems
(k,_) <- IM.lookupMin itms
return (k-1)
(k, _) <- IM.lookupMin itms
return (k -1)
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
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
@@ -291,9 +318,9 @@ collectInvItems secid is w = fromMaybe w $ do
shiftInvItems ::
Int -> -- recurse limit
Int -> -- section where drag started
(Int,Int) -> -- selection item mouse is over
Maybe (Int,Int) -> -- selection item "above" mouse position (can be same as over)
Maybe (Int,Int) -> -- selection item "below" mouse position (can be same as over)
(Int, Int) -> -- selection item mouse is over
Maybe (Int, Int) -> -- selection item "above" mouse position (can be same as over)
Maybe (Int, Int) -> -- selection item "below" mouse position (can be same as over)
IS.IntSet ->
IM.IntMap (SelectionItem a) ->
World ->
@@ -301,23 +328,23 @@ shiftInvItems ::
shiftInvItems n k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do
let xk = fst x
guard $ xk == k || xk + 1 == k || xk -1 == k
(maxi,_) <- IS.maxView xs
(mini,_) <- IS.minView xs
(maxi, _) <- IS.maxView xs
(mini, _) <- IS.minView xs
case True of
_ | x < (k,mini) -> do
_ | x < (k, mini) -> do
guard $ not . null . fst $ IM.split mini ss
guard $ Just (k,mini-1) /= ab
return . doDrag (n-1) k (Just x) ab bn $ shiftInvItemsUp k xs w
_ | x > (k,maxi) -> do
guard $ Just (k, mini -1) /= ab
return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsUp k xs w
_ | x > (k, maxi) -> do
guard $ not . null . snd $ IM.split maxi ss
guard $ Just (k,maxi+1) /= bn
return . doDrag (n-1) k (Just x) ab bn $ shiftInvItemsDown k xs w
guard $ Just (k, maxi + 1) /= bn
return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsDown k xs w
_ -> Nothing
setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
(i,_,xs) <- w ^? hud . hudElement . diSelection . _Just
(k,j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
(i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
guard $ i == k && j `IS.member` xs
return $ w & hud . hudElement . diSelection . _Just . _2 .~ j
@@ -484,23 +511,23 @@ updateBackspaceRegex w = case di ^? subInventory of
return $ case str of
(_ : _) ->
he & filtset . _Just %~ init
& selset ?~ (x, 0,mempty)
& selset ?~ (x, 0, mempty)
[] -> he & filtset .~ Nothing
di = w ^. hud . hudElement
updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{}
| secfocus [-1,0,1] ->
w & hud . hudElement . diSelection ?~ (-1, 0,mempty)
| secfocus [-1, 0, 1] ->
w & hud . hudElement . diSelection ?~ (-1, 0, mempty)
& hud . hudElement . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2,3] ->
w & hud . hudElement . diSelection ?~ (2, 0,mempty)
| secfocus [2, 3] ->
w & hud . hudElement . diSelection ?~ (2, 0, mempty)
& hud . hudElement . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . hudElement . subInventory . ciFilter %~ enterregex
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0,mempty)
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0, mempty)
_ -> w
where
di = w ^. hud . hudElement
@@ -518,11 +545,14 @@ spaceAction w = case w ^. hud . hudElement of
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 = DisplayTerminal{}} -> w
(Left flit) ->
pickUpItem 0 flit w
& worldEventFlags . at InventoryChange ?~ ()
(Right but) ->
doButtonEvent (_btEvent but) but w
& worldEventFlags . at InventoryChange ?~ ()
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w
& hud . hudElement . subInventory .~ NoSubInventory
& worldEventFlags . at InventoryChange ?~ ()
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
@@ -536,7 +566,7 @@ selCloseObj :: World -> Maybe (Either FloorItem Button)
selCloseObj w = selobj <|> firstcitem <|> firstcbut
where
selobj = do
(i,j,_) <- w ^? hud . hudElement . diSelection . _Just
(i, j, _) <- w ^? hud . hudElement . diSelection . _Just
case i of
3 -> do
NInt k <- w ^? hud . closeItems . ix j
@@ -575,17 +605,13 @@ toggleTweakInv w = case w ^? hud . hudElement . subInventory of
where
thepointer = hud . hudElement . subInventory
tryCombine ::
(Int, Int) ->
World ->
World
tryCombine :: (Int, Int) -> World -> World
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 $
snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
-- & cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
& soundStart InventorySound p wrench1S Nothing
& hud . hudElement . diSelection . _Just . _3 .~ mempty
@@ -594,4 +620,3 @@ maybeExitCombine w
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
| otherwise =
w & hud . hudElement . subInventory .~ NoSubInventory