diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index 36bca4663..f50bbf3bd 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -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} diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index adebb8586..45f3d35d0 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -184,4 +184,5 @@ defaultHUD = , _closeItems = mempty , _closeButtons = mempty , _manObject = HandsFree + , _closeItemsInv = mempty } diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index e88f30e11..66c19fc6a 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -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,15 +175,11 @@ 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 - _ -> w +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 | ScancodeLShift `M.member` (w ^. input . pressedKeys) = id @@ -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 diff --git a/src/IntSetHelp.hs b/src/IntSetHelp.hs index bf47fa80c..7f466ef11 100644 --- a/src/IntSetHelp.hs +++ b/src/IntSetHelp.hs @@ -1,16 +1,19 @@ -module IntSetHelp - ( +module IntSetHelp ( module Data.IntSet, - deleteShift - ) - where + deleteShift, + symmetricDifference, +) where + +-- import qualified Prelude ---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 + (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)