{-|
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
(HistoryStep a -> HistoryStep a -> Bool)
-> (HistoryStep a -> HistoryStep a -> Bool) -> Eq (HistoryStep a)
forall a. Eq a => HistoryStep a -> HistoryStep a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: HistoryStep a -> HistoryStep a -> Bool
Eq, Int -> HistoryStep a -> ShowS
[HistoryStep a] -> ShowS
HistoryStep a -> String
(Int -> HistoryStep a -> ShowS)
-> (HistoryStep a -> String)
-> ([HistoryStep a] -> ShowS)
-> Show (HistoryStep a)
forall a. Show a => Int -> HistoryStep a -> ShowS
forall a. Show a => [HistoryStep a] -> ShowS
forall a. Show a => HistoryStep a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> HistoryStep a -> ShowS
showsPrec :: Int -> HistoryStep a -> ShowS
$cshow :: forall a. Show a => HistoryStep a -> String
show :: HistoryStep a -> String
$cshowList :: forall a. Show a => [HistoryStep a] -> ShowS
showList :: [HistoryStep a] -> ShowS
Show, (forall x. HistoryStep a -> Rep (HistoryStep a) x)
-> (forall x. Rep (HistoryStep a) x -> HistoryStep a)
-> Generic (HistoryStep a)
forall x. Rep (HistoryStep a) x -> HistoryStep a
forall x. HistoryStep a -> Rep (HistoryStep a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (HistoryStep a) x -> HistoryStep a
forall a x. HistoryStep a -> Rep (HistoryStep a) x
$cfrom :: forall a x. HistoryStep a -> Rep (HistoryStep a) x
from :: forall x. HistoryStep a -> Rep (HistoryStep a) x
$cto :: forall a x. Rep (HistoryStep a) x -> HistoryStep a
to :: forall x. Rep (HistoryStep a) x -> HistoryStep a
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 = Maybe Int
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
(InputFieldState a -> InputFieldState a -> Bool)
-> (InputFieldState a -> InputFieldState a -> Bool)
-> Eq (InputFieldState a)
forall a. Eq a => InputFieldState a -> InputFieldState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: InputFieldState a -> InputFieldState a -> Bool
Eq, Int -> InputFieldState a -> ShowS
[InputFieldState a] -> ShowS
InputFieldState a -> String
(Int -> InputFieldState a -> ShowS)
-> (InputFieldState a -> String)
-> ([InputFieldState a] -> ShowS)
-> Show (InputFieldState a)
forall a. Show a => Int -> InputFieldState a -> ShowS
forall a. Show a => [InputFieldState a] -> ShowS
forall a. Show a => InputFieldState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> InputFieldState a -> ShowS
showsPrec :: Int -> InputFieldState a -> ShowS
$cshow :: forall a. Show a => InputFieldState a -> String
show :: InputFieldState a -> String
$cshowList :: forall a. Show a => [InputFieldState a] -> ShowS
showList :: [InputFieldState a] -> ShowS
Show, Typeable, (forall x. InputFieldState a -> Rep (InputFieldState a) x)
-> (forall x. Rep (InputFieldState a) x -> InputFieldState a)
-> Generic (InputFieldState a)
forall x. Rep (InputFieldState a) x -> InputFieldState a
forall x. InputFieldState a -> Rep (InputFieldState a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (InputFieldState a) x -> InputFieldState a
forall a x. InputFieldState a -> Rep (InputFieldState a) x
$cfrom :: forall a x. InputFieldState a -> Rep (InputFieldState a) x
from :: forall x. InputFieldState a -> Rep (InputFieldState a) x
$cto :: forall a x. Rep (InputFieldState a) x -> InputFieldState a
to :: forall x. Rep (InputFieldState a) x -> InputFieldState a
Generic)

initialState :: a -> InputFieldState a
initialState :: forall a. a -> InputFieldState a
initialState a
value = InputFieldState {
  _ifsPlaceholder :: Seq TextLine
_ifsPlaceholder = Seq TextLine
forall a. Seq a
Seq.empty,
  _ifsCurrValue :: a
_ifsCurrValue = a
value,
  _ifsCurrText :: Text
_ifsCurrText = Text
"",
  _ifsGlyphs :: Seq GlyphPos
_ifsGlyphs = Seq GlyphPos
forall a. Seq a
Seq.empty,
  _ifsCursorPos :: Int
_ifsCursorPos = Int
0,
  _ifsSelStart :: Maybe Int
_ifsSelStart = Maybe Int
forall a. Maybe a
Nothing,
  _ifsDragSelValue :: a
_ifsDragSelValue = a
value,
  _ifsOffset :: Double
_ifsOffset = Double
0,
  _ifsTextRect :: Rect
_ifsTextRect = Rect
forall a. Default a => a
def,
  _ifsTextMetrics :: TextMetrics
_ifsTextMetrics = TextMetrics
forall a. Default a => a
def,
  _ifsHistory :: Seq (HistoryStep a)
_ifsHistory = Seq (HistoryStep a)
forall a. Seq a
Seq.empty,
  _ifsHistIdx :: Int
_ifsHistIdx = Int
0,
  _ifsFocusStart :: 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 = InputFieldCfg s e a -> a
forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue InputFieldCfg s e a
config
  widget :: Widget s e
widget = InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config (a -> InputFieldState a
forall a. a -> InputFieldState a
initialState a
value)
  node :: WidgetNode s e
node = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetType Widget s e
widget
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
Lens' WidgetNodeInfo Bool
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

makeInputField
  :: (InputFieldValue a, WidgetEvent e)
  => InputFieldCfg s e a
  -> InputFieldState a
  -> Widget s e
makeInputField :: 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 = InputFieldState a -> Single s e (InputFieldState a) -> Widget s e
forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle InputFieldState a
state Single s e Any
forall a. Default a => a
def {
    singleFocusOnBtnPressed = False,
    singleUseCustomCursor = True,
    singleUseScissor = True,
    singleGetBaseStyle = getBaseStyle,
    singleInit = init,
    singleMerge = merge,
    singleDispose = dispose,
    singleHandleEvent = handleEvent,
    singleGetSizeReq = getSizeReq,
    singleResize = resize,
    singleRender = render
  }

  -- Simpler access to state members
  !currPlaceholder :: Seq TextLine
currPlaceholder = InputFieldState a -> Seq TextLine
forall a. InputFieldState a -> Seq TextLine
_ifsPlaceholder InputFieldState a
state
  !currVal :: a
currVal = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
  !currText :: Text
currText = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
  !currGlyphs :: Seq GlyphPos
currGlyphs = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
  !currPos :: Int
currPos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
  !currSel :: Maybe Int
currSel = InputFieldState a -> Maybe Int
forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
state
  !currOffset :: Double
currOffset = InputFieldState a -> Double
forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
state
  !currHistory :: Seq (HistoryStep a)
currHistory = InputFieldState a -> Seq (HistoryStep a)
forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
state
  !currHistIdx :: Int
currHistIdx = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
state
  -- Text/value conversion functions
  !caretW :: Double
caretW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (InputFieldCfg s e a -> Maybe Double
forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
  !caretMs :: Millisecond
caretMs = Millisecond -> Maybe Millisecond -> Millisecond
forall a. a -> Maybe a -> a
fromMaybe Millisecond
defCaretMs (InputFieldCfg s e a -> Maybe Millisecond
forall s e a. InputFieldCfg s e a -> Maybe Millisecond
_ifcCaretMs InputFieldCfg s e a
config)
  !editable :: Bool
editable = Bool -> Bool
not (InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcReadOnly InputFieldCfg s e a
config)
  !fromText :: Text -> Maybe a
fromText = InputFieldCfg s e a -> Text -> Maybe a
forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText InputFieldCfg s e a
config
  !toText :: a -> Text
toText = InputFieldCfg s e a -> a -> Text
forall s e a. InputFieldCfg s e a -> a -> Text
_ifcToText InputFieldCfg s e a
config
  getModelValue :: WidgetEnv s e -> a
getModelValue !WidgetEnv s e
wenv = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) (InputFieldCfg s e a -> WidgetData s a
forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue InputFieldCfg s e a
config)
  -- Mouse select handling options
  !wheelHandler :: Maybe (InputWheelHandler a)
wheelHandler = InputFieldCfg s e a -> Maybe (InputWheelHandler a)
forall s e a. InputFieldCfg s e a -> Maybe (InputWheelHandler a)
_ifcWheelHandler InputFieldCfg s e a
config
  !dragHandler :: Maybe (InputDragHandler a)
dragHandler = InputFieldCfg s e a -> Maybe (InputDragHandler a)
forall s e a. InputFieldCfg s e a -> Maybe (InputDragHandler a)
_ifcDragHandler InputFieldCfg s e a
config
  !dragCursor :: Maybe CursorIcon
dragCursor = InputFieldCfg s e a -> Maybe CursorIcon
forall s e a. InputFieldCfg s e a -> Maybe CursorIcon
_ifcDragCursor InputFieldCfg s e a
config

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
forall s e a.
InputFieldCfg s e a -> Maybe (ALens' ThemeState StyleState)
_ifcStyle InputFieldCfg s e a
config Maybe (ALens' ThemeState StyleState)
-> (ALens' ThemeState StyleState -> Maybe Style) -> Maybe Style
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ALens' ThemeState StyleState -> Maybe Style
handler where
    handler :: ALens' ThemeState StyleState -> Maybe Style
handler ALens' ThemeState StyleState
lstyle = Style -> Maybe Style
forall a. a -> Maybe a
Just (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (ALens' ThemeState StyleState -> Lens' ThemeState StyleState
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' ThemeState StyleState
lstyle)

  init :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
    newValue :: a
newValue = WidgetEnv s e -> a
forall {e}. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv
    txtValue :: Text
txtValue = a -> Text
toText a
newValue
    txtPos :: Int
txtPos
      | InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcDefCursorEnd InputFieldCfg s e a
config = Text -> Int
T.length Text
txtValue
      | Bool
otherwise = Int
0
    newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config
    newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
newValue Text
txtValue Int
txtPos Maybe Int
forall a. Maybe a
Nothing
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
    parsedVal :: Maybe a
parsedVal = Text -> Maybe a
fromText (a -> Text
toText a
newValue)
    reqs :: [WidgetRequest s e]
reqs = InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
parsedVal)
    result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs

  merge :: WidgetEnv s e
-> WidgetNode s e -> p -> InputFieldState a -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode InputFieldState a
oldState = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs where
    oldInfo :: WidgetNodeInfo
oldInfo = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info
    oldValue :: a
oldValue = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
oldState
    oldText :: Text
oldText = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
oldState
    oldPos :: Int
oldPos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
oldState
    oldSel :: Maybe Int
oldSel = InputFieldState a -> Maybe Int
forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
oldState
    value :: a
value = WidgetEnv s e -> a
forall {e}. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv
    newText :: Text
newText
      | a
oldValue a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= WidgetEnv s e -> a
forall {e}. WidgetEnv s e -> a
getModelValue WidgetEnv s e
wenv = a -> Text
toText a
value
      | Bool
otherwise = Text
oldText
    newTextL :: Int
newTextL = Text -> Int
T.length Text
newText
    newPos :: Int
newPos
      | Text
oldText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newText = Int
oldPos
      | InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcDefCursorEnd InputFieldCfg s e a
config = Int
newTextL
      | Bool
otherwise = Int
0
    newSelStart :: Maybe Int
newSelStart
      | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
oldSel Bool -> Bool -> Bool
|| Int
newTextL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
oldSel = Maybe Int
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe Int
oldSel
    newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config
    newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
value Text
newText Int
newPos Maybe Int
newSelStart
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
    parsedVal :: Maybe a
parsedVal = Text -> Maybe a
fromText Text
newText
    oldPath :: Path
oldPath = WidgetNodeInfo
oldInfo WidgetNodeInfo -> Getting Path WidgetNodeInfo Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path WidgetNodeInfo Path
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo Path
L.path
    oldWid :: WidgetId
oldWid = WidgetNodeInfo
oldInfo WidgetNodeInfo
-> Getting WidgetId WidgetNodeInfo WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
    newPath :: Path
newPath = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> Getting Path WidgetNodeInfo Path
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Path WidgetNodeInfo Path
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo Path
L.path
    newWid :: WidgetId
newWid = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
    updateFocus :: Bool
updateFocus = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
Lens' (WidgetEnv s e) Path
L.focusedPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
oldPath Bool -> Bool -> Bool
&& Path
oldPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
newPath
    renderReqs :: [WidgetRequest s e]
renderReqs
      | Bool
updateFocus = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
oldWid, WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
newWid Millisecond
caretMs Maybe Int
forall a. Maybe a
Nothing]
      | Bool
otherwise = []
    reqs :: [WidgetRequest s e]
reqs = InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
parsedVal) [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
renderReqs

  dispose :: p -> WidgetNode s e -> WidgetResult s e
dispose p
wenv WidgetNode s e
node = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
    reqs :: [WidgetRequest s e]
reqs = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId ]

  handleKeyPress :: WidgetEnv s e -> KeyMod -> KeyCode -> Maybe (Text, Int, Maybe Int)
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code
    | Bool
isDelBackWordNoSel Bool -> Bool -> Bool
&& Bool
editable = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeWord Int
prevWordStartIdx Maybe Int
forall a. Maybe a
Nothing
    | Bool
isDelBackWord Bool -> Bool -> Bool
&& Bool
editable = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText Int
minTpSel Maybe Int
forall a. Maybe a
Nothing
    | Bool
isBackspace Bool -> Bool -> Bool
&& Bool
emptySel Bool -> Bool -> Bool
&& Bool
editable = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe Int
forall a. Maybe a
Nothing
    | Bool
isBackspace Bool -> Bool -> Bool
&& Bool
editable = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
removeText Int
minTpSel Maybe Int
forall a. Maybe a
Nothing
    | Bool
isMoveLeft = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe Int
forall a. Maybe a
Nothing
    | Bool
isMoveRight = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
forall a. Maybe a
Nothing
    | Bool
isMoveWordL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
prevWordStartIdx Maybe Int
forall a. Maybe a
Nothing
    | Bool
isMoveWordR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
nextWordEndIdx Maybe Int
forall a. Maybe a
Nothing
    | Bool
isMoveLineL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 Maybe Int
forall a. Maybe a
Nothing
    | Bool
isMoveLineR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
txtLen Maybe Int
forall a. Maybe a
Nothing
    | Bool
isSelectAll = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
txtLen)
    | Bool
isSelectLeft = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
    | Bool
isSelectRight = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt (Int
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
    | Bool
isSelectWordL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
prevWordStartIdx (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
    | Bool
isSelectWordR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
nextWordEndIdx (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
    | Bool
isSelectLineL = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
    | Bool
isSelectLineR = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
txtLen (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tp)
    | Bool
isDeselectLeft = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
minTpSel Maybe Int
forall a. Maybe a
Nothing
    | Bool
isDeselectRight = (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a. a -> Maybe a
Just ((Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int))
-> (Text, Int, Maybe Int) -> Maybe (Text, Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Int -> (Text, Int, Maybe Int)
forall {a}. a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor Text
txt Int
maxTpSel Maybe Int
forall a. Maybe a
Nothing
    | Bool
otherwise = Maybe (Text, Int, Maybe Int)
forall a. Maybe a
Nothing
    where
      txt :: Text
txt = Text
currText
      txtLen :: Int
txtLen = Text -> Int
T.length Text
txt
      tp :: Int
tp = Int
currPos
      emptySel :: Bool
emptySel = Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
currSel
      (Text
part1, Text
part2) = Int -> Text -> (Text, Text)
T.splitAt Int
currPos Text
currText
      currSelVal :: Int
currSelVal = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
currSel
      activeSel :: Bool
activeSel = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel
      minTpSel :: Int
minTpSel = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
tp Int
currSelVal
      maxTpSel :: Int
maxTpSel = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
tp Int
currSelVal
      prevWordStart :: Text
prevWordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
delim Text
part1
      prevWordStartIdx :: Int
prevWordStartIdx = Text -> Int
T.length Text
prevWordStart
      nextWordEnd :: Text
nextWordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
delim Text
part2
      nextWordEndIdx :: Int
nextWordEndIdx = Int
txtLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd
      isShift :: Bool
isShift = KeyMod -> Bool
_kmLeftShift KeyMod
mod
      isLeft :: Bool
isLeft = KeyCode -> Bool
isKeyLeft KeyCode
code
      isRight :: Bool
isRight = KeyCode -> Bool
isKeyRight KeyCode
code
      isHome :: Bool
isHome = KeyCode -> Bool
isKeyHome KeyCode
code
      isEnd :: Bool
isEnd = KeyCode -> Bool
isKeyEnd KeyCode
code
      isWordMod :: Bool
isWordMod
        | WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
      isLineMod :: Bool
isLineMod
        | WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod Bool -> Bool -> Bool
|| KeyMod -> Bool
_kmLeftGUI KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
      isAllMod :: Bool
isAllMod
        | WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftGUI KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
      isBackspace :: Bool
isBackspace = KeyCode -> Bool
isKeyBackspace KeyCode
code Bool -> Bool -> Bool
&& (Int
tp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel)
      isDelBackWord :: Bool
isDelBackWord = Bool
isBackspace Bool -> Bool -> Bool
&& Bool
isWordMod
      isDelBackWordNoSel :: Bool
isDelBackWordNoSel = Bool
isDelBackWord Bool -> Bool -> Bool
&& Bool
emptySel
      isMove :: Bool
isMove = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
      isMoveWord :: Bool
isMoveWord = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
      isMoveLine :: Bool
isMoveLine = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isLineMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod
      isSelect :: Bool
isSelect = Bool
isShift Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
      isSelectWord :: Bool
isSelectWord = Bool
isShift Bool -> Bool -> Bool
&& Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
      isSelectLine :: Bool
isSelectLine = Bool
isShift Bool -> Bool -> Bool
&& Bool
isLineMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod
      isMoveLeft :: Bool
isMoveLeft = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isLeft
      isMoveRight :: Bool
isMoveRight = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isRight
      isMoveWordL :: Bool
isMoveWordL = Bool
isMoveWord Bool -> Bool -> Bool
&& Bool
isLeft
      isMoveWordR :: Bool
isMoveWordR = Bool
isMoveWord Bool -> Bool -> Bool
&& Bool
isRight
      isMoveLineL :: Bool
isMoveLineL = (Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isLeft) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isHome)
      isMoveLineR :: Bool
isMoveLineR = (Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isRight) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isEnd)
      isSelectAll :: Bool
isSelectAll = Bool
isAllMod Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyA KeyCode
code
      isSelectLeft :: Bool
isSelectLeft = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isLeft
      isSelectRight :: Bool
isSelectRight = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isRight
      isSelectWordL :: Bool
isSelectWordL = Bool
isSelectWord Bool -> Bool -> Bool
&& Bool
isLeft
      isSelectWordR :: Bool
isSelectWordR = Bool
isSelectWord Bool -> Bool -> Bool
&& Bool
isRight
      isSelectLineL :: Bool
isSelectLineL = (Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isLeft) Bool -> Bool -> Bool
|| (Bool
isShift Bool -> Bool -> Bool
&& Bool
isHome)
      isSelectLineR :: Bool
isSelectLineR = (Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isRight) Bool -> Bool -> Bool
|| (Bool
isShift Bool -> Bool -> Bool
&& Bool
isEnd)
      isDeselectLeft :: Bool
isDeselectLeft = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isLeft
      isDeselectRight :: Bool
isDeselectRight = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isRight
      removeText :: Text
removeText
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Text -> Text -> Text
replaceText Text
txt Text
""
        | Bool
otherwise = HasCallStack => Text -> Text
Text -> Text
T.init Text
part1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
part2
      removeWord :: Text
removeWord
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Text -> Text -> Text
replaceText Text
txt Text
""
        | Bool
otherwise = Text
prevWordStart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
part2
      moveCursor :: a -> Int -> Maybe Int -> (a, Int, Maybe Int)
moveCursor a
txt Int
newPos Maybe Int
newSel
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
newSel = (a
txt, Int
fixedPos, Maybe Int
forall a. Maybe a
Nothing)
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& Int -> Maybe Int
forall a. a -> Maybe a
Just Int
fixedPos Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
currSel = (a
txt, Int
fixedPos, Maybe Int
forall a. Maybe a
Nothing)
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = (a
txt, Int
fixedPos, Maybe Int
currSel)
        | Int -> Maybe Int
forall a. a -> Maybe a
Just Int
fixedPos Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
fixedSel = (a
txt, Int
fixedPos, Maybe Int
forall a. Maybe a
Nothing)
        | Bool
otherwise = (a
txt, Int
fixedPos, Maybe Int
fixedSel)
        where
          fixedPos :: Int
fixedPos = Int -> Int
fixIdx Int
newPos
          fixedSel :: Maybe Int
fixedSel = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
fixIdx Maybe Int
newSel
      fixIdx :: Int -> Int
fixIdx Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int
0
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
txtLen = Int
txtLen
        | Bool
otherwise = Int
idx

  handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    -- Begin regular text selection
    ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
      | Button -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
        contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
        newPos :: Int
newPos = InputFieldState a -> Point -> Int
forall a. InputFieldState a -> Point -> Int
findClosestGlyphPos InputFieldState a
state Point
point
        newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
forall a. Maybe a
Nothing
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
        newReqs :: [WidgetRequest s e]
newReqs = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId | Bool -> Bool
not (WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node) ]
        result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
newReqs

    -- Begin custom drag
    ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
      | Button -> Bool
dragHandleExt Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode) where
        newState :: InputFieldState a
newState = InputFieldState a
state { _ifsDragSelValue = currVal }
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState

    -- Select one word if clicked twice in a row
    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Button -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        (Text
part1, Text
part2) = Int -> Text -> (Text, Text)
T.splitAt Int
currPos Text
currText
        txtLen :: Int
txtLen = Text -> Int
T.length Text
currText
        wordStart :: Text
wordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part1
        wordStartIdx :: Int
wordStartIdx = Text -> Int
T.length Text
wordStart
        wordEnd :: Text
wordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part2
        wordEndIdx :: Int
wordEndIdx = Int
txtLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
wordEnd
        newPos :: Int
newPos = Int
wordStartIdx
        newSel :: Maybe Int
newSel = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
wordEndIdx
        newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
newSel
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
        result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]

    -- Select all if clicked three times in a row
    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Button -> Bool
dragSelectText Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        newPos :: Int
newPos = Int
0
        newSel :: Maybe Int
newSel = Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int
T.length Text
currText)
        newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
newSel
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
        result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]

    -- If a custom drag handler is used, generate onChange events and history
    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Button -> Bool
dragHandleExt Button
btn Bool -> Bool -> Bool
&& Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
        result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
True Text
currText Int
currPos Maybe Int
currSel [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs

    -- Handle regular text selection
    Move Point
point
      | WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shiftPressed -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
        contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
        newPos :: Int
newPos = InputFieldState a -> Point -> Int
forall a. InputFieldState a -> Point -> Int
findClosestGlyphPos InputFieldState a
state Point
point
        newSel :: Maybe Int
newSel = Maybe Int
currSel Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
currPos
        newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
newPos Maybe Int
newSel
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
        result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce WidgetRequest s e -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. a -> [a] -> [a]
: CursorIcon -> [WidgetRequest s e]
forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor)

    -- Handle custom drag
    Move Point
point
      | WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool
isShiftDrag -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        isShiftDrag :: Bool
isShiftDrag = Bool
shiftPressed Bool -> Bool -> Bool
&& Maybe (InputDragHandler a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (InputDragHandler a)
dragHandler
        (Path
_, Point
stPoint) = Maybe (Path, Point) -> (Path, Point)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Path, Point) -> (Path, Point))
-> Maybe (Path, Point) -> (Path, Point)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
-> Maybe (Path, Point)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
forall s a. HasMainBtnPress s a => Lens' s a
Lens' (WidgetEnv s e) (Maybe (Path, Point))
L.mainBtnPress
        handlerRes :: (Text, Int, Maybe Int)
