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

Centralise mouse context data

Browse Source
This commit is contained in:
justin
2024-11-10 18:26:30 +00:00
parent f35dfc66bd
commit 713d3e3265
10 changed files with 123 additions and 125 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/HUD.hs
-2
View File
@@ -21,7 +21,6 @@ data HUDElement
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
, _diSelectionExtra :: Int
, _diMouseOver :: Maybe (Int, Int)
}
| DisplayCarte
@@ -40,7 +39,6 @@ data SubInventory
{ _ciSections :: IntMap (SelectionSection CombinableItem)
, _ciSelection :: Maybe (Int, Int)
, _ciFilter :: Maybe String
, _ciMouseOver :: Maybe (Int,Int)
}
| LockedInventory
| DisplayTerminal {_termID :: Int}
src/Dodge/Data/Input.hs
+3 -2
View File
@@ -18,8 +18,8 @@ data PressType
data MouseContext
= NoMouseContext
| OverInv (Int,Int)
| OverCombInv (Int,Int)
| OverInv { _mcoInv :: (Int,Int)}
| OverCombInv { _mcoCombInv :: (Int,Int)}
| OverTerminalScreen
data Input = Input
@@ -51,3 +51,4 @@ data TermSignal
| TSdown
makeLenses ''Input
makeLenses ''MouseContext
src/Dodge/Default/World.hs
-1
View File
@@ -169,7 +169,6 @@ defaultDisplayInventory =
, _diSelectionExtra = 0
, _diInvFilter = mempty
, _diCloseFilter = mempty
, _diMouseOver = Nothing
}
defaultInvSections :: IM.IntMap (SelectionSection ())
src/Dodge/DisplayInventory.hs
-1
View File
@@ -285,7 +285,6 @@ enterCombineInv cfig w =
{ _ciSections = sss
, _ciSelection = selpos
, _ciFilter = Nothing
, _ciMouseOver = Nothing
}
& hud . hudElement . diInvFilter
.~ Nothing
src/Dodge/Render/HUD.hs
+18 -21
View File
@@ -6,6 +6,7 @@ module Dodge.Render.HUD (
selNumPosCardinal, -- this shoud probably be pushed back here
) where
import Control.Applicative
import Dodge.Terminal.Type
import Dodge.CharacterEnums
import Dodge.Creature.Test
@@ -67,10 +68,11 @@ drawInventory sss w cfig =
<> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
<> drawRootCursor w sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
<> iextra
<> drawMouseOver cfig w
<> translateScreenPos
cfig
(ldp ^. ldpPos)
(drawDIMouseOver w <> drawDISelections w)
(drawDISelections w)
where
ldp = invDisplayParams w
curs = invCursorParams w
@@ -104,23 +106,22 @@ getRootItemBounds i inv = do
y <- locLeftmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
return (x,y)
drawDIMouseOver :: World -> Picture
drawDIMouseOver w = fromMaybe mempty $ do
(j, i) <- w ^? hud . hudElement . diMouseOver . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (j, i)
where
curs = BackdropCursor
drawCIMouseOver :: World -> Picture
drawCIMouseOver w = fromMaybe mempty $ do
(j, i) <- w ^? hud . hudElement . subInventory . ciMouseOver . _Just
sss <- w ^? hud . hudElement . subInventory . ciSections
let idp = invDisplayParams w
return . color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (j, i)
where
drawMouseOver :: Configuration -> World -> Picture
drawMouseOver cfig w = fromMaybe mempty $ invsel <|> combinvsel
where
invsel = do
(j, i) <- w ^? input . mouseContext . mcoInv
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (j, i)
curs = BackdropCursor
combinvsel = do
(j, i) <- w ^? input . mouseContext . mcoCombInv
sss <- w ^? hud . hudElement . subInventory . ciSections
let idp = invDisplayParams w
return . translateScreenPos cfig (secondColumnParams ^. ldpPos)
. color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (j, i)
getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
@@ -158,10 +159,6 @@ drawCombineInventory cfig sss w =
<> drawSelectionSections sss secondColumnParams cfig
<> drawSSCursor sss msel secondColumnParams curs cfig
<> combineInventoryExtra sss msel cfig w
<> translateScreenPos
cfig
(secondColumnParams ^. ldpPos)
(drawCIMouseOver w)
where
curs = BoundaryCursor [North, South, West]
msel = w ^? hud . hudElement . subInventory . ciSelection . _Just
src/Dodge/Render/Picture.hs
+4 -4
View File
@@ -82,10 +82,10 @@ mouseCursorType u
| isselect = drawPlus 5
| Just tmid <- u ^? uvWorld . hud . hudElement . subInventory . termID = determineTermCursor tmid u
| Just csel <- u ^? uvWorld . hud . hudElement . subInventory . ciSelection =
if ( csel == u ^? uvWorld . hud . hudElement . subInventory . ciMouseOver . _Just
|| null (u ^? uvWorld . hud . hudElement . subInventory . ciMouseOver . _Just)
if ( csel == u ^? uvWorld . input . mouseContext . mcoCombInv
|| null (u ^? uvWorld . input . mouseContext . mcoCombInv)
)
&& null (u ^? uvWorld . hud . hudElement . diMouseOver . _Just)
&& null (u ^? uvWorld . input . mouseContext . mcoInv)
&& fmap fst csel /= Just (-1)
&& fromMaybe True (u ^? uvWorld . hud . hudElement . subInventory . ciSections . ix 0 . ssItems . ix 0 . siIsSelectable) --HACK to check there is something creatable
then drawGapPlus 5
@@ -94,7 +94,7 @@ mouseCursorType u
where
isselect =
not (null $ u ^. uvScreenLayers)
|| not (null $ u ^? uvWorld . hud . hudElement . diMouseOver . _Just)
|| not (null $ u ^? uvWorld . input . mouseContext . mcoInv)
w = u ^. uvWorld
a = fromMaybe 0 $ do
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
src/Dodge/Update.hs
+11 -14
View File
@@ -6,6 +6,7 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Control.Applicative
import Color
import Control.Monad
import Data.List
@@ -283,8 +284,7 @@ functionalUpdate u =
. over uvWorld updateCloseObjects
. over uvWorld updateWheelEvents
. over uvWorld (updateMouseInventorySelection (u ^. uvConfig))
. over uvWorld (updateMouseOverInventory (u ^. uvConfig))
. over uvWorld (updateMouseOverCombineInventory (u ^. uvConfig))
. over uvWorld (updateMouseContext (u ^. uvConfig))
. over uvWorld zoneClouds
. over uvWorld zoneCreatures
-- . over uvWorld updateInventorySelectionList
@@ -387,24 +387,21 @@ shiftInvItemsDown (_, i) x w = fromMaybe w $ do
f w' i' = swapInvItems g i' w'
g i' m = fst <$> IM.lookupGT i' m
updateMouseOverInventory :: Configuration -> World -> World
updateMouseOverInventory cfig w =
w & hud . hudElement . diMouseOver .~ newmouseover
updateMouseContext :: Configuration -> World -> World
updateMouseContext cfig w =
w & input . mouseContext .~ fromMaybe NoMouseContext
(overinv <|> overcomb <|> overterm)
where
newmouseover = do
overinv = do
sss <- w ^? hud . hudElement . diSections
guard $
ButtonRight `M.notMember` (w ^. input . mouseButtons)
|| not (null $ w ^? hud . hudElement . subInventory . ciSelection)
inverseSelNumPos cfig (invDisplayParams w) sss (w ^. input . mousePos)
updateMouseOverCombineInventory :: Configuration -> World -> World
updateMouseOverCombineInventory cfig w =
w & hud . hudElement . subInventory . ciMouseOver .~ newmouseover
where
newmouseover = do
fmap OverInv $ inverseSelNumPos cfig (invDisplayParams w) sss (w ^. input . mousePos)
overcomb = do
sss <- w ^? hud . hudElement . subInventory . ciSections
inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
fmap OverCombInv $ inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
overterm = Nothing
updateWheelEvents :: World -> World
updateWheelEvents w
src/Dodge/Update/Input/InGame.hs
+2 -3
View File
@@ -108,7 +108,7 @@ updateCombineInvClick ::
World ->
World
updateCombineInvClick msel sss w = fromMaybe trydocombination $ do
(i,j) <- w ^? hud . hudElement . diMouseOver . _Just
(i,j) <- w ^? input . mouseContext . mcoInv
guard $ i == 0
str <- fmap (take 5) $ w
^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
@@ -118,7 +118,7 @@ updateCombineInvClick msel sss w = fromMaybe trydocombination $ do
& hud . hudElement . subInventory . ciFilter .~ Nothing
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str)
where
trydocombination = case w ^? hud . hudElement . subInventory . ciMouseOver . _Just of
trydocombination = case w ^? input . mouseContext . mcoCombInv of
x@(Just (i,_))
| x /= msel -> w & hud . hudElement . subInventory . ciSelection .~ x
& worldEventFlags . at CombineInventoryChange ?~ ()
@@ -330,7 +330,6 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
, -- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
_diInvFilter = mempty
, _diCloseFilter = mempty
, _diMouseOver = Nothing
}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte