{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Singles.Base.InputField (
InputFieldValue,
InputWheelHandler,
InputDragHandler,
InputFieldCfg(..),
InputFieldState(..),
HistoryStep,
inputField_
) where
import Control.Applicative ((<|>))
import Control.Monad
import Control.Lens hiding ((|>))
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 {
forall s e a. InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder :: Maybe Text,
forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue :: a,
forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue :: WidgetData s a,
forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid :: Maybe (WidgetData s Bool),
forall s e a. InputFieldCfg s e a -> [Bool -> e]
_ifcValidV :: [Bool -> e],
forall s e a. InputFieldCfg s e a -> Bool
_ifcDefCursorEnd :: Bool,
forall s e a. InputFieldCfg s e a -> Double
_ifcDefWidth :: Double,
forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth :: Maybe Double,
forall s e a. InputFieldCfg s e a -> Maybe Millisecond
_ifcCaretMs :: Maybe Millisecond,
forall s e a. InputFieldCfg s e a -> Maybe Char
_ifcDisplayChar :: Maybe Char,
forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange :: Bool,
forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus :: Bool,
forall s e a. InputFieldCfg s e a -> Bool
_ifcReadOnly :: Bool,
forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText :: Text -> Maybe a,
forall s e a. InputFieldCfg s e a -> a -> Text
_ifcToText :: a -> Text,
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput :: Text -> Bool,
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcIsValidInput :: Text -> Bool,
forall s e a.
InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
_ifcStyle :: Maybe (ALens' ThemeState StyleState),
forall s e a. InputFieldCfg s e a -> Maybe (InputWheelHandler a)
_ifcWheelHandler :: Maybe (InputWheelHandler a),
forall s e a. InputFieldCfg s e a -> Maybe (InputDragHandler a)
_ifcDragHandler :: Maybe (InputDragHandler a),
forall s e a. InputFieldCfg s e a -> Maybe CursorIcon
_ifcDragCursor :: Maybe CursorIcon,
forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnFocusReq :: [Path -> WidgetRequest s e],
forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnBlurReq :: [Path -> WidgetRequest s e],
forall s e a. InputFieldCfg s e a -> [a -> WidgetRequest s e]
_ifcOnChangeReq :: [a -> WidgetRequest s e]
}
data HistoryStep a = HistoryStep {
forall a. HistoryStep a -> a
_ihsValue :: a,
forall a. HistoryStep a -> Text
_ihsText :: !Text,
forall a. HistoryStep a -> Int
_ihsCursorPos :: !Int,
forall a. HistoryStep a -> Maybe Int
_ihsSelStart :: Maybe Int,
forall a. HistoryStep a -> Double
_ihsOffset :: !Double
} deriving (HistoryStep a -> HistoryStep a -> Bool
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
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 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 :: forall a. a -> HistoryStep a
initialHistoryStep a
value = HistoryStep {
_ihsValue :: a
_ihsValue = a
value,
_ihsText :: Text
_ihsText = Text
"",
_ihsCursorPos :: Int
_ihsCursorPos = Int
0,
_ihsSelStart :: Maybe Int
_ihsSelStart = forall a. Maybe a
Nothing,
_ihsOffset :: Double
_ihsOffset = Double
0
}
data InputFieldState a = InputFieldState {
forall a. InputFieldState a -> Seq TextLine
_ifsPlaceholder :: Seq TextLine,
forall a. InputFieldState a -> a
_ifsCurrValue :: a,
forall a. InputFieldState a -> Text
_ifsCurrText :: !Text,
forall a. InputFieldState a -> Int
_ifsCursorPos :: !Int,
forall a. InputFieldState a -> Maybe Int
_ifsSelStart :: Maybe Int,
forall a. InputFieldState a -> a
_ifsDragSelValue :: a,
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs :: Seq GlyphPos,
forall a. InputFieldState a -> Double
_ifsOffset :: !Double,
forall a. InputFieldState a -> Rect
_ifsTextRect :: Rect,
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics :: TextMetrics,
forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory :: Seq (HistoryStep a),
forall a. InputFieldState a -> Int
_ifsHistIdx :: Int,
forall a. InputFieldState a -> Millisecond
_ifsFocusStart :: Millisecond
} deriving (InputFieldState a -> InputFieldState a -> Bool
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
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 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 :: forall a. a -> InputFieldState a
initialState a
value = InputFieldState {
_ifsPlaceholder :: Seq TextLine
_ifsPlaceholder = forall a. Seq a
Seq.empty,
_ifsCurrValue :: a
_ifsCurrValue = a
value,
_ifsCurrText :: Text
_ifsCurrText = Text
"",
_ifsGlyphs :: Seq GlyphPos
_ifsGlyphs = forall a. Seq a
Seq.empty,
_ifsCursorPos :: Int
_ifsCursorPos = Int
0,
_ifsSelStart :: Maybe Int
_ifsSelStart = forall a. Maybe a
Nothing,
_ifsDragSelValue :: a
_ifsDragSelValue = a
value,
_ifsOffset :: Double
_ifsOffset = Double
0,
_ifsTextRect :: Rect
_ifsTextRect = forall a. Default a => a
def,
_ifsTextMetrics :: TextMetrics
_ifsTextMetrics = forall a. Default a => a
def,
_ifsHistory :: Seq (HistoryStep a)
_ifsHistory = forall a. Seq a
Seq.empty,
_ifsHistIdx :: Int
_ifsHistIdx = Int
0,
_ifsFocusStart :: Millisecond
_ifsFocusStart = Millisecond
0
}
defCaretW :: Double
defCaretW :: Double
defCaretW = Double
2
defCaretMs :: Millisecond
defCaretMs :: Millisecond
defCaretMs = Millisecond
500
inputField_
:: (InputFieldValue a, WidgetEvent e)
=> WidgetType
-> InputFieldCfg s e a
-> WidgetNode s e
inputField_ :: forall a e s.
(InputFieldValue a, WidgetEvent e) =>
WidgetType -> InputFieldCfg s e a -> WidgetNode s e
inputField_ WidgetType
widgetType InputFieldCfg s e a
config = WidgetNode s e
node where
value :: a
value = forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue InputFieldCfg s e a
config
widget :: Widget s e
widget = forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config (forall a. a -> InputFieldState a
initialState a
value)
node :: WidgetNode s e
node = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetType Widget s e
widget
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable 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 :: 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
state = Widget s e
widget where
widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle InputFieldState a
state 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 = 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 = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> InputFieldState a -> WidgetResult s e
merge,
singleDispose :: SingleInitHandler s e
singleDispose = forall {p} {s} {e}. p -> WidgetNode s e -> WidgetResult s e
dispose,
singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = 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 = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
}
!currPlaceholder :: Seq TextLine
currPlaceholder = forall a. InputFieldState a -> Seq TextLine
_ifsPlaceholder InputFieldState a
state
!currVal :: a
currVal = forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
!currText :: Text
currText = forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
!currGlyphs :: Seq GlyphPos
currGlyphs = forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
!currPos :: Int
currPos = forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
!currSel :: Maybe Int
currSel = forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
state
!currOffset :: Double
currOffset = forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
state
!currHistory :: Seq (HistoryStep a)
currHistory = forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
state
!currHistIdx :: Int
currHistIdx = forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
state
!caretW :: Double
caretW = forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
!caretMs :: Millisecond
caretMs = forall a. a -> Maybe a -> a
fromMaybe Millisecond
defCaretMs (forall s e a. InputFieldCfg s e a -> Maybe Millisecond
_ifcCaretMs InputFieldCfg s e a
config)
!editable :: Bool
editable = Bool -> Bool
not (forall s e a. InputFieldCfg s e a -> Bool
_ifcReadOnly InputFieldCfg s e a
config)
!fromText :: Text -> Maybe a
fromText = forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText InputFieldCfg s e a
config
!toText :: a -> Text
toText = 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 = forall s a. s -> WidgetData s a -> a
widgetDataGet (forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) (forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue InputFieldCfg s e a
config)
!wheelHandler :: Maybe (InputWheelHandler a)
wheelHandler = forall s e a. InputFieldCfg s e a -> Maybe (InputWheelHandler a)
_ifcWheelHandler InputFieldCfg s e a
config
!dragHandler :: Maybe (InputDragHandler a)
dragHandler = forall s e a. InputFieldCfg s e a -> Maybe (InputDragHandler a)
_ifcDragHandler InputFieldCfg s e a
config
!dragCursor :: Maybe CursorIcon
dragCursor = 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 = forall s e a.
InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
_ifcStyle InputFieldCfg s e a
config 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (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 = forall {e}. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv
txtValue :: Text
txtValue = a -> Text
toText a
newValue
txtPos :: Int
txtPos
| 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 = 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 forall a. Maybe a
Nothing
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config (forall a. Maybe a -> Bool
isJust Maybe a
parsedVal)
result :: WidgetResult s e
result = 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 = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
oldValue :: a
oldValue = forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
oldState
oldText :: Text
oldText = forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
oldState
oldPos :: Int
oldPos = forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
oldState
oldSel :: Maybe Int
oldSel = forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
oldState
value :: a
value = forall {e}. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv
newText :: Text
newText
| a
oldValue forall a. Eq a => a -> a -> Bool
/= 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 forall a. Eq a => a -> a -> Bool
== Text
newText = Int
oldPos
| 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
| forall a. Maybe a -> Bool
isNothing Maybe Int
oldSel Bool -> Bool -> Bool
|| Int
newTextL forall a. Ord a => a -> a -> Bool
< forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
oldSel = forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Int
oldSel
newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
oldWid :: WidgetId
oldWid = WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
newPath :: Path
newPath = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
newWid :: WidgetId
newWid = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
updateFocus :: Bool
updateFocus = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath forall a. Eq a => a -> a -> Bool
== Path
oldPath Bool -> Bool -> Bool
&& Path
oldPath forall a. Eq a => a -> a -> Bool
/= Path
newPath
renderReqs :: [WidgetRequest s e]
renderReqs
| Bool
updateFocus = [forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
oldWid, forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
newWid Millisecond
caretMs forall a. Maybe a
Nothing]
| Bool
otherwise = []
reqs :: [WidgetRequest s e]
reqs = forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config (forall a. Maybe a -> Bool
isJust Maybe a
parsedVal) forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
renderReqs
dispose :: p -> WidgetNode s e -> WidgetResult s e
dispose p
wenv WidgetNode s e
node = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
reqs :: [WidgetRequest s e]
reqs = [ 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 Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeWord Int
prevWordStartIdx forall a. Maybe a
Nothing
| Bool
isDelBackWord Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText Int
minTpSel forall a. Maybe a
Nothing
| Bool
isBackspace Bool -> Bool -> Bool
&& Bool
emptySel Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText (Int
tp forall a. Num a => a -> a -> a
- Int
1) forall a. Maybe a
Nothing
| Bool
isBackspace Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText Int
minTpSel forall a. Maybe a
Nothing
| Bool
isMoveLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp forall a. Num a => a -> a -> a
- Int
1) forall a. Maybe a
Nothing
| Bool
isMoveRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp forall a. Num a => a -> a -> a
+ Int
1) forall a. Maybe a
Nothing
| Bool
isMoveWordL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
prevWordStartIdx forall a. Maybe a
Nothing
| Bool
isMoveWordR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
nextWordEndIdx forall a. Maybe a
Nothing
| Bool
isMoveLineL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 forall a. Maybe a
Nothing
| Bool
isMoveLineR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
txtLen forall a. Maybe a
Nothing
| Bool
isSelectAll = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 (forall a. a -> Maybe a
Just Int
txtLen)
| Bool
isSelectLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp forall a. Num a => a -> a -> a
+ Int
1) (forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectWordL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
prevWordStartIdx (forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectWordR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
nextWordEndIdx (forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectLineL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 (forall a. a -> Maybe a
Just Int
tp)
| Bool
isSelectLineR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
txtLen (forall a. a -> Maybe a
Just Int
tp)
| Bool
isDeselectLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
minTpSel forall a. Maybe a
Nothing
| Bool
isDeselectRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
maxTpSel forall a. Maybe a
Nothing
| Bool
otherwise = 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 = 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 = forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
currSel
activeSel :: Bool
activeSel = forall a. Maybe a -> Bool
isJust Maybe Int
currSel
minTpSel :: Int
minTpSel = forall a. Ord a => a -> a -> a
min Int
tp Int
currSelVal
maxTpSel :: Int
maxTpSel = forall a. Ord a => a -> a -> a
max Int
tp Int
currSelVal
prevWordStart :: Text
prevWordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
delim Text
part2
nextWordEndIdx :: Int
nextWordEndIdx = Int
txtLen 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
| 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
| 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
| 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 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> 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
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Text -> Text -> Text
replaceText Text
txt Text
""
| Bool
otherwise = Text -> Text
T.init Text
part1 forall a. Semigroup a => a -> a -> a
<> Text
part2
removeWord :: Text
removeWord
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Text -> Text -> Text
replaceText Text
txt Text
""
| Bool
otherwise = Text
prevWordStart 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
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Int
newSel = (a
txt, Int
fixedPos, forall a. Maybe a
Nothing)
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& forall a. a -> Maybe a
Just Int
fixedPos forall a. Eq a => a -> a -> Bool
== Maybe Int
currSel = (a
txt, Int
fixedPos, forall a. Maybe a
Nothing)
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel = (a
txt, Int
fixedPos, Maybe Int
currSel)
| forall a. a -> Maybe a
Just Int
fixedPos forall a. Eq a => a -> a -> Bool
== Maybe Int
fixedSel = (a
txt, Int
fixedPos, 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 = 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 forall a. Ord a => a -> a -> Bool
< Int
0 = Int
0
| Int
idx 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
| forall {a}. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
newPos :: Int
newPos = 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 forall a. Maybe a
Nothing
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = [ forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId | Bool -> Bool
not (forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node) ]
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
newReqs
ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
| forall {a}. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragHandleExt Button
btn Bool -> Bool -> Bool
&& Int
clicks forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a. a -> Maybe a
Just (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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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
| forall {a}. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks forall a. Eq a => a -> a -> Bool
== Int
2 -> 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part2
wordEndIdx :: Int
wordEndIdx = Int
txtLen forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
wordEnd
newPos :: Int
newPos = Int
wordStartIdx
newSel :: Maybe Int
newSel = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce]
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| forall {a}. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks forall a. Eq a => a -> a -> Bool
== Int
3 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
newPos :: Int
newPos = Int
0
newSel :: Maybe Int
newSel = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce]
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| forall {a}. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
dragHandleExt Button
btn Bool -> Bool -> Bool
&& Int
clicks forall a. Eq a => a -> a -> Bool
== Int
0 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
reqs :: [WidgetRequest s e]
reqs = [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 forall {s} {e}. [WidgetRequest s e]
reqs
Move Point
point
| 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 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
newPos :: Int
newPos = forall a. InputFieldState a -> Point -> Int
findClosestGlyphPos InputFieldState a
state Point
point
newSel :: Maybe Int
newSel = Maybe Int
currSel forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (forall s e. WidgetRequest s e
RenderOnce forall a. a -> [a] -> [a]
: forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor)
Move Point
point
| forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool
isShiftDrag -> forall a. a -> Maybe a
Just WidgetResult s e
result where
isShiftDrag :: Bool
isShiftDrag = Bool
shiftPressed Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe (InputDragHandler a)
dragHandler
(Path
_, Point
stPoint) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
handlerRes :: (Text, Int, Maybe Int)
handlerRes = 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 = forall s e. WidgetRequest s e
RenderOnce forall a. a -> [a] -> [a]
: 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 forall {s} {e}. [WidgetRequest s e]
reqs
Move Point
point -> forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs) where
reqs :: [WidgetRequest s e]
reqs = forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
WheelScroll Point
point Point
move WheelDirection
dir
| forall a. Maybe a -> Bool
isJust Maybe (InputWheelHandler a)
wheelHandler -> forall a. a -> Maybe a
Just WidgetResult s e
result where
handlerRes :: (Text, Int, Maybe Int)
handlerRes = 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 = [forall s e. WidgetRequest s e
RenderOnce, forall s e. WidgetRequest s e
IgnoreParentEvents]
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 forall {s} {e}. [WidgetRequest s e]
reqs
KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCopy WidgetEnv s e
wenv SystemEvent
evt
-> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText)]
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardPaste WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable
-> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
GetClipboard WidgetId
widgetId]
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCut WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
cutTextRes WidgetEnv s e
wenv WidgetNode s e
node
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardUndo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> 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)
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardRedo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> 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 -> 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (WidgetResult s e)
cursorRes where
!keyRes :: Maybe (Text, Int, Maybe Int)
keyRes = 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 = forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
cursorRes :: Maybe (WidgetResult s e)
cursorRes
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall {s} {e}. [WidgetRequest s e]
cursorReq) = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
cursorReq)
| Bool
otherwise = 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall {s} {e}. [WidgetRequest s e]
reqs) -> Maybe (WidgetResult s e)
result where
pressed :: Bool
pressed = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node
hovered :: Bool
hovered = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node
reqs :: [WidgetRequest s e]
reqs = forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs)
TextInput Text
newText
| Bool
editable -> 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 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
tmpState :: InputFieldState a
tmpState
| forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus InputFieldCfg s e a
config Bool -> Bool -> Bool
&& Text -> Int
T.length Text
currText forall a. Ord a => a -> a -> Bool
> Int
0 = InputFieldState a
state {
_ifsSelStart :: Maybe Int
_ifsSelStart = 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 :: Millisecond
_ifsFocusStart = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
}
reqs :: [WidgetRequest s e]
reqs = [forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
caretMs forall a. Maybe a
Nothing, forall s e. Rect -> WidgetRequest s e
StartTextInput Rect
viewport]
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
reqs
focusRs :: Maybe (WidgetResult s e)
focusRs = forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
newNode Path
prev (forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnFocusReq InputFieldCfg s e a
config)
result :: WidgetResult s e
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
focusRs
Blur Path
next -> forall a. a -> Maybe a
Just WidgetResult s e
result where
reqs :: [WidgetRequest s e]
reqs = [forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId, forall s e. WidgetRequest s e
StopTextInput]
newResult :: WidgetResult s e
newResult = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs
blurResult :: Maybe (WidgetResult s e)
blurResult = forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnBlurReq InputFieldCfg s e a
config)
result :: WidgetResult s e
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
blurResult
SystemEvent
_ -> forall a. Maybe a
Nothing
where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
viewport :: Rect
viewport = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKeyMod s a => Lens' s a
L.keyMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasLeftShift s a => Lens' s a
L.leftShift
dragSelectText :: a -> Bool
dragSelectText a
btn
= WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainButton s a => Lens' s a
L.mainButton 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasMainButton s a => Lens' s a
L.mainButton forall a. Eq a => a -> a -> Bool
== a
btn
Bool -> Bool -> Bool
&& Bool
shiftPressed
Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe (InputDragHandler a)
dragHandler
validCursor :: CursorIcon
validCursor
| Bool -> Bool
not Bool
shiftPressed Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing Maybe (InputDragHandler a)
dragHandler = CursorIcon
CursorIBeam
| Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe CursorIcon
CursorArrow Maybe CursorIcon
dragCursor
changeCursorReq :: CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
newCursor = forall {s} {e}. [WidgetRequest s e]
reqs where
cursorMatch :: Bool
cursorMatch = WidgetEnv s e
wenv forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasCursor s a => Lens' s a
L.cursor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just CursorIcon
newCursor
reqs :: [WidgetRequest s e]
reqs
| Bool -> Bool
not Bool
cursorMatch = [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 = 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
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int
addedLen forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
min Int
currPos (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
| Bool
otherwise = Int
addedLen 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 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 = forall a. a -> Maybe a
Just WidgetResult s e
result where
tmpResult :: WidgetResult s e
tmpResult = forall a. a -> Maybe a -> a
fromMaybe (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
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText))
replaceText :: Text -> Text -> Text
replaceText Text
txt Text
newTxt
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int -> Text -> Text
T.take Int
start Text
txt forall a. Semigroup a => a -> a -> a
<> Text
newTxt 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 forall a. Semigroup a => a -> a -> a
<> Text
newTxt forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
currPos Text
txt
where
start :: Int
start = forall a. Ord a => a -> a -> a
min Int
currPos (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
end :: Int
end = forall a. Ord a => a -> a -> a
max Int
currPos (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
selectedText :: Text
selectedText
| forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int -> Text -> Text
T.take (Int
end forall a. Num a => a -> a -> a
- Int
start) forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
start Text
currText
| Bool
otherwise = Text
""
where
start :: Int
start = forall a. Ord a => a -> a -> a
min Int
currPos (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
end :: Int
end = forall a. Ord a => a -> a -> a
max Int
currPos (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 = forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput InputFieldCfg s e a
config Text
newText
isValid :: Bool
isValid = 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 = forall a. a -> Maybe a -> a
fromMaybe a
currVal Maybe a
newVal
| Bool
otherwise = a
currVal
tempState :: InputFieldState a
tempState = 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 = forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
tempState
history :: Seq (HistoryStep a)
history = forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
tempState
histIdx :: Int
histIdx = forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
tempState
!newStep :: HistoryStep a
newStep = 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 forall a. Eq a => a -> a -> Bool
== Text
newText = InputFieldState a
tempState
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (HistoryStep a)
history forall a. Eq a => a -> a -> Bool
== Int
histIdx = InputFieldState a
tempState {
_ifsHistory :: Seq (HistoryStep a)
_ifsHistory = Seq (HistoryStep a)
history forall a. Seq a -> a -> Seq a
|> HistoryStep a
newStep,
_ifsHistIdx :: Int
_ifsHistIdx = Int
histIdx forall a. Num a => a -> a -> a
+ Int
1
}
| Bool
otherwise = InputFieldState a
tempState {
_ifsHistory :: Seq (HistoryStep a)
_ifsHistory = forall a. Int -> Seq a -> Seq a
Seq.take (Int
histIdx forall a. Num a => a -> a -> a
- Int
1) Seq (HistoryStep a)
history forall a. Seq a -> a -> Seq a
|> HistoryStep a
newStep,
_ifsHistIdx :: Int
_ifsHistIdx = Int
histIdx
}
!newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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) = 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 = 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 = 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 = forall s e a. InputFieldCfg s e a -> Double
_ifcDefWidth InputFieldCfg s e a
config
resizeOnChange :: Bool
resizeOnChange = forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange InputFieldCfg s e a
config
currText :: Text
currText
| forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state forall a. Eq a => a -> a -> Bool
/= Text
"" = forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
| Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe Text
"" (forall s e a. InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder InputFieldCfg s e a
config)
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
Size Double
w Double
h = forall s e. WidgetEnv s e -> StyleState -> Text -> Size
getTextSize WidgetEnv s e
wenv StyleState
style Text
currText
targetW :: Double
targetW
| Bool
resizeOnChange = 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 = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
tempNode :: WidgetNode s e
tempNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
viewport
newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& (Bool
focused Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
selectOnFocus)) forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
selRect (forall a. a -> Maybe a
Just Color
selColor) forall a. Maybe a
Nothing
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
currText forall a. Eq a => a -> a -> Bool
== Text
"" Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq TextLine
currPlaceholder)) forall a b. (a -> b) -> a -> b
$
Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer (Double -> Double -> Point
Point Double
cx Double
cy) forall a b. (a -> b) -> a -> b
$
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)
forall a.
Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
renderContent Renderer
renderer InputFieldState a
state StyleState
style (forall s e a. InputFieldCfg s e a -> Text -> Text
getDisplayText InputFieldCfg s e a
config Text
currText)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
caretRequired forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
caretRect (forall a. a -> Maybe a
Just Color
caretColor) forall a. Maybe a
Nothing
where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
placeholderStyle :: StyleState
placeholderStyle = StyleState
style
forall a b. a -> (a -> b) -> b
& forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFontColor s a => Lens' s a
L.fontColor forall s t a b. ASetter s t a b -> b -> s -> t
.~ StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasSndColor s a => Lens' s a
L.sndColor
carea :: Rect
carea = 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 = forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus InputFieldCfg s e a
config
focused :: Bool
focused = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
ts :: Millisecond
ts = forall s e. WidgetEnv s e -> Millisecond
_weTimestamp WidgetEnv s e
wenv
caretTs :: Millisecond
caretTs = Millisecond
ts forall a. Num a => a -> a -> a
- forall a. InputFieldState a -> Millisecond
_ifsFocusStart InputFieldState a
state
caretRequired :: Bool
caretRequired = Bool
focused Bool -> Bool -> Bool
&& forall a. Integral a => a -> Bool
even (Millisecond
caretTs forall a. Integral a => a -> a -> a
`div` Millisecond
caretMs)
caretColor :: Color
caretColor = StyleState -> Color
styleFontColor StyleState
style
caretRect :: Rect
caretRect = 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 = 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 :: forall a.
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 = forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
textMetrics :: TextMetrics
textMetrics = forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
textPos :: Point
textPos = Double -> Double -> Point
Point Double
tx (Double
ty forall a. Num a => a -> a -> a
+ Double
th forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
textOffsetY TextMetrics
textMetrics StyleState
style)
textStyle :: TextStyle
textStyle = forall a. a -> Maybe a -> a
fromMaybe 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 :: forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state = Double
lineh where
TextMetrics Double
asc Double
desc Double
lineh Double
_ = forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
getCaretOffset :: TextMetrics -> StyleState -> Double
getCaretOffset :: TextMetrics -> StyleState -> Double
getCaretOffset TextMetrics
metrics StyleState
style = Double
textOffset forall a. Num a => a -> a -> a
- Double
desc where
TextMetrics Double
asc Double
desc Double
lineh Double
_ = TextMetrics
metrics
textOffset :: Double
textOffset = TextMetrics -> StyleState -> Double
textOffsetY TextMetrics
metrics StyleState
style
getCaretRect
:: InputFieldCfg s e a
-> InputFieldState a
-> StyleState
-> Rect
-> Rect
getCaretRect :: 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 = Rect
caretRect where
Rect Double
cx Double
cy Double
cw Double
ch = Rect
carea
Rect Double
tx Double
ty Double
tw Double
th = forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
caretW :: Double
caretW = forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
textMetrics :: TextMetrics
textMetrics = forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
glyphs :: Seq GlyphPos
glyphs = forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
pos :: Int
pos = forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
caretPos :: Double
caretPos
| Int
pos forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq GlyphPos
glyphs = Double
0
| Int
pos forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = GlyphPos -> Double
_glpXMax (forall a. Seq a -> a
seqLast Seq GlyphPos
glyphs)
| Bool
otherwise = GlyphPos -> Double
_glpXMin (forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs Int
pos)
caretX :: Double -> Double
caretX Double
tx = forall a. Ord a => a -> a -> a
max Double
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (Double
cx forall a. Num a => a -> a -> a
+ Double
cw forall a. Num a => a -> a -> a
- Double
caretW) (Double
tx forall a. Num a => a -> a -> a
+ Double
caretPos)
caretY :: Double
caretY = Double
ty forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
getCaretOffset TextMetrics
textMetrics StyleState
style
caretRect :: Rect
caretRect = Double -> Double -> Double -> Double -> Rect
Rect (Double -> Double
caretX Double
tx) Double
caretY Double
caretW (forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state)
getSelRect :: InputFieldState a -> StyleState -> Rect
getSelRect :: forall a. InputFieldState a -> StyleState -> Rect
getSelRect InputFieldState a
state StyleState
style = Rect
selRect where
Rect Double
tx Double
ty Double
tw Double
th = forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
textMetrics :: TextMetrics
textMetrics = forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
glyphs :: Seq GlyphPos
glyphs = forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
pos :: Int
pos = forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
sel :: Maybe Int
sel = forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
state
caretY :: Double
caretY = Double
ty forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
getCaretOffset TextMetrics
textMetrics StyleState
style
caretH :: Double
caretH = forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state
glyph :: Int -> GlyphPos
glyph Int
idx = forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs (forall a. Ord a => a -> a -> a
min Int
idx (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs 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 = forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ GlyphPos -> Double
_glpXMax (Int -> GlyphPos
glyph Int
end) forall a. Num a => a -> a -> a
- GlyphPos -> Double
_glpXMin (Int -> GlyphPos
glyph Int
start)
mkSelRect :: Int -> Rect
mkSelRect Int
end
| Int
pos forall a. Ord a => a -> a -> Bool
> Int
end = Double -> Double -> Double -> Double -> Rect
Rect (Double
tx forall a. Num a => a -> a -> a
+ Int -> Double
gx Int
end) Double
caretY (Int -> Int -> Double
gw Int
end (Int
pos forall a. Num a => a -> a -> a
- Int
1)) Double
caretH
| Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect (Double
tx forall a. Num a => a -> a -> a
+ Int -> Double
gx Int
pos) Double
caretY (Int -> Int -> Double
gw Int
pos (Int
end forall a. Num a => a -> a -> a
- Int
1)) Double
caretH
selRect :: Rect
selRect = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Default a => a
def Int -> Rect
mkSelRect Maybe Int
sel
findClosestGlyphPos :: InputFieldState a -> Point -> Int
findClosestGlyphPos :: forall a. InputFieldState a -> Point -> Int
findClosestGlyphPos InputFieldState a
state Point
point = Int
newPos where
Point Double
x Double
y = Point
point
textRect :: Rect
textRect = forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
localX :: Double
localX = Double
x forall a. Num a => a -> a -> a
- Rect -> Double
_rX Rect
textRect
textLen :: Double
textLen = Seq GlyphPos -> Double
getGlyphsMax (forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state)
glyphs :: Seq GlyphPos
glyphs
| forall a. Seq a -> Bool
Seq.null (forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state) = forall a. Seq a
Seq.empty
| Bool
otherwise = forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state forall a. Seq a -> a -> Seq a
|> Char
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> GlyphPos
GlyphPos Char
' ' Double
0 Double
textLen Double
0 Double
0 Double
0 Double
0 Double
0
glyphStart :: a -> GlyphPos -> (a, Double)
glyphStart a
i GlyphPos
g = (a
i, forall a. Num a => a -> a
abs (GlyphPos -> Double
_glpXMin GlyphPos
g forall a. Num a => a -> a -> a
- Double
localX))
pairs :: Seq (Int, Double)
pairs = forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex forall {a}. a -> GlyphPos -> (a, Double)
glyphStart Seq GlyphPos
glyphs
cpm :: (a, a) -> (a, a) -> Ordering
cpm (a
_, a
g1) (a
_, a
g2) = forall a. Ord a => a -> a -> Ordering
compare a
g1 a
g2
diffs :: Seq (Int, Double)
diffs = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cpm Seq (Int, Double)
pairs
newPos :: Int
newPos = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a b. (a, b) -> a
fst (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 :: 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 = ([WidgetRequest s e], [e])
result where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
resizeOnChange :: Bool
resizeOnChange = forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange InputFieldCfg s e a
config
fromText :: Text -> Maybe a
fromText = forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText InputFieldCfg s e a
config
setModelValue :: a -> [WidgetRequest s e]
setModelValue = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue InputFieldCfg s e a
config)
currVal :: a
currVal = forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
currText :: Text
currText = forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
accepted :: Bool
accepted = forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput InputFieldCfg s e a
config Text
newText
isValid :: Bool
isValid = 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 = forall a. a -> Maybe a -> a
fromMaybe a
currVal Maybe a
newVal
txtChanged :: Bool
txtChanged = Text
newText forall a. Eq a => a -> a -> Bool
/= Text
currText
valChanged :: Bool
valChanged = a
stateVal forall a. Eq a => a -> a -> Bool
/= a
currVal
!evtValid :: [e]
evtValid
| Bool
txtChanged = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Bool
isValid) (forall s e a. InputFieldCfg s e a -> [Bool -> e]
_ifcValidV InputFieldCfg s e a
config)
| Bool
otherwise = []
reqValid :: [WidgetRequest s e]
reqValid = 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 = forall {e}. a -> [WidgetRequest s e]
setModelValue a
stateVal
| Bool
otherwise = []
reqResize :: [WidgetRequest s e]
reqResize
| Bool
resizeOnChange Bool -> Bool -> Bool
&& Bool
valChanged = [forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId]
| Bool
otherwise = []
reqOnChange :: [WidgetRequest s e]
reqOnChange
| Bool
accepted Bool -> Bool -> Bool
&& Bool
valChanged = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
stateVal) (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 forall a. [a] -> [a] -> [a]
++ forall {e}. [WidgetRequest s e]
reqUpdateModel forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqValid forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
reqResize 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 :: 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
steps = Maybe (WidgetResult s e)
result where
historyStep :: HistoryStep a
historyStep = forall a. a -> HistoryStep a
initialHistoryStep (forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue InputFieldCfg s e a
config)
currHistory :: Seq (HistoryStep a)
currHistory = forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
state
currHistIdx :: Int
currHistIdx = forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
state
lenHistory :: Int
lenHistory = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (HistoryStep a)
currHistory
reqHistIdx :: Int
reqHistIdx
| Int
steps forall a. Eq a => a -> a -> Bool
== -Int
1 Bool -> Bool -> Bool
&& Int
currHistIdx forall a. Eq a => a -> a -> Bool
== Int
lenHistory = Int
currHistIdx forall a. Num a => a -> a -> a
- Int
2
| Bool
otherwise = Int
currHistIdx forall a. Num a => a -> a -> a
+ Int
steps
histStep :: Maybe (HistoryStep a)
histStep = forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
reqHistIdx Seq (HistoryStep a)
currHistory
result :: Maybe (WidgetResult s e)
result
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (HistoryStep a)
currHistory Bool -> Bool -> Bool
|| Int
reqHistIdx forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. a -> Maybe a
Just (HistoryStep a -> WidgetResult s e
createResult HistoryStep a
historyStep)
| Bool
otherwise = 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 = 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) = 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 (forall a. HistoryStep a -> Text
_ihsText HistoryStep a
histStep) []
tempState :: InputFieldState a
tempState = 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 = forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
lenHistory Int
reqHistIdx
}
!newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 :: 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
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 = 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 :: 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
value Text
text Int
cursor Maybe Int
sel = InputFieldState a
newState where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
caretW :: Double
caretW = forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (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 forall a. Eq a => a -> a -> Bool
== AlignTH
ATLeft
alignR :: Bool
alignR = AlignTH
alignH forall a. Eq a => a -> a -> Bool
== AlignTH
ATRight
alignC :: Bool
alignC = AlignTH
alignH forall a. Eq a => a -> a -> Bool
== AlignTH
ATCenter
cursorL :: Bool
cursorL = Int
cursor forall a. Eq a => a -> a -> Bool
== Int
0
cursorR :: Bool
cursorR = Int
cursor forall a. Eq a => a -> a -> Bool
== Text -> Int
T.length Text
text
!textMetrics :: TextMetrics
textMetrics = forall s e. WidgetEnv s e -> StyleState -> TextMetrics
getTextMetrics WidgetEnv s e
wenv StyleState
style
!textRect :: Rect
textRect = 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 forall a. Ord a => a -> a -> Bool
>= Double
tw
glyphs :: Seq GlyphPos
glyphs = forall s e. WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
getTextGlyphs WidgetEnv s e
wenv StyleState
style (forall s e a. InputFieldCfg s e a -> Text -> Text
getDisplayText InputFieldCfg s e a
config Text
text)
glyphStart :: Double
glyphStart = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 GlyphPos -> Double
_glpXMax forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Maybe a
Seq.lookup (Int
cursor 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 forall a. Num a => a -> a -> a
- Double
glyphOffset
curX :: Double
curX = Double
tx forall a. Num a => a -> a -> a
+ Double
glyphX
oldOffset :: Double
oldOffset = forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
oldState
newOffset :: Double
newOffset
| forall a b. (RealFrac a, Integral b) => a -> b
round Double
cw 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 forall a. Num a => a -> a -> a
- Double
tx forall a. Num a => a -> a -> a
+ Double
caretW
| Bool
alignL Bool -> Bool -> Bool
&& Double
curX forall a. Num a => a -> a -> a
+ Double
oldOffset forall a. Ord a => a -> a -> Bool
> Double
cx forall a. Num a => a -> a -> a
+ Double
cw = Double
cx forall a. Num a => a -> a -> a
+ Double
cw forall a. Num a => a -> a -> a
- Double
curX
| Bool
alignL Bool -> Bool -> Bool
&& Double
curX forall a. Num a => a -> a -> a
+ Double
oldOffset forall a. Ord a => a -> a -> Bool
< Double
cx = Double
cx 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 forall a. Num a => a -> a -> a
+ Double
oldOffset forall a. Ord a => a -> a -> Bool
> Double
cx forall a. Num a => a -> a -> a
+ Double
cw = Double
tw forall a. Num a => a -> a -> a
- Double
glyphX
| Bool
alignR Bool -> Bool -> Bool
&& Double
curX forall a. Num a => a -> a -> a
+ Double
oldOffset forall a. Ord a => a -> a -> Bool
< Double
cx = Double
tw forall a. Num a => a -> a -> a
- Double
cw forall a. Num a => a -> a -> a
- Double
glyphX
| Bool
alignC Bool -> Bool -> Bool
&& Double
curX forall a. Num a => a -> a -> a
+ Double
oldOffset forall a. Ord a => a -> a -> Bool
> Double
cx forall a. Num a => a -> a -> a
+ Double
cw = Double
cx forall a. Num a => a -> a -> a
+ Double
cw forall a. Num a => a -> a -> a
- Double
curX
| Bool
alignC Bool -> Bool -> Bool
&& Double
curX forall a. Num a => a -> a -> a
+ Double
oldOffset forall a. Ord a => a -> a -> Bool
< Double
cx = Double
cx forall a. Num a => a -> a -> a
- Double
curX
| Bool
otherwise = Double
oldOffset
justSel :: Int
justSel = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
sel
newSel :: Maybe Int
newSel
| forall a. a -> Maybe a
Just Int
cursor forall a. Eq a => a -> a -> Bool
== Maybe Int
sel = forall a. Maybe a
Nothing
| forall a. Maybe a -> Bool
isJust Maybe Int
sel Bool -> Bool -> Bool
&& (Int
justSel forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
justSel forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
text) = forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Int
sel
!tmpState :: InputFieldState a
tmpState = 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 forall a b. a -> (a -> b) -> b
& forall s a. HasX s a => Lens' s a
L.x forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
tx 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 :: 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
state !InputFieldCfg s e a
config = InputFieldState a
newState where
fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFontManager s a => Lens' s a
L.fontManager
style :: StyleState
style = 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 = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignH s a => Lens' s a
L.alignH forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StyleState -> AlignTH
inputFieldAlignH StyleState
style
forall a b. a -> (a -> b) -> b
& forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignV s a => Lens' s a
L.alignV forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StyleState -> AlignTV
inputFieldAlignV StyleState
style
text :: Maybe Text
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 forall a. Maybe a
Nothing
lines :: Seq TextLine
lines
| forall a. Maybe a -> Bool
isJust Maybe Text
text = Size -> Text -> Seq TextLine
fitText Size
size (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
text)
| Bool
otherwise = 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 :: forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config
| forall a. Maybe a -> Bool
isJust (forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid InputFieldCfg s e a
config) = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid InputFieldCfg s e a
config)
| Bool
otherwise = forall a b. a -> b -> a
const []
inputFieldAlignH :: StyleState -> AlignTH
inputFieldAlignH :: StyleState -> AlignTH
inputFieldAlignH StyleState
style = forall a. a -> Maybe a -> a
fromMaybe AlignTH
ATLeft Maybe AlignTH
alignH where
alignH :: Maybe AlignTH
alignH = StyleState
style forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignH s a => Lens' s a
L.alignH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
inputFieldAlignV :: StyleState -> AlignTV
inputFieldAlignV :: StyleState -> AlignTV
inputFieldAlignV StyleState
style = forall a. a -> Maybe a -> a
fromMaybe AlignTV
ATLowerX Maybe AlignTV
alignV where
alignV :: Maybe AlignTV
alignV = StyleState
style forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasAlignV s a => Lens' s a
L.alignV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
getDisplayText :: InputFieldCfg s e a -> Text -> Text
getDisplayText :: forall s e a. 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e a. InputFieldCfg s e a -> Maybe Char
_ifcDisplayChar InputFieldCfg s e a
config
displayText :: Text
displayText
| forall a. Maybe a -> Bool
isJust Maybe Text
displayChar = Int -> Text -> Text
T.replicate (Text -> Int
T.length 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'.', Char
',', Char
'/', Char
'-', Char
':']