109 lines
3.6 KiB
Haskell
109 lines
3.6 KiB
Haskell
module Dodge.InputFocus (
|
|
inTermFocus,
|
|
inInvRegex,
|
|
inCloseRegex,
|
|
inSubInvRegex,
|
|
inputFocus,
|
|
inInputFocus,
|
|
regexScope,
|
|
regexFocus,
|
|
-- , inputFocus'
|
|
) where
|
|
|
|
import Control.Monad
|
|
--import Data.IntMap.Strict (IntMap)
|
|
import Data.Maybe
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.World
|
|
import LensHelp
|
|
|
|
inTermFocus :: World -> Bool
|
|
inTermFocus w = fromMaybe False $ do
|
|
tmid <- w ^? hud . hudElement . subInventory . termID
|
|
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
|
|
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
|
|
return $ hasfocus && connectionstatus == TerminalReady
|
|
|
|
regexScope ::
|
|
(Applicative f) =>
|
|
World ->
|
|
Maybe
|
|
((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int)
|
|
regexScope w = case w ^? hud . hudElement . subInventory of
|
|
Just NoSubInventory -> case he ^? diSections . sssExtra . 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 . sssExtra, -1)
|
|
_ -> Nothing
|
|
where
|
|
di x = Just (diSections . sssExtra, x)
|
|
he = w ^. hud . hudElement
|
|
|
|
regexFocus ::
|
|
(Applicative f) =>
|
|
World ->
|
|
Maybe
|
|
((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int)
|
|
regexFocus w = case w ^? hud . hudElement . subInventory of
|
|
Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of
|
|
Just (-1, _) -> di (-1)
|
|
Just (2, _) -> di 2
|
|
_ -> Nothing
|
|
Just CombineInventory{} ->
|
|
Just (subInventory . ciSections . sssExtra, -1)
|
|
_ -> Nothing
|
|
where
|
|
di x = Just (diSections . sssExtra, 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 . sssExtra . sssSelPos . _Just of
|
|
Just (-1, _) -> di (-1)
|
|
Just (2, _) -> di 2
|
|
_ -> Nothing
|
|
Just CombineInventory{} -> case he ^? subInventory . ciSections . sssExtra . sssSelPos . _Just of
|
|
Just (-1, _) -> Just $ hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . 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 . sssExtra . sssFilters . ix x . _Just
|
|
he = w ^. hud . hudElement
|
|
|
|
inTopRegex :: Int -> World -> Bool
|
|
inTopRegex x w = fromMaybe False $ do
|
|
i <- w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _1
|
|
return $ i == x
|
|
|
|
inInvRegex :: World -> Bool
|
|
inInvRegex = inTopRegex (-1)
|
|
|
|
inCloseRegex :: World -> Bool
|
|
inCloseRegex = inTopRegex 2
|
|
|
|
inSubInvRegex :: World -> Bool
|
|
inSubInvRegex w = fromMaybe False $ do
|
|
i <- w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos . _Just . _1
|
|
return $ i == (-1)
|
|
|
|
--inputFocus :: World -> Bool
|
|
--inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w
|