handlerRes = Maybe (InputDragHandler a) -> InputDragHandler a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (InputDragHandler a)
dragHandler InputFieldState a
state Point
stPoint Point
point
        (Text
newText, Int
newPos, Maybe Int
newSel) = (Text, Int, Maybe Int)
handlerRes
        reqs :: [WidgetRequest s e]
reqs = WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce WidgetRequest s e -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. a -> [a] -> [a]
: CursorIcon -> [WidgetRequest s e]
forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
        result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
True Text
newText Int
newPos Maybe Int
newSel [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs

    -- Sets the correct cursor icon
    Move Point
point -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs) where
      reqs :: [WidgetRequest s e]
reqs = CursorIcon -> [WidgetRequest s e]
forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor

    -- Handle wheel
    WheelScroll Point
point Point
move WheelDirection
dir
      | Maybe (InputWheelHandler a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (InputWheelHandler a)
wheelHandler -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        handlerRes :: (Text, Int, Maybe Int)
handlerRes = Maybe (InputWheelHandler a) -> InputWheelHandler a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (InputWheelHandler a)
wheelHandler InputFieldState a
state Point
point Point
move WheelDirection
dir
        (Text
newText, Int
newPos, Maybe Int
newSel) = (Text, Int, Maybe Int)
handlerRes
        reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce, WidgetRequest s e
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 [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs

    -- Handle keyboard shortcuts and possible cursor changes
    KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
      | WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCopy WidgetEnv s e
wenv SystemEvent
evt
          -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [ClipboardData -> WidgetRequest s e
forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText)]
      | WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardPaste WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable
          -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
GetClipboard WidgetId
widgetId]
      | WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCut WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
cutTextRes WidgetEnv s e
wenv WidgetNode s e
node
      | WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardUndo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
moveHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config (-Int
1)
      | WidgetEnv s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardRedo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> Int
-> Maybe (WidgetResult s e)
moveHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config Int
1
      | Bool
otherwise -> ((Text, Int, Maybe Int) -> WidgetResult s e)
-> Maybe (Text, Int, Maybe Int) -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Int, Maybe Int) -> WidgetResult s e
handleKeyRes Maybe (Text, Int, Maybe Int)
keyRes Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e) -> Maybe (WidgetResult s e)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (WidgetResult s e)
cursorRes where
          !keyRes :: Maybe (Text, Int, Maybe Int)
keyRes = WidgetEnv s e -> KeyMod -> KeyCode -> Maybe (Text, Int, Maybe Int)
forall {s} {e}.
WidgetEnv s e -> KeyMod -> KeyCode -> Maybe (Text, Int, Maybe Int)
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code
          handleKeyRes :: (Text, Int, Maybe Int) -> WidgetResult s e
handleKeyRes (!Text
newText, !Int
newPos, !Maybe Int
newSel) = WidgetResult s e
result where
            result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
False Text
newText Int
newPos Maybe Int
newSel []
          cursorReq :: [WidgetRequest s e]
cursorReq = CursorIcon -> [WidgetRequest s e]
forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
          cursorRes :: Maybe (WidgetResult s e)
cursorRes
            | Bool -> Bool
not ([WidgetRequest Any Any] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest Any Any]
forall {s} {e}. [WidgetRequest s e]
cursorReq) = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
cursorReq)
            | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    -- Handle possible cursor reset
    KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyReleased
      | (Bool
pressed Bool -> Bool -> Bool
|| Bool
hovered) Bool -> Bool -> Bool
&& Bool -> Bool
not ([WidgetRequest Any Any] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest Any Any]
forall {s} {e}. [WidgetRequest s e]
reqs) -> Maybe (WidgetResult s e)
result where
        pressed :: Bool
pressed = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node
        hovered :: Bool
hovered = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node
        reqs :: [WidgetRequest s e]
reqs = CursorIcon -> [WidgetRequest s e]
forall {s} {e}. CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
validCursor
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs)

    -- 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 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
      tmpState :: InputFieldState a
tmpState
        | InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus InputFieldCfg s e a
config Bool -> Bool -> Bool
&& Text -> Int
T.length Text
currText Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = InputFieldState a
state {
            _ifsSelStart = Just 0,
            _ifsCursorPos = T.length currText
          }
        | Bool
otherwise = InputFieldState a
state
      newState :: InputFieldState a
newState = InputFieldState a
tmpState {
        _ifsFocusStart = wenv ^. L.timestamp
      }
      reqs :: [WidgetRequest s e]
reqs = [WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
caretMs Maybe Int
forall a. Maybe a
Nothing, Rect -> WidgetRequest s e
forall s e. Rect -> WidgetRequest s e
StartTextInput Rect
viewport]
      newNode :: WidgetNode s e
newNode = WidgetNode s e
node
        WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
      newResult :: WidgetResult s e
newResult = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs
      focusRs :: Maybe (WidgetResult s e)
focusRs = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
newNode Path
prev (InputFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnFocusReq InputFieldCfg s e a
config)
      result :: WidgetResult s e
result = WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e)
-> Maybe (WidgetResult s e)
-> WidgetResult s e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult WidgetResult s e -> WidgetResult s e -> WidgetResult s e
forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
focusRs

    -- Handle blur and disable custom drag handlers
    Blur Path
next -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
      reqs :: [WidgetRequest s e]
reqs = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId, WidgetRequest s e
forall s e. WidgetRequest s e
StopTextInput]
      newResult :: WidgetResult s e
newResult = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs
      blurResult :: Maybe (WidgetResult s e)
blurResult = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (InputFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> [Path -> WidgetRequest s e]
_ifcOnBlurReq InputFieldCfg s e a
config)
      result :: WidgetResult s e
result = WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e)
-> Maybe (WidgetResult s e)
-> WidgetResult s e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult WidgetResult s e -> WidgetResult s e -> WidgetResult s e
forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
blurResult

    SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
      viewport :: Rect
viewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport
      newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config
      shiftPressed :: Bool
shiftPressed = WidgetEnv s e
wenv WidgetEnv s e -> Getting Bool (WidgetEnv s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
Lens' (WidgetEnv s e) InputStatus
L.inputStatus ((InputStatus -> Const Bool InputStatus)
 -> WidgetEnv s e -> Const Bool (WidgetEnv s e))
-> ((Bool -> Const Bool Bool)
    -> InputStatus -> Const Bool InputStatus)
-> Getting Bool (WidgetEnv s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus
forall s a. HasKeyMod s a => Lens' s a
Lens' InputStatus KeyMod
L.keyMod ((KeyMod -> Const Bool KeyMod)
 -> InputStatus -> Const Bool InputStatus)
-> ((Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod)
-> (Bool -> Const Bool Bool)
-> InputStatus
-> Const Bool InputStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod
forall s a. HasLeftShift s a => Lens' s a
Lens' KeyMod Bool
L.leftShift
      dragSelectText :: Button -> Bool
dragSelectText Button
btn
        = WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
Lens' (WidgetEnv s e) Button
L.mainButton Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
btn
        Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shiftPressed
      dragHandleExt :: Button -> Bool
dragHandleExt Button
btn
        = WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
Lens' (WidgetEnv s e) Button
L.mainButton Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
btn
        Bool -> Bool -> Bool
&& Bool
shiftPressed
        Bool -> Bool -> Bool
&& Maybe (InputDragHandler a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (InputDragHandler a)
dragHandler
      validCursor :: CursorIcon
validCursor
        | Bool -> Bool
not Bool
shiftPressed Bool -> Bool -> Bool
|| Maybe (InputDragHandler a) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (InputDragHandler a)
dragHandler = CursorIcon
CursorIBeam
        | Bool
otherwise = CursorIcon -> Maybe CursorIcon -> CursorIcon
forall a. a -> Maybe a -> a
fromMaybe CursorIcon
CursorArrow Maybe CursorIcon
dragCursor
      changeCursorReq :: CursorIcon -> [WidgetRequest s e]
changeCursorReq CursorIcon
newCursor = [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs where
        cursorMatch :: Bool
cursorMatch = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (First CursorIcon) (WidgetEnv s e) CursorIcon
-> Maybe CursorIcon
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe (Path, CursorIcon)
 -> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
-> WidgetEnv s e -> Const (First CursorIcon) (WidgetEnv s e)
forall s a. HasCursor s a => Lens' s a
Lens' (WidgetEnv s e) (Maybe (Path, CursorIcon))
L.cursor ((Maybe (Path, CursorIcon)
  -> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
 -> WidgetEnv s e -> Const (First CursorIcon) (WidgetEnv s e))
-> ((CursorIcon -> Const (First CursorIcon) CursorIcon)
    -> Maybe (Path, CursorIcon)
    -> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
-> Getting (First CursorIcon) (WidgetEnv s e) CursorIcon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path, CursorIcon) -> Const (First CursorIcon) (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Path, CursorIcon)
  -> Const (First CursorIcon) (Path, CursorIcon))
 -> Maybe (Path, CursorIcon)
 -> Const (First CursorIcon) (Maybe (Path, CursorIcon)))
-> ((CursorIcon -> Const (First CursorIcon) CursorIcon)
    -> (Path, CursorIcon)
    -> Const (First CursorIcon) (Path, CursorIcon))
-> (CursorIcon -> Const (First CursorIcon) CursorIcon)
-> Maybe (Path, CursorIcon)
-> Const (First CursorIcon) (Maybe (Path, CursorIcon))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CursorIcon -> Const (First CursorIcon) CursorIcon)
-> (Path, CursorIcon)
-> Const (First CursorIcon) (Path, CursorIcon)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Path, CursorIcon) (Path, CursorIcon) CursorIcon CursorIcon
_2 Maybe CursorIcon -> Maybe CursorIcon -> Bool
forall a. Eq a => a -> a -> Bool
== CursorIcon -> Maybe CursorIcon
forall a. a -> Maybe a
Just CursorIcon
newCursor
        reqs :: [WidgetRequest s e]
reqs
          | Bool -> Bool
not Bool
cursorMatch = [WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
newCursor]
          | Bool
otherwise = []

  insertTextRes :: WidgetEnv s e -> WidgetNode s e -> Text -> Maybe (WidgetResult s e)
insertTextRes WidgetEnv s e
wenv WidgetNode s e
node Text
addedText = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
    addedLen :: Int
addedLen = Text -> Int
T.length Text
addedText
    newText :: Text
newText = Text -> Text -> Text
replaceText Text
currText Text
addedText
    newPos :: Int
newPos
      | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int
addedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
      | Bool
otherwise = Int
addedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
currPos
    result :: WidgetResult s e
result = WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
True Text
newText Int
newPos Maybe Int
forall a. Maybe a
Nothing []

  cutTextRes :: WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
cutTextRes WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
    tmpResult :: WidgetResult s e
tmpResult = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) (WidgetEnv s e -> WidgetNode s e -> Text -> Maybe (WidgetResult s e)
insertTextRes WidgetEnv s e
wenv WidgetNode s e
node Text
"")
    result :: WidgetResult s e
result = WidgetResult s e
tmpResult
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> ClipboardData -> WidgetRequest s e
forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText))

  replaceText :: Text -> Text -> Text
replaceText Text
txt Text
newTxt
    | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int -> Text -> Text
T.take Int
start Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
end Text
txt
    | Bool
otherwise = Int -> Text -> Text
T.take Int
currPos Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
currPos Text
txt
    where
      start :: Int
start = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
      end :: Int
end = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)

  selectedText :: Text
selectedText
    | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel = Int -> Text -> Text
T.take (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
start Text
currText
    | Bool
otherwise = Text
""
    where
      start :: Int
start = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)
      end :: Int
end = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
currPos (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
currSel)

  genInputResult :: WidgetEnv s e
-> WidgetNode s e
-> Bool
-> Text
-> Int
-> Maybe Int
-> [WidgetRequest s e]
-> WidgetResult s e
genInputResult WidgetEnv s e
wenv WidgetNode s e
node Bool
textAdd Text
newText Int
newPos Maybe Int
newSel [WidgetRequest s e]
newReqs = WidgetResult s e
result where
    acceptInput :: Bool
