{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Monomer.Widgets.Singles.Base.InputField (
InputFieldValue,
InputWheelHandler,
InputDragHandler,
InputFieldCfg(..),
InputFieldState(..),
HistoryStep,
inputField_
) where
import Control.Applicative ((<|>))
import Control.Monad
import Control.Lens
(ALens', (&), (.~), (?~), (%~), (^.), (^?), _2, _Just, cloneLens, non)
import Data.Default
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Text (Text)
import Data.Typeable
import GHC.Generics
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import Monomer.Helper
import Monomer.Widgets.Single
import qualified Monomer.Lens as L
type InputFieldValue a = (Eq a, Show a, Typeable a)
type InputWheelHandler a
= InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
type InputDragHandler a
= InputFieldState a
-> Point
-> Point
-> (Text, Int, Maybe Int)
data InputFieldCfg s e a = InputFieldCfg {
InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder :: Maybe Text,
InputFieldCfg s e a -> a
_ifcInitialValue :: a,
InputFieldCfg s e a -> WidgetData s a
_ifcValue :: WidgetData s a,
InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid :: Maybe (WidgetData s Bool),
InputFieldCfg s e a -> [Bool -> e]
_ifcValidV :: [Bool -> e],
InputFieldCfg s e a -> Bool
_ifcDefCursorEnd :: Bool,
InputFieldCfg s e a -> Double
_ifcDefWidth :: Double,
InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth :: Maybe Double,
InputFieldCfg s e a -> Maybe Int
_ifcCaretMs :: Maybe Int,
InputFieldCfg s e a -> Maybe Char
_ifcDisplayChar :: Maybe Char,
InputFieldCfg s e a -> Bool
_ifcResizeOnChange :: Bool,
InputFieldCfg s e a -> Bool
_ifcSelectOnFocus :: Bool,
InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText :: Text -> Maybe a,
InputFieldCfg s e a -> a -> Text
_ifcToText :: a -> Text,
InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput :: Text -> Bool,
InputFieldCfg s e a -> Text -> Bool
_ifcIsValidInput :: Text -> Bool,
InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
_ifcStyle :: Maybe (ALens' ThemeState StyleState),
InputFieldCfg s e a -> Maybe (InputWheelHandler a)
_ifcWheelHandler :: Maybe (InputWheelHandler a),
InputFieldCfg s e a -> Maybe (InputDragHandler a)
_ifcDragHandler :: Maybe (InputDragHandler a),
InputFieldCfg s e a -> Maybe CursorIcon
_ifcDragCursor :: Maybe CursorIcon,
InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnFocusReq :: [Path -> WidgetRequest s e],
InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnBlurReq :: [Path -> WidgetRequest s e],
InputFieldCfg s e a -> [a -> WidgetRequest s e]
_ifcOnChangeReq :: [a -> WidgetRequest s e]
}
data HistoryStep a = HistoryStep {
HistoryStep a -> a
_ihsValue :: a,
HistoryStep a -> Text
_ihsText :: !Text,
HistoryStep a -> Int
_ihsCursorPos :: !Int,
HistoryStep a -> Maybe Int
_ihsSelStart :: Maybe Int,
HistoryStep a -> Double
_ihsOffset :: !Double
} deriving (HistoryStep a -> HistoryStep a -> Bool
(HistoryStep a -> HistoryStep a -> Bool)
-> (HistoryStep a -> HistoryStep a -> Bool) -> Eq (HistoryStep a)
forall a. Eq a => HistoryStep a -> HistoryStep a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryStep a -> HistoryStep a -> Bool
$c/= :: forall a. Eq a => HistoryStep a -> HistoryStep a -> Bool
== :: HistoryStep a -> HistoryStep a -> Bool
$c== :: forall a. Eq a => HistoryStep a -> HistoryStep a -> Bool
Eq, Int -> HistoryStep a -> ShowS
[HistoryStep a] -> ShowS
HistoryStep a -> String
(Int -> HistoryStep a -> ShowS)
-> (HistoryStep a -> String)
-> ([HistoryStep a] -> ShowS)
-> Show (HistoryStep a)
forall a. Show a => Int -> HistoryStep a -> ShowS
forall a. Show a => [HistoryStep a] -> ShowS
forall a. Show a => HistoryStep a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryStep a] -> ShowS
$cshowList :: forall a. Show a => [HistoryStep a] -> ShowS
show :: HistoryStep a -> String
$cshow :: forall a. Show a => HistoryStep a -> String
showsPrec :: Int -> HistoryStep a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> HistoryStep a -> ShowS
Show, (forall x. HistoryStep a -> Rep (HistoryStep a) x)
-> (forall x. Rep (HistoryStep a) x -> HistoryStep a)
-> Generic (HistoryStep a)
forall x. Rep (HistoryStep a) x -> HistoryStep a
forall x. HistoryStep a -> Rep (HistoryStep a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (HistoryStep a) x -> HistoryStep a
forall a x. HistoryStep a -> Rep (HistoryStep a) x
$cto :: forall a x. Rep (HistoryStep a) x -> HistoryStep a
$cfrom :: forall a x. HistoryStep a -> Rep (HistoryStep a) x
Generic)
initialHistoryStep :: a -> HistoryStep a
initialHistoryStep :: a -> HistoryStep a
initialHistoryStep a
value = HistoryStep :: forall a. a -> Text -> Int -> Maybe Int -> Double -> HistoryStep a
HistoryStep {
_ihsValue :: a
_ihsValue = a
value,
_ihsText :: Text
_ihsText = Text
"",
_ihsCursorPos :: Int
_ihsCursorPos = Int
0,
_ihsSelStart :: Maybe Int
_ihsSelStart = Maybe Int
forall a. Maybe a
Nothing,
_ihsOffset :: Double
_ihsOffset = Double
0
}
data InputFieldState a = InputFieldState {
InputFieldState a -> Seq TextLine
_ifsPlaceholder :: Seq TextLine,
InputFieldState a -> a
_ifsCurrValue :: a,
InputFieldState a -> Text
_ifsCurrText :: !Text,
InputFieldState a -> Int
_ifsCursorPos :: !Int,
InputFieldState a -> Maybe Int
_ifsSelStart :: Maybe Int,
InputFieldState a -> a
_ifsDragSelValue :: a,
InputFieldState a -> Seq GlyphPos
_ifsGlyphs :: Seq GlyphPos,
InputFieldState a -> Double
_ifsOffset :: !Double,
InputFieldState a -> Rect
_ifsTextRect :: Rect,
InputFieldState a -> TextMetrics
_ifsTextMetrics :: TextMetrics,
InputFieldState a -> Seq (HistoryStep a)
_ifsHistory :: Seq (HistoryStep a),
InputFieldState a -> Int
_ifsHistIdx :: Int,
InputFieldState a -> Int
_ifsFocusStart :: Int
} deriving (InputFieldState a -> InputFieldState a -> Bool
(InputFieldState a -> InputFieldState a -> Bool)
-> (InputFieldState a -> InputFieldState a -> Bool)
-> Eq (InputFieldState a)
forall a. Eq a => InputFieldState a -> InputFieldState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputFieldState a -> InputFieldState a -> Bool
$c/= :: forall a. Eq a => InputFieldState a -> InputFieldState a -> Bool
== :: InputFieldState a -> InputFieldState a -> Bool
$c== :: forall a. Eq a => InputFieldState a -> InputFieldState a -> Bool
Eq, Int -> InputFieldState a -> ShowS
[InputFieldState a] -> ShowS
InputFieldState a -> String
(Int -> InputFieldState a -> ShowS)
-> (InputFieldState a -> String)
-> ([InputFieldState a] -> ShowS)
-> Show (InputFieldState a)
forall a. Show a => Int -> InputFieldState a -> ShowS
forall a. Show a => [InputFieldState a] -> ShowS
forall a. Show a => InputFieldState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputFieldState a] -> ShowS
$cshowList :: forall a. Show a => [InputFieldState a] -> ShowS
show :: InputFieldState a -> String
$cshow :: forall a. Show a => InputFieldState a -> String
showsPrec :: Int -> InputFieldState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> InputFieldState a -> ShowS
Show, Typeable, (forall x. InputFieldState a -> Rep (InputFieldState a) x)
-> (forall x. Rep (InputFieldState a) x -> InputFieldState a)
-> Generic (InputFieldState a)
forall x. Rep (InputFieldState a) x -> InputFieldState a
forall x. InputFieldState a -> Rep (InputFieldState a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (InputFieldState a) x -> InputFieldState a
forall a x. InputFieldState a -> Rep (InputFieldState a) x
$cto :: forall a x. Rep (InputFieldState a) x -> InputFieldState a
$cfrom :: forall a x. InputFieldState a -> Rep (InputFieldState a) x
Generic)
initialState :: a -> InputFieldState a
initialState :: a -> InputFieldState a
initialState a
value = InputFieldState :: forall a.
Seq TextLine
-> a
-> Text
-> Int
-> Maybe Int
-> a
-> Seq GlyphPos
-> Double
-> Rect
-> TextMetrics
-> Seq (HistoryStep a)
-> Int
-> Int
-> InputFieldState a
InputFieldState {
_ifsPlaceholder :: Seq TextLine
_ifsPlaceholder = Seq TextLine
forall a. Seq a
Seq.empty,
_ifsCurrValue :: a
_ifsCurrValue = a
value,
_ifsCurrText :: Text
_ifsCurrText = Text
"",
_ifsGlyphs :: Seq GlyphPos
_ifsGlyphs = Seq GlyphPos
forall a. Seq a
Seq.empty,
_ifsCursorPos :: Int
_ifsCursorPos = Int
0,
_ifsSelStart :: Maybe Int
_ifsSelStart = Maybe Int
forall a. Maybe a
Nothing,
_ifsDragSelValue :: a
_ifsDragSelValue = a
value,
_ifsOffset :: Double
_ifsOffset = Double
0,
_ifsTextRect :: Rect
_ifsTextRect = Rect
forall a. Default a => a
def,
_ifsTextMetrics :: TextMetrics
_ifsTextMetrics = TextMetrics
forall a. Default a => a
def,
_ifsHistory :: Seq (HistoryStep a)
_ifsHistory = Seq (HistoryStep a)
forall a. Seq a
Seq.empty,
_ifsHistIdx :: Int
_ifsHistIdx = Int
0,
_ifsFocusStart :: Int
_ifsFocusStart = Int
0
}
defCaretW :: Double
defCaretW :: Double
defCaretW = Double
2
defCaretMs :: Int
defCaretMs :: Int
defCaretMs = Int
500
inputField_
:: (InputFieldValue a, WidgetEvent e)
=> WidgetType
-> InputFieldCfg s e a
-> WidgetNode s e
inputField_ :: WidgetType -> InputFieldCfg s e a -> WidgetNode s e
inputField_ WidgetType
widgetType InputFieldCfg s e a
config = WidgetNode s e
node where
value :: a
value = InputFieldCfg s e a -> a
forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue InputFieldCfg s e a
config
widget :: Widget s e
widget = InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config (a -> InputFieldState a
forall a. a -> InputFieldState a
initialState a
value)
node :: WidgetNode s e
node = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetType Widget s e
widget
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
makeInputField
:: (InputFieldValue a, WidgetEvent e)
=> InputFieldCfg s e a
-> InputFieldState a
-> Widget s e
makeInputField :: InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
state = Widget s e
widget where
widget :: Widget s e
widget = InputFieldState a -> Single s e (InputFieldState a) -> Widget s e
forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle InputFieldState a
state Single s e Any
forall a. Default a => a
def {
singleFocusOnBtnPressed :: Bool
singleFocusOnBtnPressed = Bool
False,
singleUseCustomCursor :: Bool
singleUseCustomCursor = Bool
True,
singleUseScissor :: Bool
singleUseScissor = Bool
True,
singleGetBaseStyle :: SingleGetBaseStyle s e
singleGetBaseStyle = SingleGetBaseStyle s e
forall s e p. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
singleInit :: SingleInitHandler s e
singleInit = SingleInitHandler s e
init,
singleMerge :: SingleMergeHandler s e (InputFieldState a)
singleMerge = SingleMergeHandler s e (InputFieldState a)
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> InputFieldState a -> WidgetResult s e
merge,
singleDispose :: SingleInitHandler s e
singleDispose = SingleInitHandler s e
forall p s e. p -> WidgetNode s e -> WidgetResult s e
dispose,
singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = SingleEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = SingleGetSizeReqHandler s e
forall s e. WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq,
singleResize :: SingleResizeHandler s e
singleResize = SingleResizeHandler s e
resize,
singleRender :: SingleRenderHandler s e
singleRender = SingleRenderHandler s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
}
currPlaceholder :: Seq TextLine
currPlaceholder = InputFieldState a -> Seq TextLine
forall a. InputFieldState a -> Seq TextLine
_ifsPlaceholder InputFieldState a
state
currVal :: a
currVal = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
currText :: Text
currText = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
currGlyphs :: Seq GlyphPos
currGlyphs = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
currPos :: Int
currPos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
currSel :: Maybe Int
currSel = InputFieldState a -> Maybe Int
forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
state
currOffset :: Double
currOffset = InputFieldState a -> Double
forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
state
currHistory :: Seq (HistoryStep a)
currHistory = InputFieldState a -> Seq (HistoryStep a)
forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
state
currHistIdx :: Int
currHistIdx = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
state
caretW :: Double
caretW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (InputFieldCfg s e a -> Maybe Double
forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
caretMs :: Int
caretMs = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defCaretMs (InputFieldCfg s e a -> Maybe Int
forall s e a. InputFieldCfg s e a -> Maybe Int
_ifcCaretMs InputFieldCfg s e a
config)
fromText :: Text -> Maybe a
fromText = InputFieldCfg s e a -> Text -> Maybe a
forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText InputFieldCfg s e a
config
toText :: a -> Text
toText = InputFieldCfg s e a -> a -> Text
forall s e a. InputFieldCfg s e a -> a -> Text
_ifcToText InputFieldCfg s e a
config
getModelValue :: WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) (InputFieldCfg s e a -> WidgetData s a
forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue InputFieldCfg s e a
config)
wheelHandler :: Maybe (InputWheelHandler a)
wheelHandler = InputFieldCfg s e a -> Maybe (InputWheelHandler a)
forall s e a. InputFieldCfg s e a -> Maybe (InputWheelHandler a)
_ifcWheelHandler InputFieldCfg s e a
config
dragHandler :: Maybe (InputDragHandler a)
dragHandler = InputFieldCfg s e a -> Maybe (InputDragHandler a)
forall s e a. InputFieldCfg s e a -> Maybe (InputDragHandler a)
_ifcDragHandler InputFieldCfg s e a
config
dragCursor :: Maybe CursorIcon
dragCursor = InputFieldCfg s e a -> Maybe CursorIcon
forall s e a. InputFieldCfg s e a -> Maybe CursorIcon
_ifcDragCursor InputFieldCfg s e a
config
getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
forall s e a.
InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
_ifcStyle InputFieldCfg s e a
config Maybe (ALens' ThemeState StyleState)
-> (ALens' ThemeState StyleState -> Maybe Style) -> Maybe Style
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ALens' ThemeState StyleState -> Maybe Style
handler where
handler :: ALens' ThemeState StyleState -> Maybe Style
handler ALens' ThemeState StyleState
lstyle = Style -> Maybe Style
forall a. a -> Maybe a
Just (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (ALens' ThemeState StyleState -> Lens' ThemeState StyleState
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' ThemeState StyleState
lstyle)
init :: SingleInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
newValue :: a
newValue = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv
txtValue :: Text
txtValue = a -> Text
toText a
newValue
txtPos :: Int
txtPos
| InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcDefCursorEnd InputFieldCfg s e a
config = Text -> Int
T.length Text
txtValue
| Bool
otherwise = Int
0
newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config
newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
newValue Text
txtValue Int
txtPos Maybe Int
forall a. Maybe a
Nothing
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
parsedVal :: Maybe a
parsedVal = Text -> Maybe a
fromText (a -> Text
toText a
newValue)
reqs :: [WidgetRequest s e]
reqs = InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
parsedVal)
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs
merge :: WidgetEnv s e
-> WidgetNode s e -> p -> InputFieldState a -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode InputFieldState a
oldState = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs where
oldInfo :: WidgetNodeInfo
oldInfo = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
oldValue :: a
oldValue = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
oldState
oldText :: Text
oldText = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
oldState
oldPos :: Int
oldPos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
oldState
oldSel :: Maybe Int
oldSel = InputFieldState a -> Maybe Int
forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
oldState
value :: a
value = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv
newText :: Text
newText
| a
oldValue a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv = a -> Text
toText a
value
| Bool
otherwise = Text
oldText
newTextL :: Int
newTextL = Text -> Int
T.length Text
newText
newPos :: Int
newPos
| Text
oldText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newText = Int
oldPos
| InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcDefCursorEnd InputFieldCfg s e a
config = Int
newTextL
| Bool
otherwise = Int
0
newSelStart :: Maybe Int
newSelStart
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
oldSel Bool -> Bool -> Bool
|| Int
newTextL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
oldSel = Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Int
oldSel
newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config
newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
value Text
newText Int
newPos Maybe Int
newSelStart
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
parsedVal :: Maybe a
parsedVal = Text -> Maybe a
fromText Text
newText
oldPath :: Path
oldPath = WidgetNodeInfo
oldInfo WidgetNodeInfo -> Getting Path WidgetNodeInfo Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path WidgetNodeInfo Path
forall s a. HasPath s a => Lens' s a
L.path
oldWid :: WidgetId
oldWid = WidgetNodeInfo
oldInfo WidgetNodeInfo
-> Getting WidgetId WidgetNodeInfo WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
newPath :: Path
newPath = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e))
-> Getting Path WidgetNodeInfo Path
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Path WidgetNodeInfo Path
forall s a. HasPath s a => Lens' s a
L.path
newWid :: WidgetId
newWid = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
updateFocus :: Bool
updateFocus = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
oldPath Bool -> Bool -> Bool
&& Path
oldPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
newPath
renderReqs :: [WidgetRequest s e]
renderReqs
| Bool
updateFocus = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
oldWid, WidgetId -> Int -> Maybe Int -> WidgetRequest s e
forall s e. WidgetId -> Int -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
newWid Int
caretMs Maybe Int
forall a. Maybe a
Nothing]
| Bool
otherwise = []
reqs :: [WidgetRequest s e]
reqs = InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
parsedVal) [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall s e. [WidgetRequest s e]
renderReqs
dispose :: p -> WidgetNode s e -> WidgetResult s e
dispose p
wenv WidgetNode s e
node = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs where
widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
reqs :: [WidgetRequest s e]
reqs = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId ]
handleKeyPress :: WidgetEnv s e -> KeyMod -> KeyCode -> Maybe (Text, Int, Maybe Int)
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code
| Bool
isDelBackWordNoSel = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeWord Int
prevWordStartIdx Maybe Int
forall a. Maybe a
Nothing
| Bool
isDelBackWord = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText Int
minTpSel Maybe Int
forall a. Maybe a
Nothing
| Bool
isBackspace Bool -> Bool -> Bool
&& Bool
emptySel = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe Int
forall a. Maybe a
Nothing
| Bool
isBackspace = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText Int
minTpSel Maybe Int
forall a. Maybe a
Nothing
| Bool
isMoveLeft = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe Int
forall a. Maybe a
Nothing
| Bool
isMoveRight = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
forall a. Maybe a
Nothing
| Bool
isMoveWordL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
prevWordStartIdx Maybe Int
forall a. Maybe a
Nothing
| Bool
isMoveWordR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
nextWordEndIdx Maybe Int
forall a. Maybe a
Nothing
| Bool
isMoveLineL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 Maybe Int
forall a. Maybe a
Nothing
| Bool
isMoveLineR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
txtLen Maybe Int
forall a. Maybe a
Nothing
| Bool
isSelectAll = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
txtLen)
| Bool
isSelectLeft = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectRight = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectWordL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
prevWordStartIdx (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectWordR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
nextWordEndIdx (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectLineL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectLineR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
txtLen (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
| Bool
isDeselectLeft = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
minTpSel Maybe Int
forall a. Maybe a
Nothing
| Bool
isDeselectRight = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall a. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
maxTpSel Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe (Text, Int, Maybe Int)
forall a. Maybe a
Nothing
where
txt :: Text
txt = Text
currText
txtLen :: Int
txtLen = Text -> Int
T.length Text
txt
tp :: Int
tp = Int
currPos
emptySel :: Bool
emptySel = Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
currSel
(Text
part1, Text
part2) = Int -> Text -> (Text, Text)
T.splitAt Int
currPos Text
currText
currSelVal :: Int
currSelVal = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
currSel
activeSel :: Bool
activeSel = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel
minTpSel :: Int
minTpSel = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
tp Int
currSelVal
maxTpSel :: Int
maxTpSel = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
tp Int
currSelVal
prevWordStart :: Text
prevWordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
delim Text
part1
prevWordStartIdx :: Int
prevWordStartIdx = Text -> Int
T.length Text
prevWordStart
nextWordEnd :: Text
nextWordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
delim Text
part2
nextWordEndIdx :: Int
nextWordEndIdx = Int
txtLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd
isShift :: Bool
isShift = KeyMod -> Bool
_kmLeftShift KeyMod
mod
isLeft :: Bool
isLeft = KeyCode -> Bool
isKeyLeft KeyCode
code
isRight :: Bool
isRight = KeyCode -> Bool
isKeyRight KeyCode
code
isHome :: Bool
isHome = KeyCode -> Bool
isKeyHome KeyCode
code
isEnd :: Bool
isEnd = KeyCode -> Bool
isKeyEnd KeyCode
code
isWordMod :: Bool
isWordMod
| WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
| Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
isLineMod :: Bool
isLineMod
| WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod Bool -> Bool -> Bool
|| KeyMod -> Bool
_kmLeftGUI KeyMod
mod
| Bool
otherwise = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
isAllMod :: Bool
isAllMod
| WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftGUI KeyMod
mod
| Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
isBackspace :: Bool
isBackspace = KeyCode -> Bool
isKeyBackspace KeyCode
code Bool -> Bool -> Bool
&& (Int
tp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel)
isDelBackWord :: Bool
isDelBackWord = Bool
isBackspace Bool -> Bool -> Bool
&& Bool
isWordMod
isDelBackWordNoSel :: Bool
isDelBackWordNoSel = Bool
isDelBackWord Bool -> Bool -> Bool
&& Bool
emptySel
isMove :: Bool
isMove = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isMoveWord :: Bool
isMoveWord = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isMoveLine :: Bool
isMoveLine = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isLineMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod
isSelect :: Bool
isSelect = Bool
isShift Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isSelectWord :: Bool
isSelectWord = Bool
isShift Bool -> Bool -> Bool
&& Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isSelectLine :: Bool
isSelectLine = Bool
isShift Bool -> Bool -> Bool
&& Bool
isLineMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod
isMoveLeft :: Bool
isMoveLeft = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isLeft
isMoveRight :: Bool
isMoveRight = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isRight
isMoveWordL :: Bool
isMoveWordL = Bool
isMoveWord Bool -> Bool -> Bool
&& Bool
isLeft
isMoveWordR :: Bool
isMoveWordR = Bool
isMoveWord Bool -> Bool -> Bool
&& Bool
isRight
isMoveLineL :: Bool
isMoveLineL = (Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isLeft) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isHome)
isMoveLineR :: Bool
isMoveLineR = (Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isRight) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isEnd)
isSelectAll :: Bool
isSelectAll = Bool
isAllMod Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyA KeyCode
code
isSelectLeft :: Bool
isSelectLeft = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isLeft
isSelectRight :: Bool
isSelectRight = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isRight
isSelectWordL :: Bool
isSelectWordL = Bool
isSelectWord Bool -> Bool -> Bool
&& Bool
isLeft
isSelectWordR :: Bool
isSelectWordR = Bool
isSelectWord Bool -> Bool -> Bool
&& Bool
isRight
isSelectLineL :: Bool
isSelectLineL = (Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isLeft) Bool -> Bool -> Bool
|| (Bool
isShift Bool -> Bool -> Bool
&& Bool
isHome)
isSelectLineR :: Bool
isSelectLineR = (Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isRight) Bool -> Bool -> Bool
|| (Bool
isShift Bool -> Bool -> Bool
&& Bool
isEnd)
isDeselectLeft :: Bool
isDeselectLeft = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isLeft
isDeselectRight :: Bool
isDeselectRight = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isRight
removeText :: Text
removeText
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Text -> Text -> Text
replaceText Text
txt Text
""
| Bool
otherwise = Text -> Text
T.init Text
part1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
part2
removeWord :: Text
removeWord
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Text -> Text -> Text
replaceText Text
txt Text
""
| Bool
otherwise = Text
prevWordStart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
part2
moveCursor :: a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor a
txt Int
newPos Maybe Int
newSel
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
newSel = (a
txt, Int
fixedPos, Maybe Int
forall a. Maybe a
Nothing)
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& Int -> Maybe Int
forall a. a -> Maybe a
Just Int
fixedPos Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
currSel = (a
txt, Int
fixedPos, Maybe Int
forall a. Maybe a
Nothing)
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = (a
txt, Int
fixedPos, Maybe Int
currSel)
| Int -> Maybe Int
forall a. a -> Maybe a
Just Int
fixedPos Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
fixedSel = (a
txt, Int
fixedPos, Maybe Int
forall a. Maybe a
Nothing)
| Bool
otherwise = (a
txt, Int
fixedPos, Maybe Int
fixedSel)
where
fixedPos :: Int
fixedPos = Int -> Int
fixIdx Int
newPos
fixedSel :: Maybe Int
fixedSel = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
fixIdx Maybe Int
newSel
fixIdx :: Int -> Int
fixIdx Int
idx
| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int
0
| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
txtLen = Int
txtLen
| Bool
otherwise = Int
idx
handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
| Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
newPos :: Int
newPos = InputFieldState a -> Point -> Int
forall a. InputFieldState a -> Point -> Int
findClosestGlyphPos InputFieldState a
state Point
point
newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
forall a. Maybe a
Nothing
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
newReqs :: [WidgetRequest s e]
newReqs = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId | Bool -> Bool
not (WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node) ]
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
newReqs
ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
| Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragHandleExt Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode) where
newState :: InputFieldState a
newState = InputFieldState a
state { _ifsDragSelValue :: a
_ifsDragSelValue = a
currVal }
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
(Text
part1, Text
part2) = Int -> Text -> (Text, Text)
T.splitAt Int
currPos Text
currText
txtLen :: Int
txtLen = Text -> Int
T.length Text
currText
wordStart :: Text
wordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part1
wordStartIdx :: Int
wordStartIdx = Text -> Int
T.length Text
wordStart
wordEnd :: Text
wordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part2
wordEndIdx :: Int
wordEndIdx = Int
txtLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
wordEnd
newPos :: Int
newPos = Int
wordStartIdx
newSel :: Maybe Int
newSel = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
wordEndIdx
newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
newSel
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
newPos :: Int
newPos = Int
0
newSel :: Maybe Int
newSel = Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int
T.length Text
currText)
newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
newSel
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragHandleExt Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
True Text
currText Int
currPos Maybe Int
currSel [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs
Move Point
point
| WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shiftPressed -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
newPos :: Int
newPos = InputFieldState a -> Point -> Int
forall a. InputFieldState a -> Point -> Int
findClosestGlyphPos InputFieldState a
state Point
point
newSel :: Maybe Int
newSel = Maybe Int
currSel Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
currPos
newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
newSel
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce WidgetRequest s e -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. a -> [a] -> [a]
: CursorIcon -> [WidgetRequest s e]
forall s e. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor)
Move Point
point
| WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool
shiftPressed -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
(Path
_, Point
stPoint) = Maybe (Path, Point) -> (Path, Point)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Path, Point) -> (Path, Point))
-> Maybe (Path, Point) -> (Path, Point)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e
wenv WidgetEnv s e
-> Getting
(Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
-> Maybe (Path, Point)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
handlerRes :: (Text, Int, Maybe Int)
handlerRes = Maybe (InputDragHandler a) -> InputDragHandler a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (InputDragHandler a)
dragHandler InputFieldState a
state Point
stPoint Point
point
(Text
newText, Int
newPos, Maybe Int
newSel) = (Text, Int, Maybe Int)
handlerRes
reqs :: [WidgetRequest s e]
reqs = WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce WidgetRequest s e -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. a -> [a] -> [a]
: CursorIcon -> [WidgetRequest s e]
forall s e. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
True Text
newText Int
newPos Maybe Int
newSel [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs
Move Point
point -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs) where
reqs :: [WidgetRequest s e]
reqs = CursorIcon -> [WidgetRequest s e]
forall s e. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
WheelScroll Point
point Point
move WheelDirection
dir
| Maybe (InputWheelHandler a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (InputWheelHandler a)
wheelHandler -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
handlerRes :: (Text, Int, Maybe Int)
handlerRes = Maybe (InputWheelHandler a) -> InputWheelHandler a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (InputWheelHandler a)
wheelHandler InputFieldState a
state Point
point Point
move WheelDirection
dir
(Text
newText, Int
newPos, Maybe Int
newSel) = (Text, Int, Maybe Int)
handlerRes
reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
True Text
newText Int
newPos Maybe Int
newSel [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs
KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
| WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCopy WidgetEnv s e
wenv SystemEvent
evt
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [ClipboardData -> WidgetRequest s e
forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText)]
| WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardPaste WidgetEnv s e
wenv SystemEvent
evt
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
GetClipboard WidgetId
widgetId]
| WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCut WidgetEnv s e
wenv SystemEvent
evt -> WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
cutTextRes WidgetEnv s e
wenv WidgetNode s e
node
| WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardUndo WidgetEnv s e
wenv SystemEvent
evt -> WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
moveHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config (-Int
1)
| WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardRedo WidgetEnv s e
wenv SystemEvent
evt -> WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
moveHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config Int
1
| Bool
otherwise -> ((Text, Int, Maybe Int) -> WidgetResult s e)
-> Maybe (Text, Int, Maybe Int) -> Maybe (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Int, Maybe Int) -> WidgetResult s e
handleKeyRes Maybe (Text, Int, Maybe Int)
keyRes Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e) -> Maybe (WidgetResult s e)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (WidgetResult s e)
cursorRes where
keyRes :: Maybe (Text, Int, Maybe Int)
keyRes = WidgetEnv s e -> KeyMod -> KeyCode -> Maybe (Text, Int, Maybe Int)
forall s e.
WidgetEnv s e -> KeyMod -> KeyCode -> Maybe (Text, Int, Maybe Int)
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code
handleKeyRes :: (Text, Int, Maybe Int) -> WidgetResult s e
handleKeyRes (Text
newText, Int
newPos, Maybe Int
newSel) = WidgetResult s e
result where
result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
False Text
newText Int
newPos Maybe Int
newSel []
cursorReq :: [WidgetRequest s e]
cursorReq = CursorIcon -> [WidgetRequest s e]
forall s e. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
cursorRes :: Maybe (WidgetResult s e)
cursorRes
| Bool -> Bool
not ([WidgetRequest Any Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest Any Any]
forall s e. [WidgetRequest s e]
cursorReq) = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
cursorReq)
| Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyReleased
| (Bool
pressed Bool -> Bool -> Bool
|| Bool
hovered) Bool -> Bool -> Bool
&& Bool -> Bool
not ([WidgetRequest Any Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest Any Any]
forall s e. [WidgetRequest s e]
reqs) -> Maybe (WidgetResult s e)
result where
pressed :: Bool
pressed = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node
hovered :: Bool
hovered = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node
reqs :: [WidgetRequest s e]
reqs = CursorIcon -> [WidgetRequest s e]
forall s e. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs)
TextInput Text
newText -> Maybe (WidgetResult s e)
result where
result :: Maybe (WidgetResult s e)
result = WidgetEnv s e -> WidgetNode s e -> Text -> Maybe (WidgetResult s e)
insertTextRes WidgetEnv s e
wenv WidgetNode s e
node Text
newText
Clipboard (ClipboardText Text
newText) -> Maybe (WidgetResult s e)
result where
result :: Maybe (WidgetResult s e)
result = WidgetEnv s e -> WidgetNode s e -> Text -> Maybe (WidgetResult s e)
insertTextRes WidgetEnv s e
wenv WidgetNode s e
node Text
newText
Focus Path
prev -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
tmpState :: InputFieldState a
tmpState
| InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus InputFieldCfg s e a
config Bool -> Bool -> Bool
&& Text -> Int
T.length Text
currText Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = InputFieldState a
state {
_ifsSelStart :: Maybe Int
_ifsSelStart = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0,
_ifsCursorPos :: Int
_ifsCursorPos = Text -> Int
T.length Text
currText
}
| Bool
otherwise = InputFieldState a
state
newState :: InputFieldState a
newState = InputFieldState a
tmpState {
_ifsFocusStart :: Int
_ifsFocusStart = WidgetEnv s e
wenv WidgetEnv s e -> Getting Int (WidgetEnv s e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (WidgetEnv s e) Int
forall s a. HasTimestamp s a => Lens' s a
L.timestamp
}
reqs :: [WidgetRequest s e]
reqs = [WidgetId -> Int -> Maybe Int -> WidgetRequest s e
forall s e. WidgetId -> Int -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Int
caretMs Maybe Int
forall a. Maybe a
Nothing, Rect -> WidgetRequest s e
forall s e. Rect -> WidgetRequest s e
StartTextInput Rect
viewport]
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
newResult :: WidgetResult s e
newResult = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs
focusRs :: Maybe (WidgetResult s e)
focusRs = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
newNode Path
prev (InputFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnFocusReq InputFieldCfg s e a
config)
result :: WidgetResult s e
result = WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e)
-> Maybe (WidgetResult s e)
-> WidgetResult s e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult WidgetResult s e -> WidgetResult s e -> WidgetResult s e
forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
focusRs
Blur Path
next -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
reqs :: [WidgetRequest s e]
reqs = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId, WidgetRequest s e
forall s e. WidgetRequest s e
StopTextInput]
newResult :: WidgetResult s e
newResult = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs
blurResult :: Maybe (WidgetResult s e)
blurResult = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (InputFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnBlurReq InputFieldCfg s e a
config)
result :: WidgetResult s e
result = WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e)
-> Maybe (WidgetResult s e)
-> WidgetResult s e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult WidgetResult s e -> WidgetResult s e -> WidgetResult s e
forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
blurResult
SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
where
widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
viewport :: Rect
viewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config
shiftPressed :: Bool
shiftPressed = WidgetEnv s e
wenv WidgetEnv s e -> Getting Bool (WidgetEnv s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e))
-> ((Bool -> Const Bool Bool)
-> InputStatus -> Const Bool InputStatus)
-> Getting Bool (WidgetEnv s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus
forall s a. HasKeyMod s a => Lens' s a
L.keyMod ((KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus)
-> ((Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod)
-> (Bool -> Const Bool Bool)
-> InputStatus
-> Const Bool InputStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod
forall s a. HasLeftShift s a => Lens' s a
L.leftShift
dragSelectText :: a -> Bool
dragSelectText a
btn
= WidgetEnv s e
wenv WidgetEnv s e -> Getting a (WidgetEnv s e) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (WidgetEnv s e) a
forall s a. HasMainButton s a => Lens' s a
L.mainButton a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
btn
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shiftPressed
dragHandleExt :: a -> Bool
dragHandleExt a
btn
= WidgetEnv s e
wenv WidgetEnv s e -> Getting a (WidgetEnv s e) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (WidgetEnv s e) a
forall s a. HasMainButton s a => Lens' s a
L.mainButton a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
btn
Bool -> Bool -> Bool
&& Bool
shiftPressed
Bool -> Bool -> Bool
&& Maybe (InputDragHandler a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (InputDragHandler a)
dragHandler
validCursor :: CursorIcon
validCursor
| Bool -> Bool
not Bool
shiftPressed = CursorIcon
CursorIBeam
| Bool
otherwise = CursorIcon -> Maybe CursorIcon -> CursorIcon
forall a. a -> Maybe a -> a
fromMaybe CursorIcon
CursorArrow Maybe CursorIcon
dragCursor
changeCursorReq :: CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
newCursor = [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs where
cursorMatch :: Bool
cursorMatch = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (First CursorIcon) (WidgetEnv s e) CursorIcon
-> Maybe CursorIcon
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
-> WidgetEnv s e -> Const (First CursorIcon) (WidgetEnv s e)
forall s a. HasCursor s a => Lens' s a
L.cursor ((Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
-> WidgetEnv s e -> Const (First CursorIcon) (WidgetEnv s e))
-> ((CursorIcon -> Const (First CursorIcon) CursorIcon)
-> Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
-> Getting (First CursorIcon) (WidgetEnv s e) CursorIcon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path, CursorIcon) -> Const (First CursorIcon) (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((Path, CursorIcon)
-> Const (First CursorIcon) (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
-> ((CursorIcon -> Const (First CursorIcon) CursorIcon)
-> (Path, CursorIcon)
-> Const (First CursorIcon) (Path, CursorIcon))
-> (CursorIcon -> Const (First CursorIcon) CursorIcon)
-> Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CursorIcon -> Const (First CursorIcon) CursorIcon)
-> (Path, CursorIcon)
-> Const (First CursorIcon) (Path, CursorIcon)
forall s t a b. Field2 s t a b => Lens s t a b
_2 Maybe CursorIcon -> Maybe CursorIcon -> Bool
forall a. Eq a => a -> a -> Bool
== CursorIcon -> Maybe CursorIcon
forall a. a -> Maybe a
Just CursorIcon
newCursor
reqs :: [WidgetRequest s e]
reqs
| Bool -> Bool
not Bool
cursorMatch = [WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
newCursor]
| Bool
otherwise = []
insertTextRes :: WidgetEnv s e -> WidgetNode s e -> Text -> Maybe (WidgetResult s e)
insertTextRes WidgetEnv s e
wenv WidgetNode s e
node Text
addedText = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
addedLen :: Int
addedLen = Text -> Int
T.length Text
addedText
newText :: Text
newText = Text -> Text -> Text
replaceText Text
currText Text
addedText
newPos :: Int
newPos
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int
addedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
| Bool
otherwise = Int
addedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
currPos
result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
True Text
newText Int
newPos Maybe Int
forall a. Maybe a
Nothing []
cutTextRes :: WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
cutTextRes WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
tmpResult :: WidgetResult s e
tmpResult = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) (WidgetEnv s e -> WidgetNode s e -> Text -> Maybe (WidgetResult s e)
insertTextRes WidgetEnv s e
wenv WidgetNode s e
node Text
"")
result :: WidgetResult s e
result = WidgetResult s e
tmpResult
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> ClipboardData -> WidgetRequest s e
forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText))
replaceText :: Text -> Text -> Text
replaceText Text
txt Text
newTxt
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int -> Text -> Text
T.take Int
start Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
end Text
txt
| Bool
otherwise = Int -> Text -> Text
T.take Int
currPos Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
currPos Text
txt
where
start :: Int
start = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
end :: Int
end = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
selectedText :: Text
selectedText
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int -> Text -> Text
T.take (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
start Text
currText
| Bool
otherwise = Text
""
where
start :: Int
start = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
end :: Int
end = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
genInputResult :: WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
textAdd Text
newText Int
newPos Maybe Int
newSel [WidgetRequest s e]
newReqs = WidgetResult s e
result where
acceptInput :: Bool
acceptInput = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput InputFieldCfg s e a
config Text
newText
isValid :: Bool
isValid = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcIsValidInput InputFieldCfg s e a
config Text
newText
newVal :: Maybe a
newVal = Text -> Maybe a
fromText Text
newText
stVal :: a
stVal
| Bool
isValid = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
currVal Maybe a
newVal
| Bool
otherwise = a
currVal
tempState :: InputFieldState a
tempState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config a
stVal Text
newText Int
newPos Maybe Int
newSel
newOffset :: Double
newOffset = InputFieldState a -> Double
forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
tempState
history :: Seq (HistoryStep a)
history = InputFieldState a -> Seq (HistoryStep a)
forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
tempState
histIdx :: Int
histIdx = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
tempState
newStep :: HistoryStep a
newStep = a -> Text -> Int -> Maybe Int -> Double -> HistoryStep a
forall a. a -> Text -> Int -> Maybe Int -> Double -> HistoryStep a
HistoryStep a
stVal Text
newText Int
newPos Maybe Int
newSel Double
newOffset
newState :: InputFieldState a
newState
| Text
currText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newText = InputFieldState a
tempState
| Seq (HistoryStep a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (HistoryStep a)
history Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
histIdx = InputFieldState a
tempState {
_ifsHistory :: Seq (HistoryStep a)
_ifsHistory = Seq (HistoryStep a)
history Seq (HistoryStep a) -> HistoryStep a -> Seq (HistoryStep a)
forall a. Seq a -> a -> Seq a
|> HistoryStep a
newStep,
_ifsHistIdx :: Int
_ifsHistIdx = Int
histIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
}
| Bool
otherwise = InputFieldState a
tempState {
_ifsHistory :: Seq (HistoryStep a)
_ifsHistory = Int -> Seq (HistoryStep a) -> Seq (HistoryStep a)
forall a. Int -> Seq a -> Seq a
Seq.take (Int
histIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq (HistoryStep a)
history Seq (HistoryStep a) -> HistoryStep a -> Seq (HistoryStep a)
forall a. Seq a -> a -> Seq a
|> HistoryStep a
newStep,
_ifsHistIdx :: Int
_ifsHistIdx = Int
histIdx
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
([WidgetRequest s e]
reqs, [e]
events) = WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
forall a s e.
Eq a =>
WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
genReqsEvents WidgetNode s e
node InputFieldCfg s e a
config InputFieldState a
state Text
newText [WidgetRequest s e]
newReqs
result :: WidgetResult s e
result
| Bool
acceptInput Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
textAdd = WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
forall e s.
Typeable e =>
WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
newNode [WidgetRequest s e]
reqs [e]
events
| Bool
otherwise = WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
forall e s.
Typeable e =>
WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
node [WidgetRequest s e]
reqs [e]
events
getSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node = (SizeReq, SizeReq)
sizeReq where
defWidth :: Double
defWidth = InputFieldCfg s e a -> Double
forall s e a. InputFieldCfg s e a -> Double
_ifcDefWidth InputFieldCfg s e a
config
resizeOnChange :: Bool
resizeOnChange = InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange InputFieldCfg s e a
config
currText :: Text
currText
| InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
| Bool
otherwise = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (InputFieldCfg s e a -> Maybe Text
forall s e a. InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder InputFieldCfg s e a
config)
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
Size Double
w Double
h = WidgetEnv s e -> StyleState -> Text -> Size
forall s e. WidgetEnv s e -> StyleState -> Text -> Size
getTextSize WidgetEnv s e
wenv StyleState
style Text
currText
targetW :: Double
targetW
| Bool
resizeOnChange = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
w Double
100
| Bool
otherwise = Double
defWidth
factor :: Double
factor = Double
1
sizeReq :: (SizeReq, SizeReq)
sizeReq = (Double -> Double -> SizeReq
expandSize Double
targetW Double
factor, Double -> SizeReq
fixedSize Double
h)
resize :: SingleResizeHandler s e
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
tempNode :: WidgetNode s e
tempNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Rect -> Identity Rect)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Rect -> Identity Rect)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Identity Rect)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Rect -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
viewport
newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
tempNode InputFieldState a
state InputFieldCfg s e a
config
newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
currPos Maybe Int
currSel
newNode :: WidgetNode s e
newNode = WidgetNode s e
tempNode
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& (Bool
focused Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
selectOnFocus)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
selRect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
selColor) Maybe Radius
forall a. Maybe a
Nothing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
currText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" Bool -> Bool -> Bool
&& Bool -> Bool
not (Seq TextLine -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq TextLine
currPlaceholder)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer (Double -> Double -> Point
Point Double
cx Double
cy) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Seq TextLine -> (TextLine -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq TextLine
currPlaceholder (Renderer -> StyleState -> TextLine -> IO ()
drawTextLine Renderer
renderer StyleState
placeholderStyle)
Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
forall a.
Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
renderContent Renderer
renderer InputFieldState a
state StyleState
style (InputFieldCfg s e a -> Text -> Text
forall s e a. InputFieldCfg s e a -> Text -> Text
getDisplayText InputFieldCfg s e a
config Text
currText)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
caretRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
caretRect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
caretColor) Maybe Radius
forall a. Maybe a
Nothing
where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
placeholderStyle :: StyleState
placeholderStyle = StyleState
style
StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState)
-> ((Maybe Color -> Identity (Maybe Color))
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> (Maybe Color -> Identity (Maybe Color))
-> StyleState
-> Identity StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Identity TextStyle)
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> ((Maybe Color -> Identity (Maybe Color))
-> TextStyle -> Identity TextStyle)
-> (Maybe Color -> Identity (Maybe Color))
-> Maybe TextStyle
-> Identity (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Color -> Identity (Maybe Color))
-> TextStyle -> Identity TextStyle
forall s a. HasFontColor s a => Lens' s a
L.fontColor ((Maybe Color -> Identity (Maybe Color))
-> StyleState -> Identity StyleState)
-> Maybe Color -> StyleState -> StyleState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StyleState
style StyleState
-> Getting (Maybe Color) StyleState (Maybe Color) -> Maybe Color
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Color) StyleState (Maybe Color)
forall s a. HasSndColor s a => Lens' s a
L.sndColor
carea :: Rect
carea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
Rect Double
cx Double
cy Double
_ Double
_ = Rect
carea
selectOnFocus :: Bool
selectOnFocus = InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus InputFieldCfg s e a
config
focused :: Bool
focused = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
ts :: Int
ts = WidgetEnv s e -> Int
forall s e. WidgetEnv s e -> Int
_weTimestamp WidgetEnv s e
wenv
caretTs :: Int
caretTs = Int
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsFocusStart InputFieldState a
state
caretRequired :: Bool
caretRequired = Bool
focused Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even (Int
caretTs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
caretMs)
caretColor :: Color
caretColor = StyleState -> Color
styleFontColor StyleState
style
caretRect :: Rect
caretRect = InputFieldCfg s e a
-> InputFieldState a -> StyleState -> Rect -> Rect
forall s e a.
InputFieldCfg s e a
-> InputFieldState a -> StyleState -> Rect -> Rect
getCaretRect InputFieldCfg s e a
config InputFieldState a
state StyleState
style Rect
carea
selColor :: Color
selColor = StyleState -> Color
styleHlColor StyleState
style
selRect :: Rect
selRect = InputFieldState a -> StyleState -> Rect
forall a. InputFieldState a -> StyleState -> Rect
getSelRect InputFieldState a
state StyleState
style
textOffsetY :: TextMetrics -> StyleState -> Double
textOffsetY :: TextMetrics -> StyleState -> Double
textOffsetY (TextMetrics Double
ta Double
td Double
tl Double
tlx) StyleState
style = Double
offset where
offset :: Double
offset = case StyleState -> AlignTV
styleTextAlignV StyleState
style of
AlignTV
ATBaseline -> -Double
td
AlignTV
_ -> Double
0
renderContent :: Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
renderContent :: Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
renderContent Renderer
renderer InputFieldState a
state StyleState
style Text
currText = do
Renderer -> Color -> IO ()
setFillColor Renderer
renderer Color
tsFontColor
Renderer -> Point -> Font -> FontSize -> FontSpace -> Text -> IO ()
renderText Renderer
renderer Point
textPos Font
tsFont FontSize
tsFontSize FontSpace
tsFontSpcH Text
currText
where
Rect Double
tx Double
ty Double
tw Double
th = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
textMetrics :: TextMetrics
textMetrics = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
textPos :: Point
textPos = Double -> Double -> Point
Point Double
tx (Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
th Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
textOffsetY TextMetrics
textMetrics StyleState
style)
textStyle :: TextStyle
textStyle = TextStyle -> Maybe TextStyle -> TextStyle
forall a. a -> Maybe a -> a
fromMaybe TextStyle
forall a. Default a => a
def (StyleState -> Maybe TextStyle
_sstText StyleState
style)
tsFont :: Font
tsFont = StyleState -> Font
styleFont StyleState
style
tsFontSize :: FontSize
tsFontSize = StyleState -> FontSize
styleFontSize StyleState
style
tsFontSpcH :: FontSpace
tsFontSpcH = StyleState -> FontSpace
styleFontSpaceH StyleState
style
tsFontColor :: Color
tsFontColor = StyleState -> Color
styleFontColor StyleState
style
getCaretH :: InputFieldState a -> Double
getCaretH :: InputFieldState a -> Double
getCaretH InputFieldState a
state = Double
ta Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
td Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 where
TextMetrics Double
ta Double
td Double
_ Double
_ = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
getCaretRect
:: InputFieldCfg s e a
-> InputFieldState a
-> StyleState
-> Rect
-> Rect
getCaretRect :: InputFieldCfg s e a
-> InputFieldState a -> StyleState -> Rect -> Rect
getCaretRect InputFieldCfg s e a
config InputFieldState a
state StyleState
style Rect
carea = Rect
caretRect where
Rect Double
cx Double
cy Double
cw Double
ch = Rect
carea
Rect Double
tx Double
ty Double
tw Double
th = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
caretW :: Double
caretW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (InputFieldCfg s e a -> Maybe Double
forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
textMetrics :: TextMetrics
textMetrics = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
glyphs :: Seq GlyphPos
glyphs = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
pos :: Int
pos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
caretPos :: Double
caretPos
| Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Seq GlyphPos -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq GlyphPos
glyphs = Double
0
| Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq GlyphPos -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = GlyphPos -> Double
_glpXMax (Seq GlyphPos -> GlyphPos
forall a. Seq a -> a
seqLast Seq GlyphPos
glyphs)
| Bool
otherwise = GlyphPos -> Double
_glpXMin (Seq GlyphPos -> Int -> GlyphPos
forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs Int
pos)
caretX :: Double -> Double
caretX Double
tx = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
caretW) (Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
caretPos)
caretY :: Double
caretY = Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
textOffsetY TextMetrics
textMetrics StyleState
style
caretRect :: Rect
caretRect = Double -> Double -> Double -> Double -> Rect
Rect (Double -> Double
caretX Double
tx) Double
caretY Double
caretW (InputFieldState a -> Double
forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state)
getSelRect :: InputFieldState a -> StyleState -> Rect
getSelRect :: InputFieldState a -> StyleState -> Rect
getSelRect InputFieldState a
state StyleState
style = Rect
selRect where
Rect Double
tx Double
ty Double
tw Double
th = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
textMetrics :: TextMetrics
textMetrics = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
glyphs :: Seq GlyphPos
glyphs = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
pos :: Int
pos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
sel :: Maybe Int
sel = InputFieldState a -> Maybe Int
forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
state
caretY :: Double
caretY = Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
textOffsetY TextMetrics
textMetrics StyleState
style
caretH :: Double
caretH = InputFieldState a -> Double
forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state
glyph :: Int -> GlyphPos
glyph Int
idx = Seq GlyphPos -> Int -> GlyphPos
forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
idx (Seq GlyphPos -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
gx :: Int -> Double
gx Int
idx = GlyphPos -> Double
_glpXMin (Int -> GlyphPos
glyph Int
idx)
gw :: Int -> Int -> Double
gw Int
start Int
end = Double -> Double
forall a. Num a => a -> a
abs (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ GlyphPos -> Double
_glpXMax (Int -> GlyphPos
glyph Int
end) Double -> Double -> Double
forall a. Num a => a -> a -> a
- GlyphPos -> Double
_glpXMin (Int -> GlyphPos
glyph Int
start)
mkSelRect :: Int -> Rect
mkSelRect Int
end
| Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end = Double -> Double -> Double -> Double -> Rect
Rect (Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
gx Int
end) Double
caretY (Int -> Int -> Double
gw Int
end (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Double
caretH
| Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect (Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
gx Int
pos) Double
caretY (Int -> Int -> Double
gw Int
pos (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Double
caretH
selRect :: Rect
selRect = Rect -> (Int -> Rect) -> Maybe Int -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect
forall a. Default a => a
def Int -> Rect
mkSelRect Maybe Int
sel
findClosestGlyphPos :: InputFieldState a -> Point -> Int
findClosestGlyphPos :: InputFieldState a -> Point -> Int
findClosestGlyphPos InputFieldState a
state Point
point = Int
newPos where
Point Double
x Double
y = Point
point
textRect :: Rect
textRect = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
localX :: Double
localX = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Rect -> Double
_rX Rect
textRect
textLen :: Double
textLen = Seq GlyphPos -> Double
getGlyphsMax (InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state)
glyphs :: Seq GlyphPos
glyphs
| Seq GlyphPos -> Bool
forall a. Seq a -> Bool
Seq.null (InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state) = Seq GlyphPos
forall a. Seq a
Seq.empty
| Bool
otherwise = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state Seq GlyphPos -> GlyphPos -> Seq GlyphPos
forall a. Seq a -> a -> Seq a
|> Char
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> GlyphPos
GlyphPos Char
' ' Double
textLen Double
0 Double
0 Double
0 Double
0 Double
0
glyphStart :: a -> GlyphPos -> (a, Double)
glyphStart a
i GlyphPos
g = (a
i, Double -> Double
forall a. Num a => a -> a
abs (GlyphPos -> Double
_glpXMin GlyphPos
g Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
localX))
pairs :: Seq (Int, Double)
pairs = (Int -> GlyphPos -> (Int, Double))
-> Seq GlyphPos -> Seq (Int, Double)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> GlyphPos -> (Int, Double)
forall a. a -> GlyphPos -> (a, Double)
glyphStart Seq GlyphPos
glyphs
cpm :: (a, a) -> (a, a) -> Ordering
cpm (a
_, a
g1) (a
_, a
g2) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
g1 a
g2
diffs :: Seq (Int, Double)
diffs = ((Int, Double) -> (Int, Double) -> Ordering)
-> Seq (Int, Double) -> Seq (Int, Double)
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (Int, Double) -> (Int, Double) -> Ordering
forall a a a. Ord a => (a, a) -> (a, a) -> Ordering
cpm Seq (Int, Double)
pairs
newPos :: Int
newPos = Int -> ((Int, Double) -> Int) -> Maybe (Int, Double) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Double) -> Int
forall a b. (a, b) -> a
fst (Int -> Seq (Int, Double) -> Maybe (Int, Double)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq (Int, Double)
diffs)
genReqsEvents
:: (Eq a)
=> WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
genReqsEvents :: WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
genReqsEvents WidgetNode s e
node InputFieldCfg s e a
config InputFieldState a
state Text
newText [WidgetRequest s e]
newReqs = ([WidgetRequest s e], [e])
result where
widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
resizeOnChange :: Bool
resizeOnChange = InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange InputFieldCfg s e a
config
fromText :: Text -> Maybe a
fromText = InputFieldCfg s e a -> Text -> Maybe a
forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText InputFieldCfg s e a
config
setModelValue :: a -> [WidgetRequest s e]
setModelValue = WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (InputFieldCfg s e a -> WidgetData s a
forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue InputFieldCfg s e a
config)
currVal :: a
currVal = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
currText :: Text
currText = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
accepted :: Bool
accepted = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput InputFieldCfg s e a
config Text
newText
isValid :: Bool
isValid = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcIsValidInput InputFieldCfg s e a
config Text
newText
newVal :: Maybe a
newVal = Text -> Maybe a
fromText Text
newText
stateVal :: a
stateVal = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
currVal Maybe a
newVal
txtChanged :: Bool
txtChanged = Text
newText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
currText
valChanged :: Bool
valChanged = a
stateVal a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
currVal
evtValid :: [e]
evtValid
| Bool
txtChanged = ((Bool -> e) -> e) -> [Bool -> e] -> [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> e) -> Bool -> e
forall a b. (a -> b) -> a -> b
$ Bool
isValid) (InputFieldCfg s e a -> [Bool -> e]
forall s e a. InputFieldCfg s e a -> [Bool -> e]
_ifcValidV InputFieldCfg s e a
config)
| Bool
otherwise = []
reqValid :: [WidgetRequest s e]
reqValid = InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config Bool
isValid
reqUpdateModel :: [WidgetRequest s e]
reqUpdateModel
| Bool
accepted Bool -> Bool -> Bool
&& Bool
valChanged = a -> [WidgetRequest s e]
forall e. a -> [WidgetRequest s e]
setModelValue a
stateVal
| Bool
otherwise = []
reqResize :: [WidgetRequest s e]
reqResize
| Bool
resizeOnChange Bool -> Bool -> Bool
&& Bool
valChanged = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId]
| Bool
otherwise = []
reqOnChange :: [WidgetRequest s e]
reqOnChange
| Bool
accepted Bool -> Bool -> Bool
&& Bool
valChanged = ((a -> WidgetRequest s e) -> WidgetRequest s e)
-> [a -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> WidgetRequest s e) -> a -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ a
stateVal) (InputFieldCfg s e a -> [a -> WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> [a -> WidgetRequest s e]
_ifcOnChangeReq InputFieldCfg s e a
config)
| Bool
otherwise = []
reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
newReqs [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall e. [WidgetRequest s e]
reqUpdateModel [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqValid [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqResize [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange
result :: ([WidgetRequest s e], [e])
result = ([WidgetRequest s e]
reqs, [e]
evtValid)
moveHistory
:: (InputFieldValue a, WidgetEvent e)
=> WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
moveHistory :: WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
moveHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config Int
steps = Maybe (WidgetResult s e)
result where
historyStep :: HistoryStep a
historyStep = a -> HistoryStep a
forall a. a -> HistoryStep a
initialHistoryStep (InputFieldCfg s e a -> a
forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue InputFieldCfg s e a
config)
currHistory :: Seq (HistoryStep a)
currHistory = InputFieldState a -> Seq (HistoryStep a)
forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
state
currHistIdx :: Int
currHistIdx = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
state
lenHistory :: Int
lenHistory = Seq (HistoryStep a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (HistoryStep a)
currHistory
reqHistIdx :: Int
reqHistIdx
| Int
steps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 Bool -> Bool -> Bool
&& Int
currHistIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenHistory = Int
currHistIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
| Bool
otherwise = Int
currHistIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
steps
histStep :: Maybe (HistoryStep a)
histStep = Int -> Seq (HistoryStep a) -> Maybe (HistoryStep a)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
reqHistIdx Seq (HistoryStep a)
currHistory
result :: Maybe (WidgetResult s e)
result
| Seq (HistoryStep a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (HistoryStep a)
currHistory Bool -> Bool -> Bool
|| Int
reqHistIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (HistoryStep a -> WidgetResult s e
createResult HistoryStep a
historyStep)
| Bool
otherwise = (HistoryStep a -> WidgetResult s e)
-> Maybe (HistoryStep a) -> Maybe (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HistoryStep a -> WidgetResult s e
createResult Maybe (HistoryStep a)
histStep
createResult :: HistoryStep a -> WidgetResult s e
createResult HistoryStep a
histStep = WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
forall e s.
Typeable e =>
WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
newNode [WidgetRequest s e]
reqs [e]
evts where
([WidgetRequest s e]
reqs, [e]
evts) = WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
forall a s e.
Eq a =>
WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
genReqsEvents WidgetNode s e
node InputFieldCfg s e a
config InputFieldState a
state (HistoryStep a -> Text
forall a. HistoryStep a -> Text
_ihsText HistoryStep a
histStep) []
tempState :: InputFieldState a
tempState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> HistoryStep a
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> HistoryStep a
-> InputFieldState a
newStateFromHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config HistoryStep a
histStep
newState :: InputFieldState a
newState = InputFieldState a
tempState {
_ifsHistIdx :: Int
_ifsHistIdx = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
lenHistory Int
reqHistIdx
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
newStateFromHistory
:: WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> HistoryStep a
-> InputFieldState a
newStateFromHistory :: WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> HistoryStep a
-> InputFieldState a
newStateFromHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config HistoryStep a
inputHist = InputFieldState a
newState where
HistoryStep a
hValue Text
hText Int
hPos Maybe Int
hSel Double
hOffset = HistoryStep a
inputHist
tempState :: InputFieldState a
tempState = InputFieldState a
oldState { _ifsOffset :: Double
_ifsOffset = Double
hOffset }
newState :: InputFieldState a
newState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config a
hValue Text
hText Int
hPos Maybe Int
hSel
newTextState
:: WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState :: WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config a
value Text
text Int
cursor Maybe Int
sel = InputFieldState a
newState where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
caretW :: Double
caretW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (InputFieldCfg s e a -> Maybe Double
forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
Rect Double
cx Double
cy Double
cw Double
ch = Rect
contentArea
alignH :: AlignTH
alignH = StyleState -> AlignTH
inputFieldAlignH StyleState
style
alignV :: AlignTV
alignV = StyleState -> AlignTV
inputFieldAlignV StyleState
style
alignL :: Bool
alignL = AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATLeft
alignR :: Bool
alignR = AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATRight
alignC :: Bool
alignC = AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATCenter
cursorL :: Bool
cursorL = Int
cursor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
cursorR :: Bool
cursorR = Int
cursor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
T.length Text
text
!textMetrics :: TextMetrics
textMetrics = WidgetEnv s e -> StyleState -> TextMetrics
forall s e. WidgetEnv s e -> StyleState -> TextMetrics
getTextMetrics WidgetEnv s e
wenv StyleState
style
!textRect :: Rect
textRect = WidgetEnv s e
-> StyleState -> Rect -> AlignTH -> AlignTV -> Text -> Rect
forall s e.
WidgetEnv s e
-> StyleState -> Rect -> AlignTH -> AlignTV -> Text -> Rect
getSingleTextLineRect WidgetEnv s e
wenv StyleState
style Rect
contentArea AlignTH
alignH AlignTV
alignV Text
text
Rect Double
tx Double
ty Double
tw Double
th = Rect
textRect
textFits :: Bool
textFits = Double
cw Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
tw
glyphs :: Seq GlyphPos
glyphs = WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
forall s e. WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
getTextGlyphs WidgetEnv s e
wenv StyleState
style (InputFieldCfg s e a -> Text -> Text
forall s e a. InputFieldCfg s e a -> Text -> Text
getDisplayText InputFieldCfg s e a
config Text
text)
glyphStart :: Double
glyphStart = Double -> (GlyphPos -> Double) -> Maybe GlyphPos -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 GlyphPos -> Double
_glpXMax (Maybe GlyphPos -> Double) -> Maybe GlyphPos -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Seq GlyphPos -> Maybe GlyphPos
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Int
cursor Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq GlyphPos
glyphs
glyphOffset :: Double
glyphOffset = Seq GlyphPos -> Double
getGlyphsMin Seq GlyphPos
glyphs
glyphX :: Double
glyphX = Double
glyphStart Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
glyphOffset
curX :: Double
curX = Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
glyphX
oldOffset :: Double
oldOffset = InputFieldState a -> Double
forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
oldState
newOffset :: Double
newOffset
| Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Double
cw Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Double
0
| Bool
textFits Bool -> Bool -> Bool
&& Bool
alignR = -Double
caretW
| Bool
textFits = Double
0
| Bool
alignL Bool -> Bool -> Bool
&& Bool
cursorL = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
caretW
| Bool
alignL Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
| Bool
alignL Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
cx = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
| Bool
alignR Bool -> Bool -> Bool
&& Bool
cursorR = -Double
caretW
| Bool
alignR Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw = Double
tw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
glyphX
| Bool
alignR Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
cx = Double
tw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
glyphX
| Bool
alignC Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
| Bool
alignC Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
cx = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
| Bool
otherwise = Double
oldOffset
justSel :: Int
justSel = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
sel
newSel :: Maybe Int
newSel
| Int -> Maybe Int
forall a. a -> Maybe a
Just Int
cursor Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
sel = Maybe Int
forall a. Maybe a
Nothing
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
sel Bool -> Bool -> Bool
&& (Int
justSel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
justSel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
text) = Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Int
sel
tmpState :: InputFieldState a
tmpState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> InputFieldState a
updatePlaceholder WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config
newState :: InputFieldState a
newState = InputFieldState a
tmpState {
_ifsCurrValue :: a
_ifsCurrValue = a
value,
_ifsCurrText :: Text
_ifsCurrText = Text
text,
_ifsCursorPos :: Int
_ifsCursorPos = Int
cursor,
_ifsSelStart :: Maybe Int
_ifsSelStart = Maybe Int
newSel,
_ifsGlyphs :: Seq GlyphPos
_ifsGlyphs = Seq GlyphPos
glyphs,
_ifsOffset :: Double
_ifsOffset = Double
newOffset,
_ifsTextRect :: Rect
_ifsTextRect = Rect
textRect Rect -> (Rect -> Rect) -> Rect
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> Rect -> Identity Rect
forall s a. HasX s a => Lens' s a
L.x ((Double -> Identity Double) -> Rect -> Identity Rect)
-> Double -> Rect -> Rect
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
newOffset,
_ifsTextMetrics :: TextMetrics
_ifsTextMetrics = TextMetrics
textMetrics
}
updatePlaceholder
:: WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> InputFieldState a
updatePlaceholder :: WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> InputFieldState a
updatePlaceholder WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config = InputFieldState a
newState where
fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
L.fontManager
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
Rect Double
cx Double
cy Double
cw Double
ch = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
carea :: Rect
carea = Double -> Double -> Double -> Double -> Rect
Rect Double
0 Double
0 Double
cw Double
ch
size :: Size
size = Double -> Double -> Size
Size Double
cw Double
ch
pstyle :: StyleState
pstyle = StyleState
style
StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState)
-> ((Maybe AlignTH -> Identity (Maybe AlignTH))
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> (Maybe AlignTH -> Identity (Maybe AlignTH))
-> StyleState
-> Identity StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Identity TextStyle)
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> ((Maybe AlignTH -> Identity (Maybe AlignTH))
-> TextStyle -> Identity TextStyle)
-> (Maybe AlignTH -> Identity (Maybe AlignTH))
-> Maybe TextStyle
-> Identity (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTH -> Identity (Maybe AlignTH))
-> TextStyle -> Identity TextStyle
forall s a. HasAlignH s a => Lens' s a
L.alignH ((Maybe AlignTH -> Identity (Maybe AlignTH))
-> StyleState -> Identity StyleState)
-> AlignTH -> StyleState -> StyleState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StyleState -> AlignTH
inputFieldAlignH StyleState
style
StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState)
-> ((Maybe AlignTV -> Identity (Maybe AlignTV))
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> (Maybe AlignTV -> Identity (Maybe AlignTV))
-> StyleState
-> Identity StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Identity TextStyle)
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> ((Maybe AlignTV -> Identity (Maybe AlignTV))
-> TextStyle -> Identity TextStyle)
-> (Maybe AlignTV -> Identity (Maybe AlignTV))
-> Maybe TextStyle
-> Identity (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTV -> Identity (Maybe AlignTV))
-> TextStyle -> Identity TextStyle
forall s a. HasAlignV s a => Lens' s a
L.alignV ((Maybe AlignTV -> Identity (Maybe AlignTV))
-> StyleState -> Identity StyleState)
-> AlignTV -> StyleState -> StyleState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StyleState -> AlignTV
inputFieldAlignV StyleState
style
text :: Maybe Text
text = InputFieldCfg s e a -> Maybe Text
forall s e a. InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder InputFieldCfg s e a
config
fitText :: Size -> Text -> Seq TextLine
fitText = FontManager
-> StyleState
-> TextOverflow
-> TextMode
-> TextTrim
-> Maybe Int
-> Size
-> Text
-> Seq TextLine
fitTextToSize FontManager
fontMgr StyleState
pstyle TextOverflow
Ellipsis TextMode
MultiLine TextTrim
KeepSpaces Maybe Int
forall a. Maybe a
Nothing
lines :: Seq TextLine
lines
| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
text = Size -> Text -> Seq TextLine
fitText Size
size (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
text)
| Bool
otherwise = Seq TextLine
forall a. Seq a
Seq.empty
newState :: InputFieldState a
newState = InputFieldState a
state {
_ifsPlaceholder :: Seq TextLine
_ifsPlaceholder = StyleState -> Rect -> Seq TextLine -> Seq TextLine
alignTextLines StyleState
pstyle Rect
carea Seq TextLine
lines
}
setModelValid :: InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid :: InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config
| Maybe (WidgetData s Bool) -> Bool
forall a. Maybe a -> Bool
isJust (InputFieldCfg s e a -> Maybe (WidgetData s Bool)
forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid InputFieldCfg s e a
config) = WidgetData s Bool -> Bool -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (Maybe (WidgetData s Bool) -> WidgetData s Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (WidgetData s Bool) -> WidgetData s Bool)
-> Maybe (WidgetData s Bool) -> WidgetData s Bool
forall a b. (a -> b) -> a -> b
$ InputFieldCfg s e a -> Maybe (WidgetData s Bool)
forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid InputFieldCfg s e a
config)
| Bool
otherwise = [WidgetRequest s e] -> Bool -> [WidgetRequest s e]
forall a b. a -> b -> a
const []
inputFieldAlignH :: StyleState -> AlignTH
inputFieldAlignH :: StyleState -> AlignTH
inputFieldAlignH StyleState
style = AlignTH -> Maybe AlignTH -> AlignTH
forall a. a -> Maybe a -> a
fromMaybe AlignTH
ATLeft Maybe AlignTH
alignH where
alignH :: Maybe AlignTH
alignH = StyleState
style StyleState
-> Getting (First AlignTH) StyleState AlignTH -> Maybe AlignTH
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
-> StyleState -> Const (First AlignTH) StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
-> StyleState -> Const (First AlignTH) StyleState)
-> ((AlignTH -> Const (First AlignTH) AlignTH)
-> Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
-> Getting (First AlignTH) StyleState AlignTH
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextStyle -> Const (First AlignTH) TextStyle)
-> Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((TextStyle -> Const (First AlignTH) TextStyle)
-> Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
-> ((AlignTH -> Const (First AlignTH) AlignTH)
-> TextStyle -> Const (First AlignTH) TextStyle)
-> (AlignTH -> Const (First AlignTH) AlignTH)
-> Maybe TextStyle
-> Const (First AlignTH) (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH))
-> TextStyle -> Const (First AlignTH) TextStyle
forall s a. HasAlignH s a => Lens' s a
L.alignH ((Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH))
-> TextStyle -> Const (First AlignTH) TextStyle)
-> ((AlignTH -> Const (First AlignTH) AlignTH)
-> Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH))
-> (AlignTH -> Const (First AlignTH) AlignTH)
-> TextStyle
-> Const (First AlignTH) TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlignTH -> Const (First AlignTH) AlignTH)
-> Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
inputFieldAlignV :: StyleState -> AlignTV
inputFieldAlignV :: StyleState -> AlignTV
inputFieldAlignV StyleState
style = AlignTV -> Maybe AlignTV -> AlignTV
forall a. a -> Maybe a -> a
fromMaybe AlignTV
ATLowerX Maybe AlignTV
alignV where
alignV :: Maybe AlignTV
alignV = StyleState
style StyleState
-> Getting (First AlignTV) StyleState AlignTV -> Maybe AlignTV
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
-> StyleState -> Const (First AlignTV) StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
-> StyleState -> Const (First AlignTV) StyleState)
-> ((AlignTV -> Const (First AlignTV) AlignTV)
-> Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
-> Getting (First AlignTV) StyleState AlignTV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextStyle -> Const (First AlignTV) TextStyle)
-> Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((TextStyle -> Const (First AlignTV) TextStyle)
-> Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
-> ((AlignTV -> Const (First AlignTV) AlignTV)
-> TextStyle -> Const (First AlignTV) TextStyle)
-> (AlignTV -> Const (First AlignTV) AlignTV)
-> Maybe TextStyle
-> Const (First AlignTV) (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV))
-> TextStyle -> Const (First AlignTV) TextStyle
forall s a. HasAlignV s a => Lens' s a
L.alignV ((Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV))
-> TextStyle -> Const (First AlignTV) TextStyle)
-> ((AlignTV -> Const (First AlignTV) AlignTV)
-> Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV))
-> (AlignTV -> Const (First AlignTV) AlignTV)
-> TextStyle
-> Const (First AlignTV) TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlignTV -> Const (First AlignTV) AlignTV)
-> Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
getDisplayText :: InputFieldCfg s e a -> Text -> Text
getDisplayText :: InputFieldCfg s e a -> Text -> Text
getDisplayText InputFieldCfg s e a
config Text
text = Text
displayText where
displayChar :: Maybe Text
displayChar = Char -> Text
T.singleton (Char -> Text) -> Maybe Char -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputFieldCfg s e a -> Maybe Char
forall s e a. InputFieldCfg s e a -> Maybe Char
_ifcDisplayChar InputFieldCfg s e a
config
displayText :: Text
displayText
| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
displayChar = Int -> Text -> Text
T.replicate (Text -> Int
T.length Text
text) (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
displayChar)
| Bool
otherwise = Text
text
delim :: Char -> Bool
delim :: Char -> Bool
delim Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'.', Char
',', Char
'/', Char
'-', Char
':']