This commit is contained in:
2026-05-17 10:08:51 +01:00
parent 0386683670
commit 580619280a
4 changed files with 50 additions and 86 deletions
+2
View File
@@ -10,6 +10,7 @@ import Dodge.Data.Item.Location
import Dodge.Data.SelectionList
import Geometry.Data
import NewInt
import qualified Data.IntMap.Strict as IM
data SubInventory
= NoSubInventory
@@ -35,6 +36,7 @@ data HUD = HUD
, _closeItems :: [NewInt ItmInt] -- add bool showing whether in ssSet?
, _closeButtons :: [Int]
, _manObject :: ManipulatedObject
, _closeItemsInv :: IM.IntMap Int
}
data Selection = Sel {_slSec :: Int, _slInt :: Int}
+1
View File
@@ -184,4 +184,5 @@ defaultHUD =
, _closeItems = mempty
, _closeButtons = mempty
, _manObject = HandsFree
, _closeItemsInv = mempty
}
+35 -77
View File
@@ -9,7 +9,7 @@ import Control.Applicative
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import qualified IntSetHelp as IS
import Data.List (sort)
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -133,8 +133,7 @@ tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
tryDropSelected mpos w = do
guard $ maybe True (\(i, _) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
0 <- w ^? hud . diSelection . _Just . slSec
j <- w ^? hud . diSelection . _Just . slInt
Sel 0 j <- w ^. hud . diSelection
xs <- selectionSet w
let xmin = IS.findMin xs
return
@@ -176,14 +175,10 @@ tryPickupSelected k mpos w = do
w ^? cWorld . lWorld . items . ix j
updateMouseReleaseInGame :: Config -> World -> World
updateMouseReleaseInGame cfig w = input . mouseContext .~ MouseInGame $ case w ^. input . mouseContext of
OverInvDrag k ->
fromMaybe w $
tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect ssel ->
w
& mresetssset
& doDragSelect cfig ssel
updateMouseReleaseInGame cfig w = input . mouseContext .~ MouseInGame
$ case w ^. input . mouseContext of
OverInvDrag k -> fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect ssel -> doDragSelect cfig ssel $ mresetssset w
_ -> w
where
mresetssset
@@ -201,29 +196,26 @@ doDragSelect cfig x w = fromMaybe w $ do
where
f w' i ss
| i == 0 || i == 3 =
w'
& hud
. diSections
. ix i
. ssSet
%~ symmetricDifference (IM.keysSet (ss ^. ssItems))
w' & hud . diSections . ix i . ssSet %~ IS.symmetricDifference (IM.keysSet (ss ^. ssItems))
| otherwise = w'
-- this is in Data.IntSet 0.8
symmetricDifference :: IS.IntSet -> IS.IntSet -> IS.IntSet
symmetricDifference x y = (x `IS.union` y) IS.\\ (x `IS.intersection` y)
mouseInvHeight :: Config -> World -> XInfinity (Int,Int)
mouseInvHeight cfig w =
inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
(w ^. hud . diSections)
mouseInvPos :: Universe -> Maybe (XInfinity (Int,Int))
mouseInvPos u = inverseSelNumPos
(u^.uvConfig)
invDP
(u^.uvWorld. input . mousePos)
(u ^.uvWorld. hud . diSections)
updateMouseClickInGame :: Config -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
MouseInGame ->
w
& input
. mouseContext
.~ OverInvDragSelect
( inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
(w ^. hud . diSections)
)
w & input . mouseContext .~ OverInvDragSelect (mouseInvHeight cfig w)
OverInvSelect (-1, _)
| selsec == Just (-1) ->
w
@@ -489,27 +481,17 @@ updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory{}
| secfocus (-1) 0 ->
w
& hud
%~ trybackspace (-1) diInvFilter diInvFilter diSelection
& worldEventFlags
. at InventoryChange
?~ ()
& hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory{}
| secfocus 2 3 ->
w
& hud
%~ trybackspace 2 diCloseFilter diCloseFilter diSelection
& worldEventFlags
. at InventoryChange
?~ ()
& hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} ->
w
& hud
. subInventory
%~ trybackspace (-1) ciFilter ciFilter ciSelection
& worldEventFlags
. at InventoryChange
?~ ()
& hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
where
secfocus a b = fromMaybe False $ do
@@ -520,11 +502,8 @@ updateBackspaceRegex w = case di ^? subInventory of
return $ case str of
(_ : _) ->
he
& filtset
. _Just
%~ init
& selset
?~ Sel x 0
& filtset . _Just %~ init
& selset ?~ Sel x 0
-- & selset ?~ Sel x 0 mempty
[] -> he & filtset .~ Nothing
di = w ^. hud
@@ -533,35 +512,18 @@ updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . subInventory of
Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
-- w & hud . diSelection ?~ Sel (-1) 0 mempty
w
& hud
. diSelection
?~ Sel (-1) 0
& hud
. diInvFilter
%~ enterregex
& hud . diSelection ?~ Sel (-1) 0
& hud . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2, 3] ->
-- w & hud . diSelection ?~ Sel 2 0 mempty
w
& hud
. diSelection
?~ Sel 2 0
& hud
. diCloseFilter
%~ enterregex
& hud . diSelection ?~ Sel 2 0
& hud . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w
& hud
. subInventory
. ciFilter
%~ enterregex
-- & hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty
& hud
. subInventory
. ciSelection
?~ Sel (-1) 0
& hud . subInventory . ciFilter %~ enterregex
& hud . subInventory . ciSelection ?~ Sel (-1) 0
_ -> w
where
secfocus xs = fromMaybe False $ do
@@ -597,11 +559,7 @@ tryCombine (i, j) w = fromMaybe w $ do
return $
createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is))
& soundStart InventorySound p wrench1S Nothing
& hud
. diSections
. ix 1
. ssSet
.~ mempty
& hud . diSections . ix 1 . ssSet .~ mempty
-- & hud . diSelection . _Just . slSet .~ mempty
+9 -6
View File
@@ -1,16 +1,19 @@
module IntSetHelp
(
module IntSetHelp (
module Data.IntSet,
deleteShift
)
where
deleteShift,
symmetricDifference,
) where
-- import qualified Prelude
import Prelude hiding (map)
import Data.IntSet
import Prelude hiding (map)
deleteShift :: Int -> IntSet -> IntSet
deleteShift i x = y <> map (subtract 1) z
where
(y, z) = split i x
-- this is in Data.IntSet 0.8
symmetricDifference :: IntSet -> IntSet -> IntSet
symmetricDifference x y = (x `union` y) \\ (x `intersection` y)