acceptInput = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput InputFieldCfg s e a
config Text
newText
    isValid :: Bool
isValid = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcIsValidInput InputFieldCfg s e a
config Text
newText
    newVal :: Maybe a
newVal = Text -> Maybe a
fromText Text
newText
    stVal :: a
stVal
      | Bool
isValid = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
currVal Maybe a
newVal
      | Bool
otherwise = a
currVal
    tempState :: InputFieldState a
tempState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config a
stVal Text
newText Int
newPos Maybe Int
newSel
    newOffset :: Double
newOffset = InputFieldState a -> Double
forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
tempState
    history :: Seq (HistoryStep a)
history = InputFieldState a -> Seq (HistoryStep a)
forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
tempState
    histIdx :: Int
histIdx = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
tempState
    !newStep :: HistoryStep a
newStep = a -> Text -> Int -> Maybe Int -> Double -> HistoryStep a
forall a. a -> Text -> Int -> Maybe Int -> Double -> HistoryStep a
HistoryStep a
stVal Text
newText Int
newPos Maybe Int
newSel Double
newOffset
    !newState :: InputFieldState a
newState
      | Text
currText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newText = InputFieldState a
tempState
      | Seq (HistoryStep a) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (HistoryStep a)
history Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
histIdx = InputFieldState a
tempState {
          _ifsHistory = history |> newStep,
          _ifsHistIdx = histIdx + 1
        }
      | Bool
otherwise = InputFieldState a
tempState {
          _ifsHistory = Seq.take (histIdx - 1) history |> newStep,
          _ifsHistIdx = histIdx
        }
    !newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState
    ([WidgetRequest s e]
reqs, [e]
events) = WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
forall a s e.
Eq a =>
WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
genReqsEvents WidgetNode s e
node InputFieldCfg s e a
config InputFieldState a
state Text
newText [WidgetRequest s e]
newReqs
    !result :: WidgetResult s e
result
      | Bool
acceptInput Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
textAdd = WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
forall e s.
Typeable e =>
WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
newNode [WidgetRequest s e]
reqs [e]
events
      | Bool
otherwise = WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
forall e s.
Typeable e =>
WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
node [WidgetRequest s e]
reqs [e]
events

  getSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node = (SizeReq, SizeReq)
sizeReq where
    defWidth :: Double
defWidth = InputFieldCfg s e a -> Double
forall s e a. InputFieldCfg s e a -> Double
_ifcDefWidth InputFieldCfg s e a
config
    resizeOnChange :: Bool
resizeOnChange = InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange InputFieldCfg s e a
config
    currText :: Text
currText
      | InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
      | Bool
otherwise = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (InputFieldCfg s e a -> Maybe Text
forall s e a. InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder InputFieldCfg s e a
config)
    style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    Size Double
w Double
h = WidgetEnv s e -> StyleState -> Text -> Size
forall s e. WidgetEnv s e -> StyleState -> Text -> Size
getTextSize WidgetEnv s e
wenv StyleState
style Text
currText
    targetW :: Double
targetW
      | Bool
resizeOnChange = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
w Double
100
      | Bool
otherwise = Double
defWidth
    factor :: Double
factor = Double
1
    sizeReq :: (SizeReq, SizeReq)
sizeReq = (Double -> Double -> SizeReq
expandSize Double
targetW Double
factor, Double -> SizeReq
fixedSize Double
h)

  resize :: WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetResult s e
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    -- newTextState depends on having correct viewport in the node
    tempNode :: WidgetNode s e
tempNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Rect -> Identity Rect)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Rect -> Identity Rect)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Identity Rect)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport ((Rect -> Identity Rect)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Rect -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
viewport
    newFieldState :: a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
tempNode InputFieldState a
state InputFieldCfg s e a
config
    newState :: InputFieldState a
newState = a -> Text -> Int -> Maybe Int -> InputFieldState a
newFieldState a
currVal Text
currText Int
currPos Maybe Int
currSel
    newNode :: WidgetNode s e
newNode = WidgetNode s e
tempNode
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
currSel Bool -> Bool -> Bool
&& (Bool
focused Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
selectOnFocus)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
selRect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
selColor) Maybe Radius
forall a. Maybe a
Nothing

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
currText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" Bool -> Bool -> Bool
&& Bool -> Bool
not (Seq TextLine -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq TextLine
currPlaceholder)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer (Double -> Double -> Point
Point Double
cx Double
cy) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Seq TextLine -> (TextLine -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq TextLine
currPlaceholder (Renderer -> StyleState -> TextLine -> IO ()
drawTextLine Renderer
renderer StyleState
placeholderStyle)

    Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
forall a.
Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
renderContent Renderer
renderer InputFieldState a
state StyleState
style (InputFieldCfg s e a -> Text -> Text
forall s e a. InputFieldCfg s e a -> Text -> Text
getDisplayText InputFieldCfg s e a
config Text
currText)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
caretRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
caretRect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
caretColor) Maybe Radius
forall a. Maybe a
Nothing
    where
      style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      placeholderStyle :: StyleState
placeholderStyle = StyleState
style
        StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState
forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text ((Maybe TextStyle -> Identity (Maybe TextStyle))
 -> StyleState -> Identity StyleState)
-> ((Maybe Color -> Identity (Maybe Color))
    -> Maybe TextStyle -> Identity (Maybe TextStyle))
-> (Maybe Color -> Identity (Maybe Color))
-> StyleState
-> Identity StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Identity TextStyle)
 -> Maybe TextStyle -> Identity (Maybe TextStyle))
-> ((Maybe Color -> Identity (Maybe Color))
    -> TextStyle -> Identity TextStyle)
-> (Maybe Color -> Identity (Maybe Color))
-> Maybe TextStyle
-> Identity (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Color -> Identity (Maybe Color))
-> TextStyle -> Identity TextStyle
forall s a. HasFontColor s a => Lens' s a
Lens' TextStyle (Maybe Color)
L.fontColor ((Maybe Color -> Identity (Maybe Color))
 -> StyleState -> Identity StyleState)
-> Maybe Color -> StyleState -> StyleState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StyleState
style StyleState
-> Getting (Maybe Color) StyleState (Maybe Color) -> Maybe Color
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Color) StyleState (Maybe Color)
forall s a. HasSndColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.sndColor
      carea :: Rect
carea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      Rect Double
cx Double
cy Double
_ Double
_ = Rect
carea
      selectOnFocus :: Bool
selectOnFocus = InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcSelectOnFocus InputFieldCfg s e a
config
      focused :: Bool
focused = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
      ts :: Millisecond
ts = WidgetEnv s e -> Millisecond
forall s e. WidgetEnv s e -> Millisecond
_weTimestamp WidgetEnv s e
wenv

      caretTs :: Millisecond
caretTs = Millisecond
ts Millisecond -> Millisecond -> Millisecond
forall a. Num a => a -> a -> a
- InputFieldState a -> Millisecond
forall a. InputFieldState a -> Millisecond
_ifsFocusStart InputFieldState a
state
      caretRequired :: Bool
caretRequired = Bool
focused Bool -> Bool -> Bool
&& Millisecond -> Bool
forall a. Integral a => a -> Bool
even (Millisecond
caretTs Millisecond -> Millisecond -> Millisecond
forall a. Integral a => a -> a -> a
`div` Millisecond
caretMs)
      caretColor :: Color
caretColor = StyleState -> Color
styleFontColor StyleState
style
      caretRect :: Rect
caretRect = InputFieldCfg s e a
-> InputFieldState a -> StyleState -> Rect -> Rect
forall s e a.
InputFieldCfg s e a
-> InputFieldState a -> StyleState -> Rect -> Rect
getCaretRect InputFieldCfg s e a
config InputFieldState a
state StyleState
style Rect
carea

      selColor :: Color
selColor = StyleState -> Color
styleHlColor StyleState
style
      selRect :: Rect
selRect = InputFieldState a -> StyleState -> Rect
forall a. InputFieldState a -> StyleState -> Rect
getSelRect InputFieldState a
state StyleState
style

textOffsetY :: TextMetrics -> StyleState -> Double
textOffsetY :: TextMetrics -> StyleState -> Double
textOffsetY (TextMetrics Double
ta Double
td Double
tl Double
tlx) StyleState
style = Double
offset where
  offset :: Double
offset = case StyleState -> AlignTV
styleTextAlignV StyleState
style of
    AlignTV
ATBaseline -> -Double
td
    AlignTV
_ -> Double
0

renderContent :: Renderer -> InputFieldState a -> StyleState -> Text -> IO ()
renderContent :: 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 = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
    textMetrics :: TextMetrics
textMetrics = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
    textPos :: Point
textPos = Double -> Double -> Point
Point Double
tx (Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
th Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
textOffsetY TextMetrics
textMetrics StyleState
style)
    textStyle :: TextStyle
textStyle = TextStyle -> Maybe TextStyle -> TextStyle
forall a. a -> Maybe a -> a
fromMaybe TextStyle
forall a. Default a => a
def (StyleState -> Maybe TextStyle
_sstText StyleState
style)
    tsFont :: Font
tsFont = StyleState -> Font
styleFont StyleState
style
    tsFontSize :: FontSize
