Tweak combine filtering
This commit is contained in:
@@ -19,7 +19,8 @@ import qualified SDL
|
|||||||
-- | The AI equivalent for your control.
|
-- | The AI equivalent for your control.
|
||||||
yourControl :: Creature -> World -> World
|
yourControl :: Creature -> World -> World
|
||||||
yourControl cr w
|
yourControl cr w
|
||||||
| inTermFocus w = w & updateUsingInput
|
| inTermFocus w = w & updateUsingInput -- do we really want to do this?
|
||||||
|
| inputFocus w = w
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w
|
w
|
||||||
& cWorld . lWorld . creatures . ix (_crID cr)
|
& cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ data Input = Input
|
|||||||
{ _mousePos :: Point2
|
{ _mousePos :: Point2
|
||||||
, _mouseMoving :: Bool
|
, _mouseMoving :: Bool
|
||||||
, _pressedKeys :: M.Map Scancode PressType
|
, _pressedKeys :: M.Map Scancode PressType
|
||||||
, _mouseButtons :: M.Map MouseButton Bool
|
, _mouseButtons :: M.Map MouseButton Bool -- shortpress False, repeatpress True
|
||||||
, _scrollAmount :: Int
|
, _scrollAmount :: Int
|
||||||
, _previousScrollAmount :: Int
|
, _previousScrollAmount :: Int
|
||||||
, _hammers :: M.Map WorldHammer HammerPosition
|
, _hammers :: M.Map WorldHammer HammerPosition
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
module Dodge.InputFocus where
|
module Dodge.InputFocus where
|
||||||
|
|
||||||
|
import Dodge.Data.SelectionList
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import LensHelp
|
import LensHelp
|
||||||
@@ -10,3 +11,7 @@ inTermFocus w = fromMaybe False $ do
|
|||||||
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
|
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
|
||||||
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
|
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
|
||||||
return $ hasfocus && connectionstatus == TerminalReady
|
return $ hasfocus && connectionstatus == TerminalReady
|
||||||
|
|
||||||
|
inputFocus :: World -> Bool
|
||||||
|
inputFocus w = inTermFocus w
|
||||||
|
|| (w ^? hud . hudElement . subInventory . subInvMap . smRegexInput) == Just True
|
||||||
|
|||||||
@@ -45,14 +45,18 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
|
|||||||
|
|
||||||
doSubInvRegexInput :: Universe -> Universe
|
doSubInvRegexInput :: Universe -> Universe
|
||||||
doSubInvRegexInput u
|
doSubInvRegexInput u
|
||||||
| any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash]
|
| endkeys || backspacetonothing || endmouse
|
||||||
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
|
|
||||||
| ScancodeBackspace `M.member` pkeys
|
|
||||||
&& u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex == Just ""
|
|
||||||
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
|
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
|
||||||
|
& uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
|
||||||
| otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex)
|
| otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex)
|
||||||
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
|
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
|
||||||
where
|
where
|
||||||
|
endkeys = any
|
||||||
|
( (== Just InitialPress) . (`M.lookup` pkeys))
|
||||||
|
[ScancodeReturn,ScancodeEscape,ScancodeSlash]
|
||||||
|
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
|
||||||
|
backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex == Just ""
|
||||||
|
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
|
||||||
pkeys = u ^. uvWorld . input . pressedKeys
|
pkeys = u ^. uvWorld . input . pressedKeys
|
||||||
|
|
||||||
doInputScreenInput :: String -> Universe -> Universe
|
doInputScreenInput :: String -> Universe -> Universe
|
||||||
@@ -94,7 +98,13 @@ updateKeyInGame uv sc InitialPress = case sc of
|
|||||||
ScancodeC -> over uvWorld toggleCombineInv uv
|
ScancodeC -> over uvWorld toggleCombineInv uv
|
||||||
-- the following should be put in a more sensible place
|
-- the following should be put in a more sensible place
|
||||||
--ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
|
--ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
|
||||||
ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput) True uv
|
ScancodeSlash -> uv
|
||||||
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True
|
||||||
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
|
||||||
|
ScancodeBackspace -> uv
|
||||||
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True
|
||||||
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
|
||||||
|
|
||||||
-- in fact the whole logic should probably be rethought, oh well
|
-- in fact the whole logic should probably be rethought, oh well
|
||||||
_ -> uv
|
_ -> uv
|
||||||
updateKeyInGame uv sc LongPress = case sc of
|
updateKeyInGame uv sc LongPress = case sc of
|
||||||
|
|||||||
@@ -38,7 +38,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
|
|||||||
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
|
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
|
||||||
| rbDown -> w & changeTweakParam mi yi
|
| rbDown -> w & changeTweakParam mi yi
|
||||||
| otherwise -> w & moveTweakSel yi
|
| otherwise -> w & moveTweakSel yi
|
||||||
DisplayInventory CombineInventory{} -> w & moveCombineSel yi
|
DisplayInventory (CombineInventory SelectionIntMap {_smRegexInput = False}) -> w & moveCombineSel yi
|
||||||
DisplayInventory (DisplayTerminal tmid) -> terminalWheelEvent yi tmid w
|
DisplayInventory (DisplayTerminal tmid) -> terminalWheelEvent yi tmid w
|
||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -24,6 +24,11 @@ setShownIntMap sm = case sm ^. smRegex of
|
|||||||
, _siOffX = 0
|
, _siOffX = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
|
initialSelPos :: SelectionIntMap a -> SelectionIntMap a
|
||||||
|
initialSelPos sm = sm & smSelPos .~ mi
|
||||||
|
where
|
||||||
|
mi = fst <$> ifind (const _siIsSelectable) (sm ^. smShownItems)
|
||||||
|
|
||||||
-- assumes that at least one item is selectable!
|
-- assumes that at least one item is selectable!
|
||||||
-- also assumes that the integer is 1 or -1
|
-- also assumes that the integer is 1 or -1
|
||||||
moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a
|
moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a
|
||||||
@@ -36,10 +41,12 @@ moveSelectionMapStep x sm = fromMaybe sm $ do
|
|||||||
_ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j)
|
_ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j)
|
||||||
|
|
||||||
moveSelectionMapSelection :: Int -> SelectionIntMap a -> SelectionIntMap a
|
moveSelectionMapSelection :: Int -> SelectionIntMap a -> SelectionIntMap a
|
||||||
moveSelectionMapSelection i sm = foldl'
|
moveSelectionMapSelection i sm
|
||||||
|
| any _siIsSelectable (sm ^. smShownItems) = foldl'
|
||||||
(&)
|
(&)
|
||||||
sm
|
sm
|
||||||
(replicate (abs i) (moveSelectionMapStep (signum i)))
|
(replicate (abs i) (moveSelectionMapStep (signum i)))
|
||||||
|
| otherwise = sm & smSelPos .~ Nothing
|
||||||
|
|
||||||
getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
|
getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
|
||||||
getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm
|
getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm
|
||||||
|
|||||||
Reference in New Issue
Block a user