{-|
Module      : Monomer.Widgets.Singles.Base.InputField
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Base single line text editing field. Extensible for handling specific textual
representations of other types, such as numbers and dates. It is not meant for
direct use, but to create custom widgets using it.

See "Monomer.Widgets.Singles.NumericField", "Monomer.Widgets.Singles.DateField",
"Monomer.Widgets.Singles.TimeField" and "Monomer.Widgets.Singles.TextField".
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.Base.InputField (
  -- * Configuration
  InputFieldValue,
  InputWheelHandler,
  InputDragHandler,
  InputFieldCfg(..),
  InputFieldState(..),
  HistoryStep,
  -- * Constructors
  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

-- | Constraints for a value handled by input field.
type InputFieldValue a = (Eq a, Show a, Typeable a)

{-|
Handler for wheel events. Useful for values on which increase/decrease makes
sense.
-}
type InputWheelHandler a
  = InputFieldState a        -- ^ The state of the input field
  -> Point                   -- ^ The mouse position.
  -> Point                   -- ^ The wheel movement along x/y.
  -> WheelDirection          -- ^ Whether movement is normal or inverted.
  -> (Text, Int, Maybe Int)  -- ^ New text, cursor position and selection start.

{-|
Handler for drag events. Useful for values on which increase/decrease makes
sense.
-}
type InputDragHandler a
  = InputFieldState a        -- ^ The state of the input field
  -> Point                   -- ^ The mouse position.
  -> Point                   -- ^ The wheel movement along x/y.
  -> (Text, Int, Maybe Int)  -- ^ New text, cursor position and selection start.

{-|
Configuration options for an input field. These options are not directly exposed
to users; each derived widget should expose its own options.
-}
data InputFieldCfg s e a = InputFieldCfg {
  -- | Placeholder text to show when input is empty.
  forall s e a. InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder :: Maybe Text,
  -- | Initial value for the input field, before retrieving from model.
  forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue :: a,
  -- | Where to get current data from.
  forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue :: WidgetData s a,
  -- | Flag to indicate if the field is valid or not, using a lens.
  forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid :: Maybe (WidgetData s Bool),
  -- | Flag to indicate if the field is valid or not, using an event handler.
  forall s e a. InputFieldCfg s e a -> [Bool -> e]
_ifcValidV :: [Bool -> e],
  -- | Whether to put cursor at the end of input on init. Defaults to False.
  forall s e a. InputFieldCfg s e a -> Bool
_ifcDefCursorEnd :: Bool,
  -- | Default width of the input field.
  forall s e a. InputFieldCfg s e a -> Double
_ifcDefWidth :: Double,
  -- | Caret width.
  forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth :: Maybe Double,
  -- | Caret blink period.
  forall s e a. InputFieldCfg s e a -> Maybe Millisecond
_ifcCaretMs :: Maybe Millisecond,
  -- | Character to display as text replacement. Useful for passwords.
  forall s e a. InputFieldCfg s e a -> Maybe Char
_ifcDisplayChar :: Maybe Char,
  -- | Whether input causes ResizeWidgets requests. Defaults to False.
  forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange :: Bool,
  -- | If all input should be selected when focus is received.
  forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus :: Bool,
  -- | Whether the input should be read-only (with editing not allowed, but allowing selection).
  forall s e a. InputFieldCfg s e a -> Bool
_ifcReadOnly :: Bool,
  -- | Conversion from text to the expected value. Failure returns Nothing.
  forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText :: Text -> Maybe a,
  -- | Conversion from a value to text. Cannot fail.
  forall s e a. InputFieldCfg s e a -> a -> Text
_ifcToText :: a -> Text,
  {-|
  Whether to accept the current input status. The conversion fromText may still
  fail, but input still will be accepted. This is used, for instance, in date
  fields when input is not complete and a valid date cannot be created.
  -}
  forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput :: Text -> Bool,
  {-|
  Whether the current text is valid input. Valid input means being able to
  convert to the expected type, and after that conversion the value matches the
  expected constraints (for instance, a well formed number between 1 and 100).
  -}
  forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcIsValidInput :: Text -> Bool,
  -- | Base style retrieved from the active theme.
  forall s e a.
InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
_ifcStyle :: Maybe (ALens' ThemeState StyleState),
  -- | Handler for wheel events.
  forall s e a. InputFieldCfg s e a -> Maybe (InputWheelHandler a)
_ifcWheelHandler :: Maybe (InputWheelHandler a),
  -- | Handler for drag events.
  forall s e a. InputFieldCfg s e a -> Maybe (InputDragHandler a)
_ifcDragHandler :: Maybe (InputDragHandler a),
  -- | Cursor to display on drag events.
  forall s e a. InputFieldCfg s e a -> Maybe CursorIcon
_ifcDragCursor :: Maybe CursorIcon,
  -- | 'WidgetRequest' to generate when focus is received.
  forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnFocusReq :: [Path -> WidgetRequest s e],
  -- | 'WidgetRequest' to generate when focus is lost.
  forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnBlurReq :: [Path -> WidgetRequest s e],
  -- | 'WidgetRequest' to generate when value changes.
  forall s e a. InputFieldCfg s e a -> [a -> WidgetRequest s e]
_ifcOnChangeReq :: [a -> WidgetRequest s e]
}

-- | Snapshot of a point in history of the input.
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
}

-- | Current state of the input field. Provided to some event handlers.
data InputFieldState a = InputFieldState {
  {-|
  The placeholder text to show when input is empty. Does not depend on cursor
  position.
  -}
  forall a. InputFieldState a -> Seq TextLine
_ifsPlaceholder :: Seq TextLine,
  -- | The latest valid value.
  forall a. InputFieldState a -> a
_ifsCurrValue :: a,
  -- | The latest accepted input text.
  forall a. InputFieldState a -> Text
_ifsCurrText :: !Text,
  -- | The current cursor position.
  forall a. InputFieldState a -> Int
_ifsCursorPos :: !Int,
  -- | The selection start. Once selection begins, it doesn't change until done.
  forall a. InputFieldState a -> Maybe Int
_ifsSelStart :: Maybe Int,
  -- | The value when drag event started.
  forall a. InputFieldState a -> a
_ifsDragSelValue :: a,
  -- | The glyphs of the current text.
  forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs :: Seq GlyphPos,
  -- | The offset of the current text, given cursor position and text length.
  forall a. InputFieldState a -> Double
_ifsOffset :: !Double,
  -- | The rect of the current text, given cursor position and text length.
  forall a. InputFieldState a -> Rect
_ifsTextRect :: Rect,
  -- | Text metrics of the current font and size.
  forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics :: TextMetrics,
  -- | Edit history of the current field. Supports undo and redo.
  forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory :: Seq (HistoryStep a),
  -- | Current index into history.
  forall a. InputFieldState a -> Int
_ifsHistIdx :: Int,
  -- | The timestamp when focus was received (used for caret blink)
  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

-- | Creates an instance of an input field, with customizations in config.
inputField_
  :: (InputFieldValue a, WidgetEvent e)
  => WidgetType           -- ^ The 'WidgetType' of an input field.
  -> InputFieldCfg s e a  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created instance of an input field.
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
  }

  -- Simpler access to state members
  !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
  -- Text/value conversion functions
  !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)
  -- Mouse select handling options
  !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
    -- Begin regular text selection
    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

    -- Begin custom drag
    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

    -- Select one word if clicked twice in a row
    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]

    -- Select all if clicked three times in a row
    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]

    -- If a custom drag handler is used, generate onChange events and history
    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

    -- Handle regular text selection
    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)

    -- Handle custom drag
    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

    -- Sets the correct cursor icon
    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

    -- Handle wheel
    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

    -- Handle keyboard shortcuts and possible cursor changes
    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

    -- Handle possible cursor reset
    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)

    -- Text input has unicode already processed (it's not the same as KeyAction)
    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

    -- Paste clipboard contents
    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

    -- Handle focus, maybe select all and disable custom drag handlers
    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

    -- Handle blur and disable custom drag handlers
    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
    -- newTextState depends on having correct viewport in the node
    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
  -- Placeholder style
  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
':']