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