tsFontSize = StyleState -> FontSize
styleFontSize StyleState
style
    tsFontSpcH :: FontSpace
tsFontSpcH = StyleState -> FontSpace
styleFontSpaceH StyleState
style
    tsFontColor :: Color
tsFontColor = StyleState -> Color
styleFontColor StyleState
style

getCaretH :: InputFieldState a -> Double
getCaretH :: forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state = Double
lineh where
  TextMetrics Double
asc Double
desc Double
lineh Double
_ = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state

getCaretOffset :: TextMetrics -> StyleState -> Double
getCaretOffset :: TextMetrics -> StyleState -> Double
getCaretOffset TextMetrics
metrics StyleState
style = Double
textOffset Double -> Double -> Double
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 = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
  caretW :: Double
caretW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (InputFieldCfg s e a -> Maybe Double
forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
  textMetrics :: TextMetrics
textMetrics = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
  glyphs :: Seq GlyphPos
glyphs = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
  pos :: Int
pos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
  caretPos :: Double
caretPos
    | Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Seq GlyphPos -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq GlyphPos
glyphs = Double
0
    | Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq GlyphPos -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = GlyphPos -> Double
_glpXMax (Seq GlyphPos -> GlyphPos
forall a. Seq a -> a
seqLast Seq GlyphPos
glyphs)
    | Bool
otherwise = GlyphPos -> Double
_glpXMin (Seq GlyphPos -> Int -> GlyphPos
forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs Int
pos)
  caretX :: Double -> Double
caretX Double
tx = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
caretW) (Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
caretPos)
  caretY :: Double
caretY = Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
getCaretOffset TextMetrics
textMetrics StyleState
style
  caretRect :: Rect
caretRect = Double -> Double -> Double -> Double -> Rect
Rect (Double -> Double
caretX Double
tx) Double
caretY Double
caretW (InputFieldState a -> Double
forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state)

getSelRect :: InputFieldState a -> StyleState -> Rect
getSelRect :: forall a. InputFieldState a -> StyleState -> Rect
getSelRect InputFieldState a
state StyleState
style = Rect
selRect where
  Rect Double
tx Double
ty Double
tw Double
th = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
  textMetrics :: TextMetrics
textMetrics = InputFieldState a -> TextMetrics
forall a. InputFieldState a -> TextMetrics
_ifsTextMetrics InputFieldState a
state
  glyphs :: Seq GlyphPos
glyphs = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state
  pos :: Int
pos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
  sel :: Maybe Int
sel = InputFieldState a -> Maybe Int
forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
state
  caretY :: Double
caretY = Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextMetrics -> StyleState -> Double
getCaretOffset TextMetrics
textMetrics StyleState
style
  caretH :: Double
caretH = InputFieldState a -> Double
forall a. InputFieldState a -> Double
getCaretH InputFieldState a
state
  glyph :: Int -> GlyphPos
