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

Reimplement dragging upwards with mouse

Browse Source
This commit is contained in:
justin
2024-10-25 10:29:27 +01:00
parent 388064895f
commit 0c5a21765a
10 changed files with 204 additions and 187 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/HUD.hs
+4 -5
View File
@@ -17,16 +17,15 @@ data HUDElement
{ _subInventory :: SubInventory
, _diSections :: SelectionSections ()
, _diSelection :: Maybe (Int,Int)
, _diSelectionExtra :: Int
}
| DisplayCarte
data MouseInventorySelection
= NoMouseSel
| MouseInvSelect
= MouseInvSelect
{_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
| MouseInvChosen
{ _misExtra :: Int
}
| MouseInvDrag
| MouseInvNothing
data SubInventory
= NoSubInventory
src/Dodge/Default/World.hs
+2 -1
View File
@@ -162,11 +162,12 @@ defaultDisplayInventory :: HUDElement
defaultDisplayInventory =
DisplayInventory
{ _subInventory = NoSubInventory
{_nsSelected = NoMouseSel
{_nsSelected = MouseInvNothing
, _nsMouseOver = Just (0,3)
}
, _diSections = defaultInvSections
, _diSelection = Just (1,0)
, _diSelectionExtra = 0
}
defaultSSSExtra :: SSSExtra
src/Dodge/DisplayInventory.hs
+1 -1
View File
@@ -31,7 +31,7 @@ import Regex
toggleCombineInv :: Universe -> Universe
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory NoMouseSel Nothing
.~ NoSubInventory MouseInvNothing Nothing
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
updateCombinePositioning :: Universe -> Universe
src/Dodge/Inventory/Location.hs
-2
View File
@@ -10,7 +10,6 @@ import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base.You
import Dodge.Data.Item.Use.Consumption.LoadAction
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Item.Grammar
import qualified IntMapHelp as IM
@@ -72,7 +71,6 @@ setInvPosFromSS w =
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where
thesel = fromMaybe SelNothing $ do
sss <- w ^? hud . hudElement . diSections
(i, j) <- w ^? hud . hudElement . diSelection . _Just
case i of
(-1) -> Just SortInventory
src/Dodge/Render/HUD.hs
+25 -24
View File
@@ -6,9 +6,9 @@ module Dodge.Render.HUD (
selNumPosCardinal, -- this shoud probably be pushed back here
) where
import Dodge.SelectionSections
import Control.Lens
import Control.Monad
import Data.List (sort)
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Vector as V
@@ -31,11 +31,11 @@ import Dodge.Render.Connectors
import Dodge.Render.HUD.Carte
import Dodge.Render.List
import Dodge.ScreenPos
import Dodge.SelectionSections
import Dodge.SelectionSections.Draw
import Geometry
import qualified IntMapHelp as IM
import Justify
import Data.List (sort)
import Picture
import SDL (MouseButton (..))
@@ -60,7 +60,9 @@ drawInventory :: SelectionSections () -> World -> Configuration -> Picture
drawInventory sss w cfig =
drawSelectionSections sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
<> iextra
<> translateScreenPos cfig (ldp ^. ldpPos)
<> translateScreenPos
cfig
(ldp ^. ldpPos)
(drawDIMouseOver w)
<> drawDISelections w cfig
<> drawDISelections' w cfig
@@ -75,41 +77,39 @@ drawInventory sss w cfig =
drawDIMouseOver :: World -> Picture
drawDIMouseOver w = fromMaybe mempty $ do
(_,i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
(_, i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0,i) 10 idp sss
return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0, i) 10 idp sss
getMouseInvSel :: World -> Maybe ((Int,Int),(Int,Int))
getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvSelect s (Just e)) -> Just (s,e)
Just (MouseInvSelect s (Just e)) -> Just (s, e)
_ -> Nothing
getMouseInvSel' :: World -> Maybe ((Int,Int),(Int,Int))
getMouseInvSel' w = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvChosen x) -> do
(i,j) <- w ^? hud . hudElement . diSelection . _Just
return ((i,j),(i,j+x))
_ -> Nothing
getMouseInvSel' :: World -> Maybe ((Int, Int), (Int, Int))
getMouseInvSel' w = do
x <- w ^? hud . hudElement . diSelectionExtra
(i, j) <- w ^? hud . hudElement . diSelection . _Just
return ((i, j), (i, j + x))
drawDISelections :: World -> Configuration -> Picture
drawDISelections w cfig = fromMaybe mempty $ do
((i,j),(a,b)) <- getMouseInvSel w
((i, j), (a, b)) <- getMouseInvSel w
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
tp <- selNumPosCardinal NorthWest8 cfig idp sss i j
bp <- selNumPosCardinal SouthWest8 cfig idp sss a b
return . color red . line $ sort [tp,bp]
return . color red . line $ sort [tp, bp]
drawDISelections' :: World -> Configuration -> Picture
drawDISelections' w cfig = fromMaybe mempty $ do
((i,j),(a,b)) <- getMouseInvSel' w
((i, j), (a, b)) <- getMouseInvSel' w
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
tp <- selNumPosCardinal NorthEast8 cfig idp sss i j
bp <- selNumPosCardinal SouthEast8 cfig idp sss a b
return . color green . line $ sort [tp,bp]
return . color green . line $ sort [tp, bp]
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
@@ -246,9 +246,12 @@ inventoryExtraH sss cfig w i is = fromMaybe mempty $ do
where
snum = selNumPos cfig (invDisplayParams w) sss 0
combineInventoryExtra :: SelectionSections CombinableItem
-> Maybe (Int,Int)
-> Configuration -> World -> Picture
combineInventoryExtra ::
SelectionSections CombinableItem ->
Maybe (Int, Int) ->
Configuration ->
World ->
Picture
combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
(i, j) <- msel
cpos <- selSecYint i j sss
@@ -379,6 +382,7 @@ selNumPos ::
Int ->
Maybe Point2
selNumPos = selNumPosCardinal West8
--selNumPos cfig ldp sss i j = do
-- ipos <- selSecYint i j sss
-- size <- selSecSelSize i j sss
@@ -416,8 +420,5 @@ selNumPosCardinal card cfig ldp sss i j = do
s = _ldpScale ldp
ygap = _ldpVerticalGap ldp
selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor
src/Dodge/Terminal.hs
+2 -1
View File
@@ -222,7 +222,8 @@ disconnectTerminal tm =
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing
Just _ -> w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
_ -> w
damageCodeCommand :: TerminalCommand
src/Dodge/Update.hs
+33 -26
View File
@@ -292,7 +292,8 @@ checkTermDist w = fromMaybe w $ do
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
guard $ dist btpos (_crPos $ you w) > 40
return (w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing)
return $ w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
updateMouseInventorySelection :: Configuration -> World -> World
updateMouseInventorySelection cfig w = fromMaybe w $ do
@@ -311,28 +312,19 @@ updateMouseInventorySelection' sss cfig w
| leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
Just MouseInvSelect{} ->
w & hud . hudElement . subInventory . nsSelected . misMaybeEnd .~ msel
Just (MouseInvChosen x) -> shiftInvItems x w
-- | maybe False (< ssel) $ inverseSelBoundaryUp cfig ldp sss mpos ->
-- w
-- & shiftInvItemsUp ssel esel (inverseSelBoundaryUp cfig ldp sss mpos)
-- Just (MouseInvChosen ssel esel)
-- | maybe False (> esel) $ inverseSelBoundaryDown cfig ldp sss mpos ->
-- w
-- & shiftInvItemsDown ssel esel (inverseSelBoundaryDown cfig ldp sss mpos)
-- Just (MouseInvChosen{}) -> w
_ ->
w
& hud . hudElement . subInventory . nsSelected .~ NoMouseSel
Just MouseInvDrag -> fromMaybe w $ do
sel <- w ^? hud . hudElement . diSelection . _Just
return $ w & shiftInvItems sel cfig mpos ldp sss
_ -> w
| otherwise = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvSelect ssel (Just esel)) ->
w
& hud . hudElement . subInventory . nsSelected
.~ MouseInvChosen (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
& hud . hudElement . diSelectionExtra
.~ (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
& augInvDirectSelect (min ssel esel)
Just (MouseInvSelect _ Nothing) ->
w
& hud . hudElement . subInventory . nsSelected .~ NoMouseSel
_ -> w
w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
_ -> w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
where
leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0 && nobuttonright
leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons) && nobuttonright
@@ -345,16 +337,31 @@ updateMouseInventorySelection' sss cfig w
startDrag :: (Int,Int) -> World -> World
startDrag (a,b) w = fromMaybe (augInvDirectSelect (a,b) $ setmichosen 0 w) $ do
(i,j) <- w ^? hud . hudElement . diSelection . _Just
x <- w ^? hud . hudElement . subInventory . nsSelected . misExtra
x <- w ^? hud . hudElement . diSelectionExtra
guard $ i == a && b >= j && b <= j + x
return w
return $ setmichosen x w
where
setmichosen x = hud . hudElement . subInventory . nsSelected .~ MouseInvChosen x
-- & hud . hudElement . subInventory . nsSelected %~ startdrag p
setmichosen x = (hud . hudElement . subInventory . nsSelected .~ MouseInvDrag)
. (hud . hudElement . diSelectionExtra .~ x)
shiftInvItems :: Int -> World -> World
shiftInvItems x w = w
shiftInvItems :: (Int,Int) -> Configuration -> Point2
-> ListDisplayParams
-> SelectionSections a
-> World
-> World
shiftInvItems topsel cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
Just p | p < topsel -> shiftInvItemsUp sss topsel w
_ -> w
where
mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
shiftInvItemsUp :: SelectionSections a -> (Int,Int) -> World -> World
shiftInvItemsUp sss (_,i) w = fromMaybe w $ do
x <- w ^? hud . hudElement . diSelectionExtra
return $ foldl' f w [i..i+x]
where
f w' i' = swapInvItems g i' w'
g i' m = fmap fst $ IM.cycleLT i' m
--shiftInvItemsUp :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
--shiftInvItemsUp (_, i) (_, j) Just{} w =
src/Dodge/Update/Input/InGame.hs
+34 -19
View File
@@ -51,7 +51,7 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
_
| inInvRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement %~ dodisplayregexinput (-1)
-- . diSections %~ doRegexInput (u ^. uvWorld . input) (-1)
-- . diSections %~ doRegexInput (u ^. uvWorld . input) (-1)
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
_
@@ -68,15 +68,17 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
docombineregexinput ci = fromMaybe ci $ do
sss <- ci ^? ciSections
msel <- ci ^? ciSelection
let (sss',msel') = doRegexInput (u ^. uvWorld . input) (-1) sss msel
return $ ci & ciSections .~ sss'
& ciSelection .~ msel'
let (sss', msel') = doRegexInput (u ^. uvWorld . input) (-1) sss msel
return $
ci & ciSections .~ sss'
& ciSelection .~ msel'
dodisplayregexinput x di = fromMaybe di $ do
sss <- di ^? diSections
msel <- di ^? diSelection
let (sss',msel') = doRegexInput (u ^. uvWorld . input) x sss msel
return $ di & diSections .~ sss'
& diSelection .~ msel'
let (sss', msel') = doRegexInput (u ^. uvWorld . input) x sss msel
return $
di & diSections .~ sss'
& diSelection .~ msel'
updatePressedButtonsCarte :: World -> World
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
@@ -146,18 +148,25 @@ updateLongPressInGame uv sc = case sc of
ScancodeSpace -> over uvWorld spaceAction uv
_ -> uv
doRegexInput :: Input -> Int -> SelectionSections a -> Maybe (Int,Int)
-> (SelectionSections a, Maybe (Int,Int))
doRegexInput ::
Input ->
Int ->
SelectionSections a ->
Maybe (Int, Int) ->
(SelectionSections a, Maybe (Int, Int))
doRegexInput inp i sss msel
| backspacetonothing || escapekey = endregex i 0
| endkeys || endmouse = endregex (i + 1) (j -1)
| otherwise = (sss & doTextInputOver inp (sssExtra . sssFilters . ix i . _Just)
, msel)
| otherwise =
( sss & doTextInputOver inp (sssExtra . sssFilters . ix i . _Just)
, msel
)
where
endregex a b =
(sss & sssExtra . sssFilters . ix i .~ Nothing
( sss & sssExtra . sssFilters . ix i .~ Nothing
& sssSections . ix i . ssItems .~ mempty
, msel & ssSetCursor (ssLookupDown a b) sss)
, msel & ssSetCursor (ssLookupDown a b) sss
)
j = fromMaybe 0 $ do
itms <- sss ^? sssSections . ix (i + 1) . ssItems
fst <$> IM.lookupMin itms
@@ -247,9 +256,12 @@ spaceAction w = case w ^. hud . hudElement of
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing
w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
& worldEventFlags . at InventoryChange ?~ ()
_ -> w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing
_ ->
w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
where
theLoc =
doWorldPos
@@ -261,22 +273,24 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
DisplayCarte ->
u & uvWorld . hud . hudElement
.~ DisplayInventory
{ _subInventory = NoSubInventory NoMouseSel Nothing
{ _subInventory = NoSubInventory MouseInvNothing Nothing
, _diSections = defaultInvSections
, _diSelection = Nothing
, _diSelectionExtra = 0
}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory NoMouseSel Nothing
Just ExamineInventory{} -> w
& thepointer .~ NoSubInventory MouseInvNothing Nothing
_ -> w & thepointer .~ ExamineInventory -- mi
where
thepointer = hud . hudElement . subInventory
-- mi = 0 <$ (yourSelectedItem w >>= (^? itTweaks . tweakParams . ix 0))
tryCombine :: SelectionSections CombinableItem -> Maybe (Int,Int) -> World -> World
tryCombine :: SelectionSections CombinableItem -> Maybe (Int, Int) -> World -> World
tryCombine sss msel w = fromMaybe w $ do
(i, j) <- msel
CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
@@ -287,4 +301,5 @@ tryCombine sss msel w = fromMaybe w $ do
maybeExitCombine :: Universe -> Universe
maybeExitCombine u
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) = u
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing
| otherwise = u & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing