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

Continue improving mouse|inventory interface

Browse Source
This commit is contained in:
justin
2024-11-21 21:04:07 +00:00
parent efef41c9e1
commit 1250e2442a
9 changed files with 165 additions and 148 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Input.hs
+1 -1
View File
@@ -22,7 +22,7 @@ data MouseContext
| MouseInGame
| MouseMenuClick {_mcoMenuClick :: Int}
| MouseMenuCursor
| OverInvDrag {_mcoDragPos :: Maybe Int}
| OverInvDrag {_mcoDragSection :: Int, _mcoMaybeSelect :: Maybe (Int,Int)}
| OverInvDragSelect { _mcoSelStart :: (Int,Int), _mcoSelEnd :: Maybe (Int,Int) }
| OverInvSelect { _mcoInvSelect :: (Int,Int)}
| OverInvFilt { _mcoInvFilt :: (Int,Int)}
src/Dodge/Inventory.hs
+12
View File
@@ -15,6 +15,7 @@ module Dodge.Inventory (
swapInvItems,
scrollAugNextInSection,
isFilteringInv,
swapItemWith,
) where
import qualified Data.IntSet as IS
@@ -174,6 +175,7 @@ changeSwapClose f i w = fromMaybe w $ do
k <- f i ss
return $
w
& swapAnyExtraSelection i k
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject
.~ k
& hud . closeObjects %~ swapIndices i k
@@ -255,6 +257,16 @@ isConnected x = case x ^. locLdtContext of
|| not (null $ x ^. locLDT . ldtLeft)
_ -> True
swapItemWith ::
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
(Int,Int) ->
World ->
World
swapItemWith f (j,i) w = case j of
0 -> w & swapInvItems f i
3 -> w & changeSwapClose f i
_ -> w
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
Just (0, i) -> w & swapInvItems f i
src/Dodge/Render/HUD.hs
+3 -25
View File
@@ -131,29 +131,14 @@ drawMouseOver cfig w = concat (invsel <|> combinvsel
. 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
-- Just (MouseInvSelect s (Just e)) -> Just (s, e)
-- _ -> case w ^? hud . hudElement . diSelectionExtra of
-- Just x | x > 0 -> do
-- (i, j) <- w ^? hud . hudElement . diSelection . _Just
-- return ((i, j), (i, j + x))
-- _ -> Nothing
--drawDISelections :: World -> Picture
--drawDISelections w = fromMaybe mempty $
-- drawDragSelect w <|>
-- drawDragSelected w
drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected cfig w = do
ys <- w ^? hud . hudElement . diSelectionExtra
guard $ not (IS.null ys)
(i,j) <- w ^? hud . hudElement . diSelection . _Just
guard $ i == 0
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
let f x = (selSecDrawCursorAt 15 idp BackdropCursor sss (0, x) <>)
let f x = (selSecDrawCursorAt 15 idp BackdropCursor sss (i, x) <>)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) . IS.foldr f mempty $ IS.insert j ys
@@ -167,13 +152,6 @@ drawDragSelect cfig w = do
let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (i, x)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) . foldMap f $ [min j b .. max j b]
-- fromMaybe mempty $ do
-- ((i, j), (a, b)) <- getMouseInvSel w
-- guard $ i == a
-- sss <- w ^? hud . hudElement . diSections
-- let idp = invDisplayParams w
-- let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (i, x)
-- return . color (withAlpha 0.2 white) . foldMap f $ [min j b .. max j b]
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
@@ -203,14 +181,14 @@ drawExamineInventory cfig w =
<> drawSelectionList
secondColumnParams
cfig
( (map f
( map f
( makeParagraph 55 $
yourAugmentedItem
itemInfo
(yourInfo (you w))
(closeObjectInfo (crNumFreeSlots (you w)))
w
))
)
)
where
f str =
src/Dodge/Render/Picture.hs
+14 -2
View File
@@ -84,8 +84,11 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
MouseMenuClick {} -> drawMenuClick 5
MouseMenuCursor -> drawMenuCursor 5
MouseInGame -> drawPlus 5
OverInvDrag (Just _) -> drawDrag 5
OverInvDrag Nothing -> drawDragDrop 5
OverInvDrag 0 (Just _) -> drawDrag 5
OverInvDrag 0 Nothing -> drawDragDrop 5
OverInvDrag 3 (Just _) -> drawDrag 5
OverInvDrag 3 Nothing -> drawDragPickup 5
OverInvDrag _ _ -> drawEmptySet 5
OverInvDragSelect {} -> drawDragSelect 5
OverInvSelect {} -> drawSelect 5
OverInvFilt {} -> drawCombFilter 5
@@ -175,6 +178,15 @@ drawDragDrop x =
z = 1.5 * x
y = 0.7 * x
drawDragPickup :: Float -> Picture
drawDragPickup x =
line (fmap (+V2 z (-x)) [V2 (-x) x,V2 0 x,V2 0 (-x)])
<> line (fmap (+V2 z (-x)) [V2 (-y) (y-x), V2 0 (-x), V2 y (y-x)])
-- <> drawSelect 5
where
z = 1.5 * x
y = 0.7 * x
--drawFiltDrag :: Float -> Picture
--drawFiltDrag x = polygonWire
-- [ V2 0 y
src/Dodge/TestString.hs
-1
View File
@@ -26,7 +26,6 @@ testStringInit u =
, show $ u ^? uvWorld . hud . hudElement . diSelection
, show $ u ^? uvWorld . hud . hudElement . diSelectionExtra
]
-- fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . each . itLocation . ilIsRoot
-- , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
-- <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]
-- <> map show (IM.elems (L.postscan (L.premap _siHeight L.sum)
src/Dodge/Update.hs
+5 -5
View File
@@ -306,7 +306,7 @@ checkTermDist w = fromMaybe w $ do
updateMouseContext :: Configuration -> Universe -> Universe
updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
OverInvDrag {} -> u & uvWorld . input . mouseContext .~ invdrag
OverInvDrag i _ -> u & uvWorld . input . mouseContext .~ invdrag i
OverInvDragSelect{} -> u
_ -> u & uvWorld . input . mouseContext
.~ fromMaybe
@@ -335,10 +335,10 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| otherwise = MouseInGame
mpos = w ^. input . mousePos
invdrag = fromMaybe (OverInvDrag Nothing) $ do
invdrag i' = fromMaybe (OverInvDrag i' Nothing) $ do
sss <- w ^? hud . hudElement . diSections
(0,j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
return $ OverInvDrag $ Just j
(i,j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
return $ OverInvDrag i' (Just (i,j))
overinv = do
sss <- w ^? hud . hudElement . diSections
selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
@@ -377,7 +377,7 @@ isOverTerminalScreen cfig _ (V2 x y) =
where
ldp = secondColumnParams
V2 xmin ymax = screenPosAbs cfig (ldp ^. ldpPos)
s = (5 + 15 * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
s = 5 + 15 * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap)
-- the 15 is the length of list in the terminal display, don't change
-- without changing drawTerminalDisplay
ymin = ymax - s
src/Dodge/Update/Input/InGame.hs
+44 -30
View File
@@ -3,9 +3,9 @@ module Dodge.Update.Input.InGame (
updateMouseInGame,
) where
import Data.Foldable
import Control.Applicative
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.List (sort)
@@ -95,17 +95,19 @@ updateMouseInGame cfig w = case w ^? input . mouseButtons . ix ButtonLeft of
updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDragSelect{} -> fromMaybe w $ do
OverInvDragSelect sstart _ -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
guard $ Just (fst sstart) == fmap fst msel || isNothing msel
return $ w & input . mouseContext . mcoSelEnd .~ msel
OverInvDrag Nothing -> w
OverInvDrag{} -> fromMaybe w $ do
OverInvDrag k mmouseover -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
_ <- mmouseover
let mpos = w ^. input . mousePos
(0, i) <- w ^? hud . hudElement . diSelection . _Just
(j, i) <- w ^? hud . hudElement . diSelection . _Just
guard $ j == k -- this should always be the case?
x <- w ^? hud . hudElement . diSelectionExtra
return $ w & dragInvItems (IS.insert i x) cfig mpos ldp sss
return $ w & dragInvItems k (IS.insert i x) cfig mpos ldp sss
_ -> w
where
ldp = invDisplayParams w
@@ -119,23 +121,24 @@ dropSelected w = fromMaybe w $ do
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDrag mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
j <- mpos
return $ w & input . mouseContext .~ OverInvSelect (0, j)
guard $ fst j == i
return $ w & input . mouseContext .~ OverInvSelect j
OverInvDragSelect _ Nothing ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelectionExtra .~ mempty
OverInvDragSelect ssel (Just esel) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelectionExtra
.~ h (snd ssel) (snd esel)-- IM.keysSet [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
.~ h (snd ssel) (snd esel) -- IM.keysSet [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
& augInvDirectSelect (min ssel esel)
_ -> w
where
h i j = fold $ do
sss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
let (_,xss) = IM.split ((min i j)-1) sss
(yss,_) = IM.split ((max i j)+1) xss
let (_, xss) = IM.split (min i j -1) sss
(yss, _) = IM.split (max i j + 1) xss
return . IM.keysSet $ yss
updateMouseClickInGame :: Configuration -> World -> World
@@ -189,14 +192,15 @@ startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
(i, j) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
guard $ i == a && b `IS.member` (IS.insert j xs)
guard $ i == a && b `IS.member` IS.insert j xs
return $ setmichosen xs w
where
setmichosen x =
(input . mouseContext .~ OverInvDrag (Just b))
(input . mouseContext .~ OverInvDrag a (Just (a, b)))
. (hud . hudElement . diSelectionExtra .~ x)
dragInvItems ::
Int ->
IS.IntSet ->
Configuration ->
Point2 ->
@@ -204,9 +208,9 @@ dragInvItems ::
IM.IntMap (SelectionSection a) ->
World ->
World
dragInvItems is cfig mpos ldp sss w
dragInvItems j is cfig mpos ldp sss w
| nonconcurrent = collectInvItems is w
| otherwise = shiftInvItems is cfig mpos ldp sss w
| otherwise = shiftInvItems j is cfig mpos ldp sss w
where
nonconcurrent = not $ concurrentIS is
@@ -228,6 +232,7 @@ collectInvItems is w = fromMaybe w $ do
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
shiftInvItems ::
Int ->
IS.IntSet ->
Configuration ->
Point2 ->
@@ -235,26 +240,34 @@ shiftInvItems ::
IM.IntMap (SelectionSection a) ->
World ->
World
shiftInvItems xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
Just p | p < (0, IS.findMin xs) -> shiftInvItemsUp xs w
shiftInvItems j xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
Just p | p < (j, IS.findMin xs) -> fromMaybe w $ do
ss <- sss ^? ix j . ssItems
minsss <- IM.lookupMin ss
guard (IS.findMin xs > fst minsss)
return $ shiftInvItemsUp j xs w
_ -> case inverseSelBoundaryDown cfig ldp sss mpos of
Just p | p > (0, IS.findMax xs) -> shiftInvItemsDown xs w
Just p | p > (j, IS.findMax xs) -> fromMaybe w $ do
ss <- sss ^? ix j . ssItems
maxsss <- IM.lookupMax ss
guard (IS.findMax xs < fst maxsss)
return $ shiftInvItemsDown j xs w
_ -> w
shiftInvItemsUp :: IS.IntSet -> World -> World
shiftInvItemsUp is w = IS.foldl' f w is
shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
shiftInvItemsUp j is w = IS.foldl' f w is
where
f w' i' = swapInvItems g i' w'
f w' i' = swapItemWith g (j, i') w'
g i' m = fst <$> IM.lookupLT i' m
shiftInvItemsDown :: IS.IntSet -> World -> World
shiftInvItemsDown is w = fromMaybe w $ do
shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
shiftInvItemsDown j is w = fromMaybe w $ do
let i = IS.findMax is
guard . isJust $
w ^? hud . hudElement . diSections . ix 0 . ssItems . ix i
return $ IS.foldr f w $ is
w ^? hud . hudElement . diSections . ix j . ssItems . ix i
return $ IS.foldr f w is
where
f i' w' = swapInvItems g i' w'
f i' w' = swapItemWith g (j, i') w'
g i' m = fst <$> IM.lookupGT i' m
updateFunctionKeys :: Universe -> Universe
@@ -301,13 +314,14 @@ updatePressedButtonsCarte' pkeys w
updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u =
u & doTextInputOverUniverse (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
u
& doTextInputOverUniverse
(uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
& checkEndStatus
where
pkeys = u ^. uvWorld . input . pressedKeys
checkEndStatus
| pkeys ^. at ScancodeReturn == Just InitialPress =
over uvWorld (\w -> terminalReturnEffect tmid w)
| u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just InitialPress =
uvWorld %~ terminalReturnEffect tmid
| otherwise = id
updateKeyInGame :: Universe -> Scancode -> PressType -> Universe