glyph Int
idx = Seq GlyphPos -> Int -> GlyphPos
forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
idx (Seq GlyphPos -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  gx :: Int -> Double
gx Int
idx = GlyphPos -> Double
_glpXMin (Int -> GlyphPos
glyph Int
idx)
  gw :: Int -> Int -> Double
gw Int
start Int
end = Double -> Double
forall a. Num a => a -> a
abs (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ GlyphPos -> Double
_glpXMax (Int -> GlyphPos
glyph Int
end) Double -> Double -> Double
forall a. Num a => a -> a -> a
- GlyphPos -> Double
_glpXMin (Int -> GlyphPos
glyph Int
start)
  mkSelRect :: Int -> Rect
mkSelRect Int
end
    | Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end = Double -> Double -> Double -> Double -> Rect
Rect (Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
gx Int
end) Double
caretY (Int -> Int -> Double
gw Int
end (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Double
caretH
    | Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect (Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
gx Int
pos) Double
caretY (Int -> Int -> Double
gw Int
pos (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Double
caretH
  selRect :: Rect
selRect = Rect -> (Int -> Rect) -> Maybe Int -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect
forall a. Default a => a
def Int -> Rect
mkSelRect Maybe Int
sel

findClosestGlyphPos :: InputFieldState a -> Point -> Int
findClosestGlyphPos :: 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 = InputFieldState a -> Rect
forall a. InputFieldState a -> Rect
_ifsTextRect InputFieldState a
state
  localX :: Double
localX = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Rect -> Double
_rX Rect
textRect
  textLen :: Double
textLen = Seq GlyphPos -> Double
getGlyphsMax (InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state)
  glyphs :: Seq GlyphPos
glyphs
    | Seq GlyphPos -> Bool
forall a. Seq a -> Bool
Seq.null (InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state) = Seq GlyphPos
forall a. Seq a
Seq.empty
    | Bool
otherwise = InputFieldState a -> Seq GlyphPos
forall a. InputFieldState a -> Seq GlyphPos
_ifsGlyphs InputFieldState a
state Seq GlyphPos -> GlyphPos -> Seq GlyphPos
forall a. Seq a -> a -> Seq a
|> Char
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> 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, Double -> Double
forall a. Num a => a -> a
abs (GlyphPos -> Double
_glpXMin GlyphPos
g Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
localX))
  pairs :: Seq (Int, Double)
pairs = (Int -> GlyphPos -> (Int, Double))
-> Seq GlyphPos -> Seq (Int, Double)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> GlyphPos -> (Int, Double)
forall {a}. a -> GlyphPos -> (a, Double)
glyphStart Seq GlyphPos
glyphs
  cpm :: (a, a) -> (a, a) -> Ordering
cpm (a
_, a
g1) (a
_, a
g2) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
g1 a
g2
  diffs :: Seq (Int, Double)
diffs = ((Int, Double) -> (Int, Double) -> Ordering)
-> Seq (Int, Double) -> Seq (Int, Double)
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (Int, Double) -> (Int, Double) -> Ordering
forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cpm Seq (Int, Double)
pairs
  newPos :: Int
newPos = Int -> ((Int, Double) -> Int) -> Maybe (Int, Double) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Double) -> Int
forall a b. (a, b) -> a
fst (Int -> Seq (Int, Double) -> Maybe (Int, Double)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq (Int, Double)
diffs)

genReqsEvents
  :: (Eq a)
  => WidgetNode s e
  -> InputFieldCfg s e a
  -> InputFieldState a
  -> Text
  -> [WidgetRequest s e]
  -> ([WidgetRequest s e], [e])
genReqsEvents :: 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 WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
  resizeOnChange :: Bool
resizeOnChange = InputFieldCfg s e a -> Bool
forall s e a. InputFieldCfg s e a -> Bool
_ifcResizeOnChange InputFieldCfg s e a
config
  fromText :: Text -> Maybe a
fromText = InputFieldCfg s e a -> Text -> Maybe a
forall s e a. InputFieldCfg s e a -> Text -> Maybe a
_ifcFromText InputFieldCfg s e a
config
  setModelValue :: a -> [WidgetRequest s e]
setModelValue = WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (InputFieldCfg s e a -> WidgetData s a
forall s e a. InputFieldCfg s e a -> WidgetData s a
_ifcValue InputFieldCfg s e a
config)
  currVal :: a
currVal = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
  currText :: Text
currText = InputFieldState a -> Text
forall a. InputFieldState a -> Text
_ifsCurrText InputFieldState a
state
  accepted :: Bool
accepted = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcAcceptInput InputFieldCfg s e a
config Text
newText
  isValid :: Bool
isValid = InputFieldCfg s e a -> Text -> Bool
forall s e a. InputFieldCfg s e a -> Text -> Bool
_ifcIsValidInput InputFieldCfg s e a
config Text
newText
  newVal :: Maybe a
newVal = Text -> Maybe a
fromText Text
newText
  stateVal :: a
stateVal = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
currVal Maybe a
newVal
  txtChanged :: Bool
txtChanged = Text
newText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
currText
  valChanged :: Bool
valChanged = a
stateVal a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
currVal
  !evtValid :: [e]
evtValid
    | Bool
txtChanged = ((Bool -> e) -> e) -> [Bool -> e] -> [e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> e) -> Bool -> e
forall a b. (a -> b) -> a -> b
$ Bool
isValid) (InputFieldCfg s e a -> [Bool -> e]
forall s e a. InputFieldCfg s e a -> [Bool -> e]
_ifcValidV InputFieldCfg s e a
config)
    | Bool
otherwise = []
  reqValid :: [WidgetRequest s e]
reqValid = InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> Bool -> [WidgetRequest s e]
setModelValid InputFieldCfg s e a
config Bool
isValid
  reqUpdateModel :: [WidgetRequest s e]
reqUpdateModel
    | Bool
accepted Bool -> Bool -> Bool
&& Bool
valChanged = a -> [WidgetRequest s e]
forall {e}. a -> [WidgetRequest s e]
setModelValue a
stateVal
    | Bool
otherwise = []
  reqResize :: [WidgetRequest s e]
reqResize
    | Bool
resizeOnChange Bool -> Bool -> Bool
&& Bool
valChanged = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId]
    | Bool
otherwise = []
  reqOnChange :: [WidgetRequest s e]
reqOnChange
    | Bool
accepted Bool -> Bool -> Bool
&& Bool
valChanged = ((a -> WidgetRequest s e) -> WidgetRequest s e)
-> [a -> WidgetRequest s e] -> [WidgetRequest s e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> WidgetRequest s e) -> a -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ a
stateVal) (InputFieldCfg s e a -> [a -> WidgetRequest s e]
forall s e a. InputFieldCfg s e a -> [a -> WidgetRequest s e]
_ifcOnChangeReq InputFieldCfg s e a
config)
    | Bool
otherwise = []
  !reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
newReqs [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall {e}. [WidgetRequest s e]
reqUpdateModel [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqValid [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqResize [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange
  !result :: ([WidgetRequest s e], [e])
result = ([WidgetRequest s e]
reqs, [e]
evtValid)

moveHistory
  :: (InputFieldValue a, WidgetEvent e)
  => WidgetEnv s e
  -> WidgetNode s e
  -> InputFieldState a
  -> InputFieldCfg s e a
  -> Int
  -> Maybe (WidgetResult s e)
moveHistory :: 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 = a -> HistoryStep a
forall a. a -> HistoryStep a
initialHistoryStep (InputFieldCfg s e a -> a
forall s e a. InputFieldCfg s e a -> a
_ifcInitialValue InputFieldCfg s e a
config)
  currHistory :: Seq (HistoryStep a)
currHistory = InputFieldState a -> Seq (HistoryStep a)
forall a. InputFieldState a -> Seq (HistoryStep a)
_ifsHistory InputFieldState a
state
  currHistIdx :: Int
currHistIdx = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsHistIdx InputFieldState a
state
  lenHistory :: Int
lenHistory = Seq (HistoryStep a) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (HistoryStep a)
currHistory
  reqHistIdx :: Int
reqHistIdx
    | Int
steps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 Bool -> Bool -> Bool
&& Int
currHistIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenHistory = Int
currHistIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
    | Bool
otherwise = Int
currHistIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
steps
  histStep :: Maybe (HistoryStep a)
histStep = Int -> Seq (HistoryStep a) -> Maybe (HistoryStep a)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
reqHistIdx Seq (HistoryStep a)
currHistory
  result :: Maybe (WidgetResult s e)
result
    | Seq (HistoryStep a) -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (HistoryStep a)
currHistory Bool -> Bool -> Bool
|| Int
reqHistIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (HistoryStep a -> WidgetResult s e
createResult HistoryStep a
historyStep)
    | Bool
otherwise = (HistoryStep a -> WidgetResult s e)
-> Maybe (HistoryStep a) -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HistoryStep a -> WidgetResult s e
createResult Maybe (HistoryStep a)
histStep
  createResult :: HistoryStep a -> WidgetResult s e
createResult HistoryStep a
histStep = WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
forall e s.
Typeable e =>
WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
newNode [WidgetRequest s e]
reqs [e]
evts where
    ([WidgetRequest s e]
reqs, [e]
evts) = WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
forall a s e.
Eq a =>
WidgetNode s e
-> InputFieldCfg s e a
-> InputFieldState a
-> Text
-> [WidgetRequest s e]
-> ([WidgetRequest s e], [e])
genReqsEvents WidgetNode s e
node InputFieldCfg s e a
config InputFieldState a
state (HistoryStep a -> Text
forall a. HistoryStep a -> Text
_ihsText HistoryStep a
histStep) []
    tempState :: InputFieldState a
tempState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> HistoryStep a
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> HistoryStep a
-> InputFieldState a
newStateFromHistory WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
state InputFieldCfg s e a
config HistoryStep a
histStep
    newState :: InputFieldState a
newState = InputFieldState a
tempState {
      _ifsHistIdx = clamp 0 lenHistory reqHistIdx
    }
    !newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputFieldCfg s e a -> InputFieldState a -> Widget s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
InputFieldCfg s e a -> InputFieldState a -> Widget s e
makeInputField InputFieldCfg s e a
config InputFieldState a
newState

newStateFromHistory
  :: WidgetEnv s e
  -> WidgetNode s e
  -> InputFieldState a
  -> InputFieldCfg s e a
  -> HistoryStep a
  -> InputFieldState a
newStateFromHistory :: 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 = hOffset }
  newState :: InputFieldState a
newState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> a
-> Text
-> Int
-> Maybe Int
-> InputFieldState a
newTextState WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config a
hValue Text
hText Int
hPos Maybe Int
hSel

newTextState
  :: WidgetEnv s e
  -> WidgetNode s e
  -> InputFieldState a
  -> InputFieldCfg s e a
  -> a
  -> Text
  -> Int
  -> Maybe Int
  -> InputFieldState a
newTextState :: 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 = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
  caretW :: Double
caretW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (InputFieldCfg s e a -> Maybe Double
forall s e a. InputFieldCfg s e a -> Maybe Double
_ifcCaretWidth InputFieldCfg s e a
config)
  Rect Double
cx Double
cy Double
cw Double
ch = Rect
contentArea
  alignH :: AlignTH
alignH = StyleState -> AlignTH
inputFieldAlignH StyleState
style
  alignV :: AlignTV
alignV = StyleState -> AlignTV
inputFieldAlignV StyleState
style
  alignL :: Bool
alignL = AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATLeft
  alignR :: Bool
alignR = AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATRight
  alignC :: Bool
alignC = AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATCenter
  cursorL :: Bool
cursorL = Int
cursor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  cursorR :: Bool
cursorR = Int
cursor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
T.length Text
text
  !textMetrics :: TextMetrics
textMetrics = WidgetEnv s e -> StyleState -> TextMetrics
forall s e. WidgetEnv s e -> StyleState -> TextMetrics
getTextMetrics WidgetEnv s e
wenv StyleState
style
  !textRect :: Rect
textRect = WidgetEnv s e
-> StyleState -> Rect -> AlignTH -> AlignTV -> Text -> Rect
forall s e.
WidgetEnv s e
-> StyleState -> Rect -> AlignTH -> AlignTV -> Text -> Rect
getSingleTextLineRect WidgetEnv s e
wenv StyleState
style Rect
contentArea AlignTH
alignH AlignTV
alignV Text
text
  Rect Double
tx Double
ty Double
tw Double
th = Rect
textRect
  textFits :: Bool
textFits = Double
cw Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
tw
  glyphs :: Seq GlyphPos
glyphs = WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
forall s e. WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
getTextGlyphs WidgetEnv s e
wenv StyleState
style (InputFieldCfg s e a -> Text -> Text
forall s e a. InputFieldCfg s e a -> Text -> Text
getDisplayText InputFieldCfg s e a
config Text
text)
  glyphStart :: Double
glyphStart = Double -> (GlyphPos -> Double) -> Maybe GlyphPos -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 GlyphPos -> Double
_glpXMax (Maybe GlyphPos -> Double) -> Maybe GlyphPos -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Seq GlyphPos -> Maybe GlyphPos
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Int
cursor Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq GlyphPos
glyphs
  glyphOffset :: Double
glyphOffset = Seq GlyphPos -> Double
getGlyphsMin Seq GlyphPos
glyphs
  glyphX :: Double
glyphX = Double
glyphStart Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
glyphOffset
  curX :: Double
curX = Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
glyphX
  oldOffset :: Double
oldOffset = InputFieldState a -> Double
forall a. InputFieldState a -> Double
_ifsOffset InputFieldState a
oldState
  newOffset :: Double
newOffset
    | Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
cw Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Double
0
    | Bool
textFits Bool -> Bool -> Bool
&& Bool
alignR = -Double
caretW
    | Bool
textFits = Double
0
    | Bool
alignL Bool -> Bool -> Bool
&& Bool
cursorL = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
caretW
    | Bool
alignL Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
    | Bool
alignL Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
cx = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
    | Bool
alignR Bool -> Bool -> Bool
&& Bool
cursorR = -Double
caretW
    | Bool
alignR Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw = Double
tw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
glyphX
    | Bool
alignR Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
cx = Double
tw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
glyphX
    | Bool
alignC Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
    | Bool
alignC Bool -> Bool -> Bool
&& Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oldOffset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
cx = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curX
    | Bool
otherwise = Double
oldOffset
  justSel :: Int
justSel = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
sel
  newSel :: Maybe Int
newSel
    | Int -> Maybe Int
forall a. a -> Maybe a
Just Int
cursor Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
sel = Maybe Int
forall a. Maybe a
Nothing
    | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
sel Bool -> Bool -> Bool
&& (Int
justSel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
justSel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
text) = Maybe Int
forall a. Maybe a
Nothing
    | Bool
otherwise = Maybe Int
sel
  !tmpState :: InputFieldState a
tmpState = WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> InputFieldState a
forall s e a.
WidgetEnv s e
-> WidgetNode s e
-> InputFieldState a
-> InputFieldCfg s e a
-> InputFieldState a
updatePlaceholder WidgetEnv s e
wenv WidgetNode s e
node InputFieldState a
oldState InputFieldCfg s e a
config
  !newState :: InputFieldState a
newState = InputFieldState a
tmpState {
    _ifsCurrValue = value,
    _ifsCurrText = text,
    _ifsCursorPos = cursor,
    _ifsSelStart = newSel,
    _ifsGlyphs = glyphs,
    _ifsOffset = newOffset,
    _ifsTextRect = textRect & L.x .~ tx + newOffset,
    _ifsTextMetrics = 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 WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
Lens' (WidgetEnv s e) FontManager
L.fontManager
  style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  Rect Double
cx Double
cy Double
cw Double
ch = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
  carea :: Rect
carea = Double -> Double -> Double -> Double -> Rect
Rect Double
0 Double
0 Double
cw Double
ch
  size :: Size
size = Double -> Double -> Size
Size Double
cw Double
ch
  -- Placeholder style
  pstyle :: StyleState
pstyle = StyleState
style
    StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState
forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text ((Maybe TextStyle -> Identity (Maybe TextStyle))
 -> StyleState -> Identity StyleState)
-> ((Maybe AlignTH -> Identity (Maybe AlignTH))
    -> Maybe TextStyle -> Identity (Maybe TextStyle))
-> (Maybe AlignTH -> Identity (Maybe AlignTH))
-> StyleState
-> Identity StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Identity TextStyle)
 -> Maybe TextStyle -> Identity (Maybe TextStyle))
-> ((Maybe AlignTH -> Identity (Maybe AlignTH))
    -> TextStyle -> Identity TextStyle)
-> (Maybe AlignTH -> Identity (Maybe AlignTH))
-> Maybe TextStyle
-> Identity (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTH -> Identity (Maybe AlignTH))
-> TextStyle -> Identity TextStyle
forall s a. HasAlignH s a => Lens' s a
Lens' TextStyle (Maybe AlignTH)
L.alignH ((Maybe AlignTH -> Identity (Maybe AlignTH))
 -> StyleState -> Identity StyleState)
-> AlignTH -> StyleState -> StyleState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StyleState -> AlignTH
inputFieldAlignH StyleState
style
    StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState
forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text ((Maybe TextStyle -> Identity (Maybe TextStyle))
 -> StyleState -> Identity StyleState)
-> ((Maybe AlignTV -> Identity (Maybe AlignTV))
    -> Maybe TextStyle -> Identity (Maybe TextStyle))
-> (Maybe AlignTV -> Identity (Maybe AlignTV))
-> StyleState
-> Identity StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Identity TextStyle)
 -> Maybe TextStyle -> Identity (Maybe TextStyle))
-> ((Maybe AlignTV -> Identity (Maybe AlignTV))
    -> TextStyle -> Identity TextStyle)
-> (Maybe AlignTV -> Identity (Maybe AlignTV))
-> Maybe TextStyle
-> Identity (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTV -> Identity (Maybe AlignTV))
-> TextStyle -> Identity TextStyle
forall s a. HasAlignV s a => Lens' s a
Lens' TextStyle (Maybe AlignTV)
L.alignV ((Maybe AlignTV -> Identity (Maybe AlignTV))
 -> StyleState -> Identity StyleState)
-> AlignTV -> StyleState -> StyleState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StyleState -> AlignTV
inputFieldAlignV StyleState
style
  text :: Maybe Text
text = InputFieldCfg s e a -> Maybe Text
forall s e a. InputFieldCfg s e a -> Maybe Text
_ifcPlaceholder InputFieldCfg s e a
config
  fitText :: Size -> Text -> Seq TextLine
fitText = FontManager
-> StyleState
-> TextOverflow
-> TextMode
-> TextTrim
-> Maybe Int
-> Size
-> Text
-> Seq TextLine
fitTextToSize FontManager
fontMgr StyleState
pstyle TextOverflow
Ellipsis TextMode
MultiLine TextTrim
KeepSpaces Maybe Int
forall a. Maybe a
Nothing
  lines :: Seq TextLine
lines
    | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
text = Size -> Text -> Seq TextLine
fitText Size
size (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
text)
    | Bool
otherwise = Seq TextLine
forall a. Seq a
Seq.empty
  newState :: InputFieldState a
newState = InputFieldState a
state {
    _ifsPlaceholder = alignTextLines pstyle carea 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
  | Maybe (WidgetData s Bool) -> Bool
forall a. Maybe a -> Bool
isJust (InputFieldCfg s e a -> Maybe (WidgetData s Bool)
forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid InputFieldCfg s e a
config) = WidgetData s Bool -> Bool -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (Maybe (WidgetData s Bool) -> WidgetData s Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (WidgetData s Bool) -> WidgetData s Bool)
-> Maybe (WidgetData s Bool) -> WidgetData s Bool
forall a b. (a -> b) -> a -> b
$ InputFieldCfg s e a -> Maybe (WidgetData s Bool)
forall s e a. InputFieldCfg s e a -> Maybe (WidgetData s Bool)
_ifcValid InputFieldCfg s e a
config)
  | Bool
otherwise = [WidgetRequest s e] -> Bool -> [WidgetRequest s e]
forall a b. a -> b -> a
const []

inputFieldAlignH :: StyleState -> AlignTH
inputFieldAlignH :: StyleState -> AlignTH
inputFieldAlignH StyleState
style = AlignTH -> Maybe AlignTH -> AlignTH
forall a. a -> Maybe a -> a
fromMaybe AlignTH
ATLeft Maybe AlignTH
alignH where
  alignH :: Maybe AlignTH
alignH = StyleState
style StyleState
-> Getting (First AlignTH) StyleState AlignTH -> Maybe AlignTH
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
-> StyleState -> Const (First AlignTH) StyleState
forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text ((Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
 -> StyleState -> Const (First AlignTH) StyleState)
-> ((AlignTH -> Const (First AlignTH) AlignTH)
    -> Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
-> Getting (First AlignTH) StyleState AlignTH
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextStyle -> Const (First AlignTH) TextStyle)
-> Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextStyle -> Const (First AlignTH) TextStyle)
 -> Maybe TextStyle -> Const (First AlignTH) (Maybe TextStyle))
