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

Work towards unifying all in game input

Browse Source
This commit is contained in:
justin
2023-02-21 00:37:26 +00:00
parent 7b9b1d1799
commit dee7472d31
5 changed files with 127 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -19,7 +19,7 @@ import qualified SDL
-- | The AI equivalent for your control.
yourControl :: Creature -> World -> World
yourControl cr w
| inputFocus w = w
| inInputFocus w = w
| not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr)
%~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
| otherwise =
src/Dodge/Data/SelectionList.hs
+5
View File
@@ -43,6 +43,11 @@ data SelectionSections a = SelectionSections
, _sssSelPos :: Maybe (Int,Int)
}
--data SSSExtra :: SSSExtra
-- { _sssSelPos :: Maybe (Int,Int)
-- , _sssFilters :: IntMap (Maybe String
-- }
data SectionCursor = SectionCursor
{ _scurPos :: Int
, _scurSize :: Int
src/Dodge/InputFocus.hs
+110 -22
View File
@@ -1,13 +1,19 @@
module Dodge.InputFocus
( inTermFocus
, inInvRegex
, inCloseRegex
, inSubInvRegex
, inputFocus
) where
module Dodge.InputFocus (
inTermFocus,
inInvRegex,
inCloseRegex,
inSubInvRegex,
inputFocus,
inInputFocus,
regexScope,
regexFocus,
-- , inputFocus'
) where
import Dodge.Data.SelectionList
import Control.Monad
import Data.IntMap.Strict (IntMap)
import Data.Maybe
import Dodge.Data.SelectionList
import Dodge.Data.World
import LensHelp
@@ -18,23 +24,105 @@ inTermFocus w = fromMaybe False $ do
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
return $ hasfocus && connectionstatus == TerminalReady
inInvRegex :: World -> Bool
regexScope ::
(Applicative f1, Applicative f2, Num c) =>
World ->
Maybe
( ( IntMap (Maybe String) ->
f1 (IntMap (Maybe String))
) ->
HUDElement ->
f1 HUDElement
, (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) ->
HUDElement ->
f2 HUDElement
, c
)
regexScope w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of
Just (-1, _) -> di (-1)
Just (0, _) -> di (-1)
Just (2, _) -> di 2
Just (3, _) -> di 2
_ -> Nothing
Just CombineInventory{} ->
Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1))
_ -> Nothing
where
di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x)
he = w ^. hud . hudElement
regexFocus ::
(Applicative f1, Applicative f2, Num c) =>
World ->
Maybe
( ( IntMap (Maybe String) ->
f1 (IntMap (Maybe String))
) ->
HUDElement ->
f1 HUDElement
, (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) ->
HUDElement ->
f2 HUDElement
, c
)
regexFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of
Just (-1, _) -> di (-1)
Just (2, _) -> di 2
_ -> Nothing
Just CombineInventory{} ->
Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1))
_ -> Nothing
where
di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x)
he = w ^. hud . hudElement
inInputFocus :: World -> Bool
inInputFocus = isJust . inputFocusI
inputFocusI :: World -> Maybe ((String -> Identity String) -> World -> Identity World)
inputFocusI = inputFocus
inputFocus ::
Applicative f =>
World ->
Maybe ((String -> f String) -> World -> f World)
inputFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of
Just (-1, _) -> di (-1)
Just (2, _) -> di 2
_ -> Nothing
Just CombineInventory{} -> case he ^? subInventory . ciSections . fssSections . sssSelPos . _Just of
Just (-1, _) -> Just $ hud . hudElement . subInventory . ciSections . fssFilters . ix (-1) . _Just
_ -> Nothing
Just DisplayTerminal{_termID = tmid} -> do
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
guard $ hasfocus && connectionstatus == TerminalReady
return $ cWorld . lWorld . terminals . ix tmid . tmInput . tiText
_ -> Nothing
where
di x = Just $ hud . hudElement . diSections . fssFilters . ix x . _Just
he = w ^. hud . hudElement
inInvRegex :: World -> Bool
inInvRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1)
sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1)
inCloseRegex :: World -> Bool
inCloseRegex :: World -> Bool
inCloseRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == 2
sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == 2
inSubInvRegex :: World -> Bool
inSubInvRegex :: World -> Bool
inSubInvRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . subInventory . ciSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1)
sss <- w ^? hud . hudElement . subInventory . ciSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1)
inputFocus :: World -> Bool
inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w
--inputFocus :: World -> Bool
--inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w
src/Dodge/Update/Camera.hs
+1 -1
View File
@@ -194,7 +194,7 @@ rotateCamera cfig w
| keydown SDL.ScancodeE = over cWorld (rotateCameraBy (-0.025)) w
| otherwise = ifConfigWallRotate cfig w
where
keydown scode = scode `M.member` _pressedKeys (_input w) && not (inputFocus w)
keydown scode = scode `M.member` _pressedKeys (_input w) && not (inInputFocus w)
zoomFromItem ::
ItZoom ->
src/Dodge/Update/Input.hs
+10 -13
View File
@@ -59,6 +59,9 @@ updateUseInputInGame h u = case h of
CombineInventory {_ciSections = FilterableSections {_fssSections = sss}}
| inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1)
| lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u
-- _ -> case regexFocus w of
-- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys
-- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput
_ | inInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1)
_ | inCloseRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u 2
_ -> M.foldlWithKey' updateKeyInGame u pkeys
@@ -82,13 +85,6 @@ maybeExitCombine u
doTextInputOver :: ASetter' Universe String -> Universe -> Universe
doTextInputOver p u = doTextInputOver' u p u
-- u & p %~ (++ map toUpper thetext)
-- & checkBackspace
-- where
-- thetext = u ^. uvWorld . input . textInput
-- checkBackspace
-- | backspaceInputted u = p %~ doBackspace
-- | otherwise = id
doTextInputOver' :: Universe -> ASetter' a String -> a -> a
doTextInputOver' u p x =
@@ -219,21 +215,22 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
| secfocus (-1) 0 ->
w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
.~ InInventory SortInventory
& hud . hudElement . diSections . fssFilters . ix (-1) %~ enterregex
& hud . hudElement . diSections %~ enterregex (-1)
Just NoSubInventory
| secfocus 2 3 ->
w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
& hud . hudElement . diSections . fssFilters . ix 2 %~ enterregex
Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections . fssFilters . ix (-1)
%~ enterregex
& hud . hudElement . diSections %~ enterregex 2
Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ enterregex (-1)
_ -> w
where
di = w ^. hud . hudElement
secfocus a b = fromMaybe False $ do
i <- di ^? diSections . fssSections . sssSelPos . _Just . _1
return $ i == a || i == b
enterregex Nothing = Just ""
enterregex x = x
enterregex x fss = fss & fssFilters . ix x %~ f
& fssSections . sssSelPos ?~ (x,0)
f Nothing = Just ""
f x = x
--overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
--overSection f sss = fromMaybe sss $ do