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

Cleanup

Browse Source
This commit is contained in:
justin
2025-08-26 16:19:49 +01:00
parent f7fd747a7c
commit 596880f76a
1 changed files with 91 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input/InGame.hs
+91 -103
View File
@@ -5,11 +5,6 @@ module Dodge.Update.Input.InGame (
updateMouseInGame,
) where
import Dodge.Data.CardinalPoint
import Dodge.Inventory.CheckSlots
import Dodge.Base.Collide
import Geometry.Vector
import Dodge.Data.Terminal.Status
import Control.Applicative
import Control.Monad
import Data.Foldable
@@ -19,14 +14,18 @@ import Data.List (sort)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Dodge.Base.Collide
import Dodge.Camera
import Dodge.Creature.Action
import Dodge.Data.CardinalPoint
import Dodge.Data.Combine
import Dodge.Data.Terminal.Status
import Dodge.Data.Universe
import Dodge.DisplayInventory
import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Inventory.Add
import Dodge.Inventory.CheckSlots
import Dodge.Item.Display
import Dodge.Item.InvSize
import Dodge.ListDisplayParams
@@ -38,8 +37,7 @@ import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.Update.Input.DebugTest
import Dodge.Update.Input.Text
--import Dodge.WorldPos
--import Geometry
import Geometry.Vector
import LensHelp
import NewInt
import SDL
@@ -50,25 +48,23 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
DisplayTerminal tmid -> updateKeysInTerminal tmid u
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
u
& uvWorld . hud . hudElement . subInventory
%~ docombineregexinput sss msel
& tohud . subInventory %~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_
| disel ^? _Just . _1 == Just (-1) ->
u
& uvWorld . hud . hudElement
%~ dodisplayregexinput diInvFilter diInvFilter (-1)
& tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1)
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
_
| disel ^? _Just . _1 == Just 2 ->
u
& uvWorld . hud . hudElement
%~ dodisplayregexinput diCloseFilter diCloseFilter 2
& tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
tohud = uvWorld . hud . hudElement
pkeys = u ^. uvWorld . input . pressedKeys
dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
sss <- di ^? diSections
@@ -99,21 +95,28 @@ updateMouseInGame cfig w
updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDragSelect {} | ButtonRight `M.member` (w ^. input . mouseButtons)
-> w & input . mouseContext .~ MouseGameRotate
OverInvDragSelect (Just sstart) _ -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
let msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
return $ case msel of
OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) ->
w & input . mouseContext .~ MouseGameRotate
OverInvDragSelect (Just sstart) _ ->
let sss = w ^. hud . hudElement . diSections
msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
in case msel of
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
Just (i,j) | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
Just (i, j)
| i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
| i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0
| otherwise -> w & input . mouseContext . mcoSelEnd .~ fmap fst
(IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
| otherwise ->
w & input . mouseContext . mcoSelEnd
.~ fmap
fst
(IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
-- not sure how the above performs when filtering...
OverInvDragSelect Nothing _ -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
ysel <- inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss
ysel <-
inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
sss
^? nonInf
guard (isGroupSelectableSection $ fst ysel)
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
@@ -122,7 +125,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0) -- > 0 ?
guard (n /= 0)
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
@@ -150,15 +153,12 @@ tryPickupSelected k mpos w = do
ispickup = map (_unNInt . _itID) itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Just (0, j) ->
foldr (pickUpItemAt j 0) w ispickup
& newdisel j xs
_ ->
foldl' (flip $ pickUpItem 0) w ispickup
& newdisel (length (cr ^. crInv)) xs
Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j xs
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs
where
newdisel j xs = hud . hudElement . diSelection ?~
(0 , j , IS.fromDistinctAscList [j .. j + IS.size xs -1])
newdisel j xs =
hud . hudElement . diSelection
?~ (0, j, IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do
NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j
@@ -176,17 +176,12 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
( maybe
mempty
(h ssel)
( guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1)
>> mesel ^? _Just
)
(guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1) >> mesel ^? _Just)
)
OverInvDragSelect _ Nothing ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
OverInvDragSelect (Just ssel) (Just esel) ->
w & input . mouseContext .~ MouseInGame
& invSetSelection (f (fst ssel, esel) (h ssel esel))
OverInvDragSelect Nothing _ ->
OverInvDragSelect{} ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
_ -> w
@@ -208,20 +203,21 @@ isGroupSelectableSection = \case
updateMouseClickInGame :: Configuration -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
sss <- w ^? hud . hudElement . diSections
ysel <- inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss ^? nonInf
let sss = w ^. hud . hudElement . diSections
ysel <-
inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
sss
^? nonInf
guard (isGroupSelectableSection $ fst ysel)
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
OverInvSelect (-1, _)
| selsec == Just (-1) ->
w
& hud . hudElement . diSelection %~ endRegex (-1) w
w & hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing
OverInvSelect (2, _)
| selsec == Just 2 ->
w
& hud . hudElement . diSelection %~ endRegex 2 w
w & hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diCloseFilter .~ Nothing
OverInvSelect x
| ScancodeLShift `M.member` (w ^. input . pressedKeys)
@@ -252,11 +248,13 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
str <-
fmap (take 5) $
w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j)
>>= \k -> w ^? cWorld . lWorld . items . ix k
>>= (listToMaybe . basicItemDisplay)
>>= \k ->
w ^? cWorld . lWorld . items . ix k
>>= (listToMaybe . basicItemDisplay)
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
case w ^? hud . hudElement . subInventory . ciFilter . _Just of
Just ('#' : xs) | str == xs ->
Just ('#' : xs)
| str == xs ->
w & hud . hudElement . subInventory . ciFilter .~ Nothing
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str)
_ -> w
@@ -265,28 +263,24 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
selsec = w ^? hud . hudElement . diSelection . _Just . _1
endRegex :: Int -> World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endRegex i w = fromMaybe id $ do
sss <- w ^? hud . hudElement . diSections
let j = fromMaybe 0 $ do
itms <- sss ^? ix i . ssItems
(k, _) <- IM.lookupMin itms
return k
return $ ssSetCursor (ssLookupDown i j) sss
endRegex i w = ssSetCursor (ssLookupDown i j) sss
where
sss = w ^. hud . hudElement . diSections
j = maybe 0 fst $ IM.lookupMin =<< sss ^? ix i . ssItems
endCombineRegex :: World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endCombineRegex w = fromMaybe id $ do
sss <- w ^? hud . hudElement . subInventory . ciSections
let j = fromMaybe 0 $ do
endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
where
sss = w ^. hud . hudElement . subInventory . ciSections
j = fromMaybe 0 $ do
itms <- sss ^? ix 0 . ssItems
(k, _) <- IM.lookupMin itms
return (k -1)
return $ ssSetCursor (ssLookupDown 0 j) sss
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext
$ case w ^? hud . hudElement . diSelection . _Just of
Just (i,_,xs) | i == a && b `IS.member` xs -> w
_ -> invSetSelection (a, b, IS.singleton b) w
startDrag (a, b) w = setcontext $ case w ^? hud . hudElement . diSelection . _Just of
Just (i, _, xs) | i == a && b `IS.member` xs -> w
_ -> invSetSelection (a, b, IS.singleton b) w
where
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
@@ -294,7 +288,7 @@ concurrentIS :: IS.IntSet -> Bool
concurrentIS = go . IS.minView
where
go x = fromMaybe True $ do
(i,is) <- x
(i, is) <- x
(j, js) <- IS.minView is
return $ i + 1 == j && go (Just (j, js))
@@ -320,9 +314,11 @@ shiftInvItems ::
shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
let xk = fst x
let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
bn = (\v -> inverseSelSecYint (yint + 1) v ^? nonInf)
bn =
(\v -> inverseSelSecYint (yint + 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections
ab = (\v -> inverseSelSecYint (yint - 1) v ^? nonInf)
ab =
(\v -> inverseSelSecYint (yint - 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections
guard $ xk == k || xk + 1 == k || xk -1 == k
(maxi, _) <- IS.maxView xs
@@ -354,8 +350,7 @@ shiftInvItemsUp j is w = IS.foldl' f w is
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 j . ssItems . ix i
guard . isJust $ w ^? hud . hudElement . diSections . ix j . ssItems . ix i
return $ IS.foldr f w is
where
f i' w' = swapItemWith g (j, i') w'
@@ -363,10 +358,7 @@ shiftInvItemsDown j is w = fromMaybe w $ do
updateFunctionKeys :: Universe -> Universe
updateFunctionKeys u =
M.foldlWithKey'
updateFunctionKey
u
(u ^. uvWorld . input . pressedKeys)
M.foldlWithKey' updateFunctionKey u (u ^. uvWorld . input . pressedKeys)
updateFunctionKey :: Universe -> Scancode -> Int -> Universe
updateFunctionKey uv sc 0 = case sc of
@@ -392,8 +384,9 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
x <- u ^? uvWorld . cWorld . lWorld . buttons . ix (tm ^. tmButtonID) . btPos
y <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
return $ case tm ^. tmStatus of
_ | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld))
-> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
_
| dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) ->
u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
TerminalPressTo{} -> updateKeyContinueTerminal tmid u
@@ -401,8 +394,7 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
updateKeyContinueTerminal :: Int -> Universe -> Universe
updateKeyContinueTerminal tmid u
| elem 0 $ u ^. uvWorld . input . pressedKeys =
u & uvWorld %~ continueTerminal tmid
| elem 0 $ u ^. uvWorld . input . pressedKeys = u & uvWorld %~ continueTerminal tmid
| otherwise = u
continueTerminal :: Int -> World -> World
@@ -421,7 +413,8 @@ updateKeysTextInputTerminal tmid u =
uvWorld %~ terminalReturnEffect tmid
| otherwise = id
tryTabComplete
| u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 = uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld)
| u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 =
uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld)
| otherwise = id
updateKeyInGame :: Universe -> Scancode -> Int -> Universe
@@ -452,10 +445,10 @@ updateLongPressInGame uv = \case
doRegexInput ::
Input ->
Int ->
IM.IntMap (SelectionSection a) ->
IMSS a ->
Maybe (Int, Int, IS.IntSet) ->
Maybe String ->
(IM.IntMap (SelectionSection a), Maybe (Int, Int, IS.IntSet), Maybe String)
(IMSS a, Maybe (Int, Int, IS.IntSet), Maybe String)
doRegexInput inp i sss msel filts
| backspacetonothing || escapekey = endregex i 0
| endkeys = endregex (i + 1) (j -1)
@@ -474,10 +467,7 @@ doRegexInput inp i sss msel filts
itms <- sss ^? ix (i + 1) . ssItems
fst <$> IM.lookupMin itms
escapekey = ScancodeEscape `M.lookup` pkeys == Just 0
endkeys =
any
((== Just 0) . (`M.lookup` pkeys))
[ScancodeReturn, ScancodeSlash]
endkeys = any ((== Just 0) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash]
backspacetonothing =
filts == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just 0
@@ -485,10 +475,12 @@ doRegexInput inp i sss msel filts
updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory{} | secfocus (-1) 0 ->
Just NoSubInventory{}
| secfocus (-1) 0 ->
w & hud . hudElement %~ trybackspace (-1) diInvFilter diInvFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory{} | secfocus 2 3 ->
Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} ->
@@ -510,10 +502,12 @@ updateBackspaceRegex w = case di ^? subInventory of
updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{} | secfocus [-1, 0, 1] ->
Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
w & hud . hudElement . diSelection ?~ (-1, 0, mempty)
& hud . hudElement . diInvFilter %~ enterregex
Just NoSubInventory{} | secfocus [2, 3] ->
Just NoSubInventory{}
| secfocus [2, 3] ->
w & hud . hudElement . diSelection ?~ (2, 0, mempty)
& hud . hudElement . diCloseFilter %~ enterregex
Just CombineInventory{} ->
@@ -527,34 +521,28 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
enterregex = (<|> Just "")
pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
& pauseSound
pauseGame u = u & uvScreenLayers .~ [pauseMenu u] & pauseSound
spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement of
DisplayInventory{_subInventory = NoSubInventory{}} ->
maybe id interactWithCloseObj (getCloseObj w) w
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w
& hud . hudElement . subInventory .~ NoSubInventory
& worldEventFlags . at InventoryChange ?~ ()
spaceAction w = case w ^. hud . hudElement . subInventory of
NoSubInventory -> maybe id interactWithCloseObj (getCloseObj w) w
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
where
topcitem = do
k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems)
>>= (fmap fst . IM.lookupMin)
Left <$> w ^? hud . closeItems . ix k'
k <- (w ^? hud . hudElement . diSections . ix 3 . ssItems)
>>= (fmap fst . IM.lookupMin)
Left <$> w ^? hud . closeItems . ix k
topcbut = do
k <- w ^? hud . closeButtons . ix 0
Right <$> w ^? cWorld . lWorld . buttons . ix k
tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do
sss <- w ^? hud . hudElement . subInventory . ciSections
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just
CombinableItem is it <- w ^? hud . hudElement . subInventory
. ciSections . ix i . ssItems . ix j . siPayload . _Just
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $
(createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is)))