-> ((AlignTH -> Const (First AlignTH) AlignTH)
    -> TextStyle -> Const (First AlignTH) TextStyle)
-> (AlignTH -> Const (First AlignTH) AlignTH)
-> Maybe TextStyle
-> Const (First AlignTH) (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH))
-> TextStyle -> Const (First AlignTH) TextStyle
forall s a. HasAlignH s a => Lens' s a
Lens' TextStyle (Maybe AlignTH)
L.alignH ((Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH))
 -> TextStyle -> Const (First AlignTH) TextStyle)
-> ((AlignTH -> Const (First AlignTH) AlignTH)
    -> Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH))
-> (AlignTH -> Const (First AlignTH) AlignTH)
-> TextStyle
-> Const (First AlignTH) TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlignTH -> Const (First AlignTH) AlignTH)
-> Maybe AlignTH -> Const (First AlignTH) (Maybe AlignTH)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just

inputFieldAlignV :: StyleState -> AlignTV
inputFieldAlignV :: StyleState -> AlignTV
inputFieldAlignV StyleState
style = AlignTV -> Maybe AlignTV -> AlignTV
forall a. a -> Maybe a -> a
fromMaybe AlignTV
ATLowerX Maybe AlignTV
alignV where
  alignV :: Maybe AlignTV
alignV = StyleState
style StyleState
-> Getting (First AlignTV) StyleState AlignTV -> Maybe AlignTV
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
-> StyleState -> Const (First AlignTV) StyleState
forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text ((Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
 -> StyleState -> Const (First AlignTV) StyleState)
-> ((AlignTV -> Const (First AlignTV) AlignTV)
    -> Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
-> Getting (First AlignTV) StyleState AlignTV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextStyle -> Const (First AlignTV) TextStyle)
-> Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextStyle -> Const (First AlignTV) TextStyle)
 -> Maybe TextStyle -> Const (First AlignTV) (Maybe TextStyle))
-> ((AlignTV -> Const (First AlignTV) AlignTV)
    -> TextStyle -> Const (First AlignTV) TextStyle)
-> (AlignTV -> Const (First AlignTV) AlignTV)
-> Maybe TextStyle
-> Const (First AlignTV) (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV))
-> TextStyle -> Const (First AlignTV) TextStyle
forall s a. HasAlignV s a => Lens' s a
Lens' TextStyle (Maybe AlignTV)
L.alignV ((Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV))
 -> TextStyle -> Const (First AlignTV) TextStyle)
-> ((AlignTV -> Const (First AlignTV) AlignTV)
    -> Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV))
-> (AlignTV -> Const (First AlignTV) AlignTV)
-> TextStyle
-> Const (First AlignTV) TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlignTV -> Const (First AlignTV) AlignTV)
-> Maybe AlignTV -> Const (First AlignTV) (Maybe AlignTV)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe 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 (Char -> Text) -> Maybe Char -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputFieldCfg s e a -> Maybe Char
forall s e a. InputFieldCfg s e a -> Maybe Char
_ifcDisplayChar InputFieldCfg s e a
config
  displayText :: Text
displayText
    | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
displayChar = Int -> Text -> Text
T.replicate (Text -> Int
T.length Text
text) (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
displayChar)
    | Bool
otherwise = Text
text

delim :: Char -> Bool
delim :: Char -> Bool
delim Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'.', Char
',', Char
'/', Char
'-', Char
':']