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

Input field for multiline 'Text'. Allows setting the maximum number of
characters, lines and whether the tab key should trigger focus change.

@
textArea longTextLens
@

With configuration options:

@
textArea_ longTextLens [maxLength 1000, selectOnFocus]
@
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.TextArea (
  -- * Configuration
  TextAreaCfg,
  -- * Constructors
  textArea,
  textArea_,
  textAreaV,
  textAreaV_,
  textAreaD_
) where

import Control.Applicative ((<|>))
import Control.Lens hiding ((|>))
import Control.Monad (forM_, when)
import Data.Default
import Data.Foldable (toList)
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Tuple (swap)
import Data.Text (Text)
import GHC.Generics

import qualified Data.Sequence as Seq
import qualified Data.Text as T

import Monomer.Helper
import Monomer.Widgets.Containers.Scroll
import Monomer.Widgets.Single

import qualified Monomer.Lens as L

defCaretW :: Double
defCaretW :: Double
defCaretW = Double
2

defCaretMs :: Millisecond
defCaretMs :: Millisecond
defCaretMs = Millisecond
500

{-|
Configuration options for textArea:

- 'maxLength': the maximum length of input text.
- 'maxLines': the maximum number of lines of input text.
- 'acceptTab': whether to handle tab and convert it to spaces (cancelling change
  of focus), or keep default behaviour and lose focus.
- 'selectOnFocus': Whether all input should be selected when focus is received.
- 'readOnly': Whether to prevent the user changing the input text.
- 'onFocus': event to raise when focus is received.
- 'onFocusReq': 'WidgetRequest' to generate when focus is received.
- 'onBlur': event to raise when focus is lost.
- 'onBlurReq': 'WidgetRequest' to generate when focus is lost.
- 'onChange': event to raise when the value changes.
- 'onChangeReq': 'WidgetRequest' to generate when the value changes.
-}
data TextAreaCfg s e = TextAreaCfg {
  forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth :: Maybe Double,
  forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs :: Maybe Millisecond,
  forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength :: Maybe Int,
  forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines :: Maybe Int,
  forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab :: Maybe Bool,
  forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus :: Maybe Bool,
  forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly :: Maybe Bool,
  forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq :: [Text -> WidgetRequest s e]
}

instance Default (TextAreaCfg s e) where
  def :: TextAreaCfg s e
def = TextAreaCfg {
    _tacCaretWidth :: Maybe Double
_tacCaretWidth = forall a. Maybe a
Nothing,
    _tacCaretMs :: Maybe Millisecond
_tacCaretMs = forall a. Maybe a
Nothing,
    _tacMaxLength :: Maybe Int
_tacMaxLength = forall a. Maybe a
Nothing,
    _tacMaxLines :: Maybe Int
_tacMaxLines = forall a. Maybe a
Nothing,
    _tacAcceptTab :: Maybe Bool
_tacAcceptTab = forall a. Maybe a
Nothing,
    _tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = forall a. Maybe a
Nothing,
    _tacReadOnly :: Maybe Bool
_tacReadOnly = forall a. Maybe a
Nothing,
    _tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = [],
    _tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = [],
    _tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = []
  }

instance Semigroup (TextAreaCfg s e) where
  <> :: TextAreaCfg s e -> TextAreaCfg s e -> TextAreaCfg s e
(<>) TextAreaCfg s e
t1 TextAreaCfg s e
t2 = TextAreaCfg {
    _tacCaretWidth :: Maybe Double
_tacCaretWidth = forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
t1,
    _tacCaretMs :: Maybe Millisecond
_tacCaretMs = forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs TextAreaCfg s e
t1,
    _tacMaxLength :: Maybe Int
_tacMaxLength = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
t1,
    _tacMaxLines :: Maybe Int
_tacMaxLines = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
t1,
    _tacAcceptTab :: Maybe Bool
_tacAcceptTab = forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
t1,
    _tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
t1,
    _tacReadOnly :: Maybe Bool
_tacReadOnly = forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly TextAreaCfg s e
t1,
    _tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
t2,
    _tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
t2,
    _tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
t2
  }

instance Monoid (TextAreaCfg s e) where
  mempty :: TextAreaCfg s e
mempty = forall a. Default a => a
def

instance CmbCaretWidth (TextAreaCfg s e) Double where
  caretWidth :: Double -> TextAreaCfg s e
caretWidth Double
w = forall a. Default a => a
def {
    _tacCaretWidth :: Maybe Double
_tacCaretWidth = forall a. a -> Maybe a
Just Double
w
  }

instance CmbCaretMs (TextAreaCfg s e) Millisecond where
  caretMs :: Millisecond -> TextAreaCfg s e
caretMs Millisecond
ms = forall a. Default a => a
def {
    _tacCaretMs :: Maybe Millisecond
_tacCaretMs = forall a. a -> Maybe a
Just Millisecond
ms
  }

instance CmbMaxLength (TextAreaCfg s e) where
  maxLength :: Int -> TextAreaCfg s e
maxLength Int
len = forall a. Default a => a
def {
    _tacMaxLength :: Maybe Int
_tacMaxLength = forall a. a -> Maybe a
Just Int
len
  }

instance CmbMaxLines (TextAreaCfg s e) where
  maxLines :: Int -> TextAreaCfg s e
maxLines Int
lines = forall a. Default a => a
def {
    _tacMaxLines :: Maybe Int
_tacMaxLines = forall a. a -> Maybe a
Just Int
lines
  }

instance CmbAcceptTab (TextAreaCfg s e) where
  acceptTab_ :: Bool -> TextAreaCfg s e
acceptTab_ Bool
accept = forall a. Default a => a
def {
    _tacAcceptTab :: Maybe Bool
_tacAcceptTab = forall a. a -> Maybe a
Just Bool
accept
  }

instance CmbSelectOnFocus (TextAreaCfg s e) where
  selectOnFocus_ :: Bool -> TextAreaCfg s e
selectOnFocus_ Bool
sel = forall a. Default a => a
def {
    _tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = forall a. a -> Maybe a
Just Bool
sel
  }

instance CmbReadOnly (TextAreaCfg s e) where
  readOnly_ :: Bool -> TextAreaCfg s e
readOnly_ Bool
ro = forall a. Default a => a
def {
    _tacReadOnly :: Maybe Bool
_tacReadOnly = forall a. a -> Maybe a
Just Bool
ro
  }

instance WidgetEvent e => CmbOnFocus (TextAreaCfg s e) e Path where
  onFocus :: (Path -> e) -> TextAreaCfg s e
onFocus Path -> e
fn = forall a. Default a => a
def {
    _tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnFocusReq (TextAreaCfg s e) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> TextAreaCfg s e
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (TextAreaCfg s e) e Path where
  onBlur :: (Path -> e) -> TextAreaCfg s e
onBlur Path -> e
fn = forall a. Default a => a
def {
    _tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnBlurReq (TextAreaCfg s e) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> TextAreaCfg s e
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnChange (TextAreaCfg s e) Text e where
  onChange :: (Text -> e) -> TextAreaCfg s e
onChange Text -> e
fn = forall a. Default a => a
def {
    _tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> e
fn]
  }

instance CmbOnChangeReq (TextAreaCfg s e) s e Text where
  onChangeReq :: (Text -> WidgetRequest s e) -> TextAreaCfg s e
onChangeReq Text -> WidgetRequest s e
req = forall a. Default a => a
def {
    _tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = [Text -> WidgetRequest s e
req]
  }

data HistoryStep = HistoryStep {
  HistoryStep -> Text
_tahText :: !Text,
  HistoryStep -> (Int, Int)
_tahCursorPos :: !(Int, Int),
  HistoryStep -> Maybe (Int, Int)
_tahSelStart :: Maybe (Int, Int)
} deriving (HistoryStep -> HistoryStep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryStep -> HistoryStep -> Bool
$c/= :: HistoryStep -> HistoryStep -> Bool
== :: HistoryStep -> HistoryStep -> Bool
$c== :: HistoryStep -> HistoryStep -> Bool
Eq, Int -> HistoryStep -> ShowS
[HistoryStep] -> ShowS
HistoryStep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryStep] -> ShowS
$cshowList :: [HistoryStep] -> ShowS
show :: HistoryStep -> String
$cshow :: HistoryStep -> String
showsPrec :: Int -> HistoryStep -> ShowS
$cshowsPrec :: Int -> HistoryStep -> ShowS
Show, forall x. Rep HistoryStep x -> HistoryStep
forall x. HistoryStep -> Rep HistoryStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistoryStep x -> HistoryStep
$cfrom :: forall x. HistoryStep -> Rep HistoryStep x
Generic)

data TextAreaState = TextAreaState {
  TextAreaState -> Text
_tasText :: Text,
  TextAreaState -> TextMetrics
_tasTextMetrics :: TextMetrics,
  TextAreaState -> Maybe TextStyle
_tasTextStyle :: Maybe TextStyle,
  TextAreaState -> (Int, Int)
_tasCursorPos :: (Int, Int),
  TextAreaState -> Maybe (Int, Int)
_tasSelStart :: Maybe (Int, Int),
  TextAreaState -> Seq TextLine
_tasTextLines :: Seq TextLine,
  TextAreaState -> Seq HistoryStep
_tasHistory :: Seq HistoryStep,
  TextAreaState -> Int
_tasHistoryIdx :: Int,
  TextAreaState -> Millisecond
_tasFocusStart :: Millisecond
} deriving (TextAreaState -> TextAreaState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextAreaState -> TextAreaState -> Bool
$c/= :: TextAreaState -> TextAreaState -> Bool
== :: TextAreaState -> TextAreaState -> Bool
$c== :: TextAreaState -> TextAreaState -> Bool
Eq, Int -> TextAreaState -> ShowS
[TextAreaState] -> ShowS
TextAreaState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextAreaState] -> ShowS
$cshowList :: [TextAreaState] -> ShowS
show :: TextAreaState -> String
$cshow :: TextAreaState -> String
showsPrec :: Int -> TextAreaState -> ShowS
$cshowsPrec :: Int -> TextAreaState -> ShowS
Show, forall x. Rep TextAreaState x -> TextAreaState
forall x. TextAreaState -> Rep TextAreaState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextAreaState x -> TextAreaState
$cfrom :: forall x. TextAreaState -> Rep TextAreaState x
Generic)

instance Default TextAreaState where
  def :: TextAreaState
def = TextAreaState {
    _tasText :: Text
_tasText = Text
"",
    _tasTextMetrics :: TextMetrics
_tasTextMetrics = forall a. Default a => a
def,
    _tasTextStyle :: Maybe TextStyle
_tasTextStyle = forall a. Default a => a
def,
    _tasCursorPos :: (Int, Int)
_tasCursorPos = forall a. Default a => a
def,
    _tasSelStart :: Maybe (Int, Int)
_tasSelStart = forall a. Default a => a
def,
    _tasTextLines :: Seq TextLine
_tasTextLines = forall a. Seq a
Seq.empty,
    _tasHistory :: Seq HistoryStep
_tasHistory = forall a. Seq a
Seq.empty,
    _tasHistoryIdx :: Int
_tasHistoryIdx = Int
0,
    _tasFocusStart :: Millisecond
_tasFocusStart = Millisecond
0
  }

-- | Creates a text area using the given lens.
textArea :: WidgetEvent e => ALens' s Text -> WidgetNode s e
textArea :: forall e s. WidgetEvent e => ALens' s Text -> WidgetNode s e
textArea ALens' s Text
field = forall e s.
WidgetEvent e =>
ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ ALens' s Text
field forall a. Default a => a
def

-- | Creates a text area using the given lens. Accepts config.
textArea_
  :: WidgetEvent e => ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ :: forall e s.
WidgetEvent e =>
ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ ALens' s Text
field [TextAreaCfg s e]
configs = forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
textAreaD_ WidgetData s Text
wdata [TextAreaCfg s e]
configs where
  wdata :: WidgetData s Text
wdata = forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Text
field

-- | Creates a text area using the given value and 'onChange' event handler.
textAreaV :: WidgetEvent e => Text -> (Text -> e) -> WidgetNode s e
textAreaV :: forall e s. WidgetEvent e => Text -> (Text -> e) -> WidgetNode s e
textAreaV Text
value Text -> e
handler = forall e s.
WidgetEvent e =>
Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ Text
value Text -> e
handler forall a. Default a => a
def

-- | Creates a text area using the given value and 'onChange' event handler.
--   Accepts config.
textAreaV_
  :: WidgetEvent e => Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ :: forall e s.
WidgetEvent e =>
Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ Text
value Text -> e
handler [TextAreaCfg s e]
configs = forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
textAreaD_ forall {s}. WidgetData s Text
wdata [TextAreaCfg s e]
newConfig where
  wdata :: WidgetData s Text
wdata = forall s a. a -> WidgetData s a
WidgetValue Text
value
  newConfig :: [TextAreaCfg s e]
newConfig = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Text -> e
handler forall a. a -> [a] -> [a]
: [TextAreaCfg s e]
configs

-- | Creates a text area providing a 'WidgetData' instance and config.
textAreaD_
  :: WidgetEvent e
  => WidgetData s Text
  -> [TextAreaCfg s e]
  -> WidgetNode s e
textAreaD_ :: forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
textAreaD_ WidgetData s Text
wdata [TextAreaCfg s e]
configs = WidgetNode s e
scrollNode where
  config :: TextAreaCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [TextAreaCfg s e]
configs
  widget :: Widget s e
widget = forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config forall a. Default a => a
def
  node :: WidgetNode s e
node = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"textArea" Widget s e
widget
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
  scrollCfg :: [ScrollCfg s e]
scrollCfg = [forall s e. ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle, forall s e.
(WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle forall s e. WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault]
  scrollNode :: WidgetNode s e
scrollNode = forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ forall {s} {e}. [ScrollCfg s e]
scrollCfg WidgetNode s e
node

makeTextArea
  :: WidgetEvent e
  => WidgetData s Text
  -> TextAreaCfg s e
  -> TextAreaState
  -> Widget s e
makeTextArea :: forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea !WidgetData s Text
wdata !TextAreaCfg s e
config !TextAreaState
state = Widget s e
widget where
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle TextAreaState
state forall a. Default a => a
def {
    singleInit :: SingleInitHandler s e
singleInit = SingleInitHandler s e
init,
    singleMerge :: SingleMergeHandler s e TextAreaState
singleMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> TextAreaState -> WidgetResult s e
merge,
    singleDispose :: SingleInitHandler s e
singleDispose = forall {p} {s} {e}. p -> WidgetNode s e -> WidgetResult s e
dispose,
    singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = forall {a} {b} {p} {p}.
(CmbMinWidth a, CmbMinHeight b) =>
p -> p -> (a, b)
getSizeReq,
    singleRender :: SingleRenderHandler s e
singleRender = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
  }

  !caretMs :: Millisecond
caretMs = forall a. a -> Maybe a -> a
fromMaybe Millisecond
defCaretMs (forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs TextAreaCfg s e
config)
  !maxLength :: Maybe Int
maxLength = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
config
  !maxLines :: Maybe Int
maxLines = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
config
  !editable :: Bool
editable = forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly TextAreaCfg s e
config forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True
  getModelValue :: WidgetEnv s e -> Text
getModelValue !WidgetEnv s e
wenv = forall s a. s -> WidgetData s a -> a
widgetDataGet (forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) WidgetData s Text
wdata
  -- State
  !currText :: Text
currText = TextAreaState -> Text
_tasText TextAreaState
state
  !textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
  -- Helpers
  validText :: TextAreaState -> Bool
validText !TextAreaState
state = Bool
validLen Bool -> Bool -> Bool
&& Bool
validLines where
    text :: Text
text = TextAreaState -> Text
_tasText TextAreaState
state
    lines :: Seq TextLine
lines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
    validLen :: Bool
validLen = Text -> Int
T.length Text
text forall a. Ord a => a -> a -> Bool
<= forall a. a -> Maybe a -> a
fromMaybe forall a. Bounded a => a
maxBound Maybe Int
maxLength
    validLines :: Bool
validLines = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
lines forall a. Ord a => a -> a -> Bool
<= forall a. a -> Maybe a -> a
fromMaybe forall a. Bounded a => a
maxBound Maybe Int
maxLines
  line :: Int -> Text
line !Int
idx
    | Int
idx forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text
    | Bool
otherwise = Text
""
  !lineLen :: Int -> Int
lineLen = Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
line
  !totalLines :: Int
totalLines = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines
  !lastPos :: (Int, Int)
lastPos = (Int -> Int
lineLen (Int
totalLines forall a. Num a => a -> a -> a
- Int
1), Int
totalLines)

  init :: SingleInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    text :: Text
text = forall {e}. WidgetEnv s e -> Text
getModelValue WidgetEnv s e
wenv
    newState :: TextAreaState
newState = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
text
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState

  merge :: WidgetEnv s e
-> WidgetNode s e -> p -> TextAreaState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode TextAreaState
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    oldText :: Text
oldText = TextAreaState -> Text
_tasText TextAreaState
oldState
    newText :: Text
newText = forall {e}. WidgetEnv s e -> Text
getModelValue WidgetEnv s e
wenv
    newState :: TextAreaState
newState
      | Text
oldText forall a. Eq a => a -> a -> Bool
/= Text
newText = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
newText
      | Bool
otherwise = TextAreaState
oldState
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState

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

  handleKeyPress :: WidgetEnv s e
-> KeyMod -> KeyCode -> Maybe (Text, (Int, Int), Maybe (Int, Int))
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code
    | Bool
isDelBackWordNoSel Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (Text, (Int, Int), Maybe (Int, Int))
removeWordL
    | Bool
isDelBackWord Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
selStart Text
"")
    | Bool
isBackspace Bool -> Bool -> Bool
&& Bool
emptySel Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (Text, (Int, Int), Maybe (Int, Int))
removeCharL
    | Bool
isBackspace Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
selStart Text
"")
    | Bool
isMoveLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
- Int
1, Int
tpY) forall a. Maybe a
Nothing
    | Bool
isMoveRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
+ Int
1, Int
tpY) forall a. Maybe a
Nothing
    | Bool
isMoveUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
1) forall a. Maybe a
Nothing
    | Bool
isMoveDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
1) forall a. Maybe a
Nothing
    | Bool
isMovePageUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
vpLines) forall a. Maybe a
Nothing
    | Bool
isMovePageDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
vpLines) forall a. Maybe a
Nothing
    | Bool
isMoveWordL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
prevWordPos forall a. Maybe a
Nothing
    | Bool
isMoveWordR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
nextWordPos forall a. Maybe a
Nothing
    | Bool
isMoveLineL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
tpY) forall a. Maybe a
Nothing
    | Bool
isMoveLineR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int -> Int
lineLen Int
tpY, Int
tpY) forall a. Maybe a
Nothing
    | Bool
isMoveFullUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) forall a. Maybe a
Nothing
    | Bool
isMoveFullDn = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
lastPos forall a. Maybe a
Nothing
    | Bool
isSelectAll = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) (forall a. a -> Maybe a
Just (Int, Int)
lastPos)
    | Bool
isSelectLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
- Int
1, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
+ Int
1, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
1) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectPageUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
vpLines) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectPageDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
vpLines) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectWordL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
prevWordPos (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectWordR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
nextWordPos (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectLineL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectLineR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int -> Int
lineLen Int
tpY, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectFullUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectFullDn = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
lastPos (forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isDeselectLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
minTpSel forall a. Maybe a
Nothing
    | Bool
isDeselectRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
maxTpSel forall a. Maybe a
Nothing
    | Bool
isDeselectUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
minTpSel forall a. Maybe a
Nothing
    | Bool
isDeselectDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
maxTpSel forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
      txt :: Text
txt = Text
currText
      txtLen :: Int
txtLen = Text -> Int
T.length Text
txt
      textMetrics :: TextMetrics
textMetrics = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
      tp :: (Int, Int)
tp@(Int
tpX, Int
tpY) = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
      selStart :: Maybe (Int, Int)
selStart = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state

      ((Int, Int)
minTpSel, (Int, Int)
maxTpSel)
        | forall a b. (a, b) -> (b, a)
swap (Int, Int)
tp forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart) = ((Int, Int)
tp, forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart)
        | Bool
otherwise = (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart, (Int, Int)
tp)
      emptySel :: Bool
emptySel = forall a. Maybe a -> Bool
isNothing Maybe (Int, Int)
selStart
      vpLines :: Int
vpLines = forall a b. (RealFrac a, Integral b) => a -> b
round (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasH s a => Lens' s a
L.h forall a. Fractional a => a -> a -> a
/ TextMetrics
textMetrics forall s a. s -> Getting a s a -> a
^. forall s a. HasLineH s a => Lens' s a
L.lineH)
      activeSel :: Bool
activeSel = forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart

      prevTxt :: Text
prevTxt
        | Int
tpX forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Text -> Text
T.take Int
tpX (Int -> Text
line Int
tpY)
        | Bool
otherwise = Int -> Text
line (Int
tpY forall a. Num a => a -> a -> a
- Int
1)
      prevWordStart :: Text
prevWordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
delim forall a b. (a -> b) -> a -> b
$ Text
prevTxt
      prevWordPos :: (Int, Int)
prevWordPos
        | Int
tpX forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
tpY forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
tpX, Int
tpY)
        | Int
tpX forall a. Ord a => a -> a -> Bool
> Int
0 = (Text -> Int
T.length Text
prevWordStart, Int
tpY)
        | Bool
otherwise = (Text -> Int
T.length Text
prevWordStart, Int
tpY forall a. Num a => a -> a -> a
- Int
1)

      nextTxt :: Text
nextTxt
        | Int
tpX forall a. Ord a => a -> a -> Bool
< Int -> Int
lineLen Int
tpY = Int -> Text -> Text
T.drop Int
tpX (Int -> Text
line Int
tpY)
        | Bool
otherwise = Int -> Text
line (Int
tpY forall a. Num a => a -> a -> a
+ Int
1)
      nextWordEnd :: Text
nextWordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
delim forall a b. (a -> b) -> a -> b
$ Text
nextTxt
      nextWordPos :: (Int, Int)
nextWordPos
        | Int
tpX forall a. Eq a => a -> a -> Bool
== Int -> Int
lineLen Int
tpY Bool -> Bool -> Bool
&& Int
tpY forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Num a => a -> a -> a
- Int
1 = (Int
tpX, Int
tpY)
        | Int
tpX forall a. Ord a => a -> a -> Bool
< Int -> Int
lineLen Int
tpY = (Int -> Int
lineLen Int
tpY forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd, Int
tpY)
        | Bool
otherwise = (Int -> Int
lineLen (Int
tpY forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd, Int
tpY forall a. Num a => a -> a -> a
+ Int
1)

      isShift :: Bool
isShift = KeyMod -> Bool
_kmLeftShift KeyMod
mod
      isLeft :: Bool
isLeft = KeyCode -> Bool
isKeyLeft KeyCode
code
      isRight :: Bool
isRight = KeyCode -> Bool
isKeyRight KeyCode
code
      isUp :: Bool
isUp = KeyCode -> Bool
isKeyUp KeyCode
code
      isDown :: Bool
isDown = KeyCode -> Bool
isKeyDown KeyCode
code
      isHome :: Bool
isHome = KeyCode -> Bool
isKeyHome KeyCode
code
      isEnd :: Bool
isEnd = KeyCode -> Bool
isKeyEnd KeyCode
code
      isPageUp :: Bool
isPageUp = KeyCode -> Bool
isKeyPageUp KeyCode
code
      isPageDown :: Bool
isPageDown = KeyCode -> Bool
isKeyPageDown KeyCode
code

      isWordMod :: Bool
isWordMod
        | forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
      isLineMod :: Bool
isLineMod
        | forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod Bool -> Bool -> Bool
|| KeyMod -> Bool
_kmLeftGUI KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
      isAllMod :: Bool
isAllMod
        | forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftGUI KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod

      isBackspace :: Bool
isBackspace = KeyCode -> Bool
isKeyBackspace KeyCode
code
      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)
      isMoveFullUp :: Bool
isMoveFullUp = Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isUp
      isMoveFullDn :: Bool
isMoveFullDn = Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isDown
      isMoveUp :: Bool
isMoveUp = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isUp
      isMoveDown :: Bool
isMoveDown = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isDown
      isMovePageUp :: Bool
isMovePageUp = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isPageUp
      isMovePageDown :: Bool
isMovePageDown = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isPageDown

      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
      isSelectUp :: Bool
isSelectUp = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isUp
      isSelectDown :: Bool
isSelectDown = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isDown
      isSelectPageUp :: Bool
isSelectPageUp = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isPageUp
      isSelectPageDown :: Bool
isSelectPageDown = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isPageDown
      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)
      isSelectFullUp :: Bool
isSelectFullUp = Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isUp
      isSelectFullDn :: Bool
isSelectFullDn = Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isDown

      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
      isDeselectUp :: Bool
isDeselectUp = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isUp
      isDeselectDown :: Bool
isDeselectDown = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isDown

      replaceFix :: (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int, Int)
sel Text
text = TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int) -> (Int, Int)
fixPos (Int, Int)
sel) Text
text
      removeCharL :: (Text, (Int, Int), Maybe (Int, Int))
removeCharL
        | Int
tpX forall a. Ord a => a -> a -> Bool
> Int
0 = (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int
tpX forall a. Num a => a -> a -> a
- Int
1, Int
tpY) Text
""
        | Bool
otherwise = (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int -> Int
lineLen (Int
tpY forall a. Num a => a -> a -> a
- Int
1), Int
tpY forall a. Num a => a -> a -> a
- Int
1) Text
""
      removeWordL :: (Text, (Int, Int), Maybe (Int, Int))
removeWordL = (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int, Int)
prevWordPos Text
""
      moveCursor :: a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor a
txt (Int, Int)
newPos Maybe (Int, Int)
newSel
        | forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe (Int, Int)
newSel = (a
txt, (Int, Int)
fixedPos, forall a. Maybe a
Nothing)
        | forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart Bool -> Bool -> Bool
&& forall a. a -> Maybe a
Just (Int, Int)
fixedPos forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
selStart = (a
txt, (Int, Int)
fixedPos, forall a. Maybe a
Nothing)
        | forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
selStart)
        | forall a. a -> Maybe a
Just (Int, Int)
fixedPos forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
fixedSel = (a
txt, (Int, Int)
fixedPos, forall a. Maybe a
Nothing)
        | Bool
otherwise = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
fixedSel)
        where
          fixedPos :: (Int, Int)
fixedPos = (Int, Int) -> (Int, Int)
fixPos (Int, Int)
newPos
          fixedSel :: Maybe (Int, Int)
fixedSel = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> (Int, Int)
fixPos Maybe (Int, Int)
newSel
      fixPos :: (Int, Int) -> (Int, Int)
fixPos (Int
cX, Int
cY) = (Int, Int)
result where
        nlines :: Int
nlines = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines
        vcY :: Int
vcY = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
nlines forall a. Num a => a -> a -> a
- Int
1) Int
cY
        vcX :: Int
vcX = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int
lineLen Int
tpY) Int
cX
        ncX :: Int
ncX = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int
lineLen Int
vcY) Int
cX
        sameX :: Bool
sameX = Int
vcX forall a. Eq a => a -> a -> Bool
== Int
tpX
        sameY :: Bool
sameY = Int
vcY forall a. Eq a => a -> a -> Bool
== Int
tpY
        result :: (Int, Int)
result
          | Bool
sameY Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
vcY forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
0, Int
0)
          | Bool
sameY Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
vcY forall a. Ord a => a -> a -> Bool
> Int
0 = (Int -> Int
lineLen (Int
vcY forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
cX forall a. Num a => a -> a -> a
+ Int
1, Int
vcY forall a. Num a => a -> a -> a
- Int
1)
          | Bool
sameY Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
> Int -> Int
lineLen Int
vcY Bool -> Bool -> Bool
&& Int
vcY forall a. Ord a => a -> a -> Bool
< Int
nlines forall a. Num a => a -> a -> a
- Int
1 = (Int
cX forall a. Num a => a -> a -> a
- Int -> Int
lineLen Int
vcY forall a. Num a => a -> a -> a
- Int
1, Int
vcY forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
sameX Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
> Int -> Int
lineLen Int
vcY = (forall a. Ord a => a -> a -> a
min Int
cX (Int -> Int
lineLen Int
vcY), Int
vcY)
          | Bool
otherwise = (Int
ncX, Int
vcY)

  handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
      | Int
clicks forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
        newPos :: (Int, Int)
newPos = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
        newState :: TextAreaState
newState = TextAreaState
state {
          _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
          _tasSelStart :: Maybe (Int, Int)
_tasSelStart = forall a. Maybe a
Nothing
        }
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
        result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce]

    -- Select word if clicked twice in a row
    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks forall a. Eq a => a -> a -> Bool
== Int
2 -> Maybe (WidgetResult s e)
result where
        (Int
tx, Int
ty) = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
        currText :: Text
currText = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
ty forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text
        (Text
part1, Text
part2) = Int -> Text -> (Text, Text)
T.splitAt Int
tx Text
currText
        txtLen :: Int
txtLen = Text -> Int
T.length Text
currText
        wordStart :: Text
wordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part1
        wordStartIdx :: Int
wordStartIdx = Text -> Int
T.length Text
wordStart
        wordEnd :: Text
wordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part2
        wordEndIdx :: Int
wordEndIdx = Int
txtLen forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
wordEnd
        newPos :: (Int, Int)
newPos = (Int
wordStartIdx, Int
ty)
        newSel :: Maybe (Int, Int)
newSel = forall a. a -> Maybe a
Just (Int
wordEndIdx, Int
ty)
        newState :: TextAreaState
newState = TextAreaState
state {
          _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
          _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
        }
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
        result :: Maybe (WidgetResult s e)
result
          | Int
ty forall a. Ord a => a -> a -> Bool
< Int
totalLines = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce])
          | Bool
otherwise = forall a. Maybe a
Nothing

    -- Select line if clicked three times in a row
    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks forall a. Eq a => a -> a -> Bool
== Int
3 -> Maybe (WidgetResult s e)
result where
        (Int
tx, Int
ty) = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
        glyphs :: Seq GlyphPos
glyphs = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
ty forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs
        newPos :: (Int, Int)
newPos = (Int
0, Int
ty)
        newSel :: Maybe (Int, Int)
newSel = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs, Int
ty)
        newState :: TextAreaState
newState = TextAreaState
state {
          _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
          _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
        }
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
        result :: Maybe (WidgetResult s e)
result
          | Int
ty forall a. Ord a => a -> a -> Bool
< Int
totalLines = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce])
          | Bool
otherwise = forall a. Maybe a
Nothing

    -- Select all if clicked four times in a row
    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks forall a. Eq a => a -> a -> Bool
== Int
4 -> Maybe (WidgetResult s e)
result where
        glyphs :: Seq GlyphPos
glyphs = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines (Int
totalLines forall a. Num a => a -> a -> a
- Int
1) forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs
        newPos :: (Int, Int)
newPos = (Int
0, Int
0)
        newSel :: Maybe (Int, Int)
newSel = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs, Int
totalLines forall a. Num a => a -> a -> a
- Int
1)
        newState :: TextAreaState
newState = TextAreaState
state {
          _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
          _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
        }
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
        result :: Maybe (WidgetResult s e)
result
          | Int
totalLines forall a. Ord a => a -> a -> Bool
> Int
0 = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce])
          | Bool
otherwise = forall a. Maybe a
Nothing

    Move Point
point
      | forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node -> forall a. a -> Maybe a
Just WidgetResult s e
result where
        curPos :: (Int, Int)
curPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
        selStart :: Maybe (Int, Int)
selStart = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state
        newPos :: (Int, Int)
newPos = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
        newSel :: Maybe (Int, Int)
newSel = Maybe (Int, Int)
selStart forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just (Int, Int)
curPos
        newState :: TextAreaState
newState = TextAreaState
state {
          _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
          _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
        }
        scrollReq :: [WidgetRequest s e]
scrollReq = forall {s} {e} {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateScrollReq WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
        result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (forall s e. WidgetRequest s e
RenderOnce forall a. a -> [a] -> [a]
: forall {s} {e}. [WidgetRequest s e]
scrollReq)

    KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
      | forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCopy WidgetEnv s e
wenv SystemEvent
evt -> forall a. a -> Maybe a
Just WidgetResult s e
resultCopy
      | forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardPaste WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultPaste
      | forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCut WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultCut
      | forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardUndo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextAreaState -> Int -> WidgetResult s e
moveHistory TextAreaState
bwdState (-Int
1)
      | forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardRedo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextAreaState -> Int -> WidgetResult s e
moveHistory TextAreaState
state Int
1
      | KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultReturn
      | KeyCode -> Bool
isKeyTab KeyCode
code Bool -> Bool -> Bool
&& Bool
acceptTab Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultTab
      | Bool
otherwise -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, (Int, Int), Maybe (Int, Int)) -> WidgetResult s e
handleKeyRes (forall {s} {e}.
WidgetEnv s e
-> KeyMod -> KeyCode -> Maybe (Text, (Int, Int), Maybe (Int, Int))
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code)
      where
        acceptTab :: Bool
acceptTab = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
config)
        selectedText :: Text
selectedText = forall a. a -> Maybe a -> a
fromMaybe Text
"" (TextAreaState -> Maybe Text
getSelection TextAreaState
state)
        clipboardReq :: WidgetRequest s e
clipboardReq = forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText)

        resultCopy :: WidgetResult s e
resultCopy = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
clipboardReq]
        resultPaste :: WidgetResult s e
resultPaste = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
GetClipboard WidgetId
widgetId]
        resultCut :: WidgetResult s e
resultCut = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
""
          forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. a -> Seq a
Seq.singleton forall s e. WidgetRequest s e
clipboardReq
        resultReturn :: WidgetResult s e
resultReturn = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
"\n"
        resultTab :: WidgetResult s e
resultTab = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
"    "
          forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. a -> Seq a
Seq.singleton forall s e. WidgetRequest s e
IgnoreParentEvents

        history :: Seq HistoryStep
history = TextAreaState -> Seq HistoryStep
_tasHistory TextAreaState
state
        historyIdx :: Int
historyIdx = TextAreaState -> Int
_tasHistoryIdx TextAreaState
state

        bwdState :: TextAreaState
bwdState = TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state (Int
historyIdx forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
history)

        moveHistory :: TextAreaState -> Int -> WidgetResult s e
moveHistory TextAreaState
state Int
steps = WidgetResult s e
result where
          newIdx :: Int
newIdx = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
history) (Int
historyIdx forall a. Num a => a -> a -> a
+ Int
steps)
          newState :: TextAreaState
newState = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Int
newIdx
          newNode :: WidgetNode s e
newNode = WidgetNode s e
node
            forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
          result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (forall {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState)

        handleKeyRes :: (Text, (Int, Int), Maybe (Int, Int)) -> WidgetResult s e
handleKeyRes (Text
newText, (Int, Int)
newPos, Maybe (Int, Int)
newSel) = WidgetResult s e
result where
          tmpState :: TextAreaState
tmpState = TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state (TextAreaState -> Text
_tasText TextAreaState
state forall a. Eq a => a -> a -> Bool
/= Text
newText)
          newState :: TextAreaState
newState = (forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
tmpState Text
newText) {
            _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
            _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
          }
          newNode :: WidgetNode s e
newNode = WidgetNode s e
node
            forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
          result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (forall {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState)

    TextInput Text
newText
      | Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
result where
        result :: WidgetResult s e
result = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
newText

    Clipboard (ClipboardText Text
newText) -> forall a. a -> Maybe a
Just WidgetResult s e
result where
      result :: WidgetResult s e
result = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
newText

    Focus Path
prev -> forall a. a -> Maybe a
Just WidgetResult s e
result where
      selectOnFocus :: Bool
selectOnFocus = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
config)
      tmpState :: TextAreaState
tmpState
        | Bool
selectOnFocus Bool -> Bool -> Bool
&& Text -> Int
T.length Text
currText forall a. Ord a => a -> a -> Bool
> Int
0 = TextAreaState
state {
            _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
lastPos,
            _tasSelStart :: Maybe (Int, Int)
_tasSelStart = forall a. a -> Maybe a
Just (Int
0, Int
0)
          }
        | Bool
otherwise = TextAreaState
state
      newState :: TextAreaState
newState = TextAreaState
tmpState {
        _tasFocusStart :: Millisecond
_tasFocusStart = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
      }
      reqs :: [WidgetRequest s e]
reqs = [forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
caretMs forall a. Maybe a
Nothing, forall s e. Rect -> WidgetRequest s e
StartTextInput Rect
viewport]
      newNode :: WidgetNode s e
newNode = WidgetNode s e
node
        forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
      newResult :: WidgetResult s e
newResult = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
reqs
      focusRs :: Maybe (WidgetResult s e)
focusRs = forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
newNode Path
prev (forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
config)
      result :: WidgetResult s e
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
focusRs

    Blur Path
next -> forall a. a -> Maybe a
Just WidgetResult s e
result where
      reqs :: [WidgetRequest s e]
reqs = [forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId, forall s e. WidgetRequest s e
StopTextInput]
      newResult :: WidgetResult s e
newResult = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs
      blurRes :: Maybe (WidgetResult s e)
blurRes = forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
config)
      result :: WidgetResult s e
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
blurRes
    SystemEvent
_ -> forall a. Maybe a
Nothing

    where
      widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      viewport :: Rect
viewport = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
      style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      Rect Double
cx Double
cy Double
cw Double
ch = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      localPoint :: Point -> Point
localPoint Point
point = Point -> Point -> Point
subPoint Point
point (Double -> Double -> Point
Point Double
cx Double
cy)

  insertText :: WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
addedText = WidgetResult s e
result where
    currSel :: Maybe (Int, Int)
currSel = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state
    (Text
newText, (Int, Int)
newPos, Maybe (Int, Int)
newSel) = TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
currSel Text
addedText
    tmpState :: TextAreaState
tmpState = TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state (TextAreaState -> Text
_tasText TextAreaState
state forall a. Eq a => a -> a -> Bool
/= Text
newText)
    newState :: TextAreaState
newState = (forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
tmpState Text
newText) {
      _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
      _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
    }
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
    newReqs :: [WidgetRequest s e]
newReqs = forall {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState
    result :: WidgetResult s e
result
      | TextAreaState -> Bool
validText TextAreaState
newState = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
newReqs
      | Bool
otherwise = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

  generateReqs :: WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState = [WidgetRequest s e]
reqs forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
reqScroll where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    oldText :: Text
oldText = TextAreaState -> Text
_tasText TextAreaState
state
    newText :: Text
newText = TextAreaState -> Text
_tasText TextAreaState
newState
    reqUpdate :: [WidgetRequest s e]
reqUpdate = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s Text
wdata Text
newText
    reqOnChange :: [WidgetRequest s e]
reqOnChange = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Text
newText) (forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
config)
    reqResize :: [WidgetRequest s e]
reqResize = [forall s e. WidgetId -> WidgetRequest s e
ResizeWidgetsImmediate WidgetId
widgetId]
    reqScroll :: [WidgetRequest s e]
reqScroll = forall {s} {e} {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateScrollReq WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState
    reqs :: [WidgetRequest s e]
reqs
      | Text
oldText forall a. Eq a => a -> a -> Bool
/= Text
newText = forall {e}. [WidgetRequest s e]
reqUpdate forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
reqResize
      | Bool
otherwise = []

  generateScrollReq :: WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateScrollReq WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState = forall {s} {e}. [WidgetRequest s e]
scrollReq where
    style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    scPath :: Path
scPath = forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
node
    scWid :: Maybe WidgetId
scWid = forall s e. WidgetEnv s e -> Path -> Maybe WidgetId
widgetIdFromPath WidgetEnv s e
wenv Path
scPath
    contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
    offset :: Point
offset = Double -> Double -> Point
Point (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x) (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y)
    caretRect :: Rect
caretRect = forall s e. TextAreaCfg s e -> TextAreaState -> Rect
getCaretRect TextAreaCfg s e
config TextAreaState
newState
    -- Padding/border added to show left/top borders when moving near them
    scrollRect :: Rect
scrollRect = forall a. a -> Maybe a -> a
fromMaybe Rect
caretRect (StyleState -> Rect -> Maybe Rect
addOuterBounds StyleState
style Rect
caretRect)
    scrollMsg :: ScrollMessage
scrollMsg = Rect -> ScrollMessage
ScrollTo forall a b. (a -> b) -> a -> b
$ Point -> Rect -> Rect
moveRect Point
offset Rect
scrollRect
    scrollReq :: [WidgetRequest s e]
scrollReq
      | Rect -> Rect -> Bool
rectInRect Rect
caretRect (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing Maybe WidgetId
scWid = []
      | Bool
otherwise = [forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage (forall a. HasCallStack => Maybe a -> a
fromJust Maybe WidgetId
scWid) ScrollMessage
scrollMsg]

  getSizeReq :: p -> p -> (a, b)
getSizeReq p
wenv p
node = (a, b)
sizeReq where
    Size Double
w Double
h = Seq TextLine -> Size
getTextLinesSize Seq TextLine
textLines
    {- getTextLines does not return the vertical spacing for the last line, but
    we need it since the selection rect displays it. -}
    spaceV :: Double
spaceV = Seq TextLine -> Double
getSpaceV Seq TextLine
textLines
    sizeReq :: (a, b)
sizeReq = (forall t. CmbMinWidth t => Double -> t
minWidth (forall a. Ord a => a -> a -> a
max Double
100 Double
w), forall t. CmbMinHeight t => Double -> t
minHeight (forall a. Ord a => a -> a -> a
max Double
20 (Double
h forall a. Num a => a -> a -> a
+ Double
spaceV)))

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer =
    Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer Point
offset forall a b. (a -> b) -> a -> b
$ do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
selRequired forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Rect]
selRects forall a b. (a -> b) -> a -> b
$ \Rect
rect ->
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Rect
rect forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w forall a. Ord a => a -> a -> Bool
> Double
0) forall a b. (a -> b) -> a -> b
$
            Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
rect (forall a. a -> Maybe a
Just Color
selColor) forall a. Maybe a
Nothing

      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq TextLine
textLines (Renderer -> StyleState -> TextLine -> IO ()
drawTextLine Renderer
renderer StyleState
style)

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
caretRequired forall a b. (a -> b) -> a -> b
$
        Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
caretRect (forall a. a -> Maybe a
Just Color
caretColor) forall a. Maybe a
Nothing
    where
      style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      ts :: Millisecond
ts = forall s e. WidgetEnv s e -> Millisecond
_weTimestamp WidgetEnv s e
wenv
      offset :: Point
offset = Double -> Double -> Point
Point (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x) (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y)
      focused :: Bool
focused = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node

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

      selRequired :: Bool
selRequired = forall a. Maybe a -> Bool
isJust (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state)
      selColor :: Color
selColor = StyleState -> Color
styleHlColor StyleState
style
      selRects :: [Rect]
selRects = TextAreaState -> Rect -> [Rect]
getSelectionRects TextAreaState
state Rect
contentArea

getCaretRect :: TextAreaCfg s e -> TextAreaState -> Rect
getCaretRect :: forall s e. TextAreaCfg s e -> TextAreaState -> Rect
getCaretRect TextAreaCfg s e
config TextAreaState
state = Rect
caretRect where
  (Int
cursorX, Int
cursorY) = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
  Rect Double
tx Double
ty Double
_ Double
_ = Rect
lineRect
  TextMetrics Double
asc Double
desc Double
lineh Double
_ = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
  textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state

  (Rect
lineRect, Seq GlyphPos
glyphs, FontSpace
fspaceV) = case forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
cursorY Seq TextLine
textLines of
    Just TextLine
tl -> (TextLine
tl forall s a. s -> Getting a s a -> a
^. forall s a. HasRect s a => Lens' s a
L.rect, TextLine
tl forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs, TextLine
tl forall s a. s -> Getting a s a -> a
^. forall s a. HasFontSpaceV s a => Lens' s a
L.fontSpaceV)
    Maybe TextLine
Nothing -> (forall a. Default a => a
def, forall a. Seq a
Seq.empty, forall a. Default a => a
def)
  spaceV :: Double
spaceV = FontSpace -> Double
unFontSpace FontSpace
fspaceV

  caretPos :: Double
caretPos
    | Int
cursorX forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
cursorX forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = Double
0
    | Int
cursorX forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = GlyphPos -> Double
_glpXMax (forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs (Int
cursorX forall a. Num a => a -> a -> a
- Int
1))
    | Bool
otherwise = GlyphPos -> Double
_glpXMin (forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs Int
cursorX)

  caretX :: Double
caretX = forall a. Ord a => a -> a -> a
max Double
0 (Double
tx forall a. Num a => a -> a -> a
+ Double
caretPos)
  caretY :: Double
caretY = Double
ty forall a. Num a => a -> a -> a
- Double
spaceV
  caretW :: Double
caretW = forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
config)
  caretH :: Double
caretH = Double
lineh forall a. Num a => a -> a -> a
+ Double
spaceV

  caretRect :: Rect
caretRect = Double -> Double -> Double -> Double -> Rect
Rect Double
caretX Double
caretY Double
caretW Double
caretH

getSelectionRects :: TextAreaState -> Rect -> [Rect]
getSelectionRects :: TextAreaState -> Rect -> [Rect]
getSelectionRects TextAreaState
state Rect
contentArea = [Rect]
rects where
  currPos :: (Int, Int)
currPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
  currSel :: (Int, Int)
currSel = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state)
  TextMetrics Double
asc Double
desc Double
lineh Double
_ = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
  textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state

  spaceV :: Double
spaceV = Seq TextLine -> Double
getSpaceV Seq TextLine
textLines
  line :: Int -> Text
line Int
idx
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Ord a => a -> a -> Bool
> Int
idx = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text
    | Bool
otherwise = Text
""
  lineLen :: Int -> Int
lineLen = Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
line

  glyphs :: Int -> Seq GlyphPos
glyphs Int
idx
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Ord a => a -> a -> Bool
> Int
idx = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs
    | Bool
otherwise = forall a. Seq a
Seq.empty
  glyphPos :: Int -> Int -> Double
glyphPos Int
posx Int
posy
    | Int
posx forall a. Eq a => a -> a -> Bool
== Int
0 = Double
0
    | Int
posx forall a. Eq a => a -> a -> Bool
== Int -> Int
lineLen Int
posy = GlyphPos -> Double
_glpXMax (forall a. Seq a -> Int -> a
Seq.index (Int -> Seq GlyphPos
glyphs Int
posy) (Int
posx forall a. Num a => a -> a -> a
- Int
1))
    | Bool
otherwise = GlyphPos -> Double
_glpXMin (forall a. Seq a -> Int -> a
Seq.index (Int -> Seq GlyphPos
glyphs Int
posy) Int
posx)

  ((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
    | forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (Int, Int)
currSel = ((Int, Int)
currPos, (Int, Int)
currSel)
    | Bool
otherwise = ((Int, Int)
currSel, (Int, Int)
currPos)

  totalH :: Double
totalH = Double
lineh forall a. Num a => a -> a -> a
+ Double
spaceV
  updateRect :: b -> b
updateRect b
rect = b
rect
    forall a b. a -> (a -> b) -> b
& forall s a. HasY s a => Lens' s a
L.y forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Double
spaceV
    forall a b. a -> (a -> b) -> b
& forall s a. HasH s a => Lens' s a
L.h forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
totalH
    forall a b. a -> (a -> b) -> b
& forall s a. HasW s a => Lens' s a
L.w forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => a -> a -> a
max b
5 -- Empty lines show a small rect to indicate they are there.
  makeRect :: Int -> Int -> Int -> Rect
makeRect Int
cx1 Int
cx2 Int
cy = Double -> Double -> Double -> Double -> Rect
Rect Double
rx Double
ry Double
rw Double
rh where
    rx :: Double
rx = Int -> Int -> Double
glyphPos Int
cx1 Int
cy
    rw :: Double
rw = Int -> Int -> Double
glyphPos Int
cx2 Int
cy forall a. Num a => a -> a -> a
- Double
rx
    ry :: Double
ry = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cy forall a. Num a => a -> a -> a
* Double
totalH forall a. Num a => a -> a -> a
- Double
spaceV
    rh :: Double
rh = Double
totalH
  rects :: [Rect]
rects
    | Int
selY1 forall a. Eq a => a -> a -> Bool
== Int
selY2 = [Int -> Int -> Int -> Rect
makeRect Int
selX1 Int
selX2 Int
selY1]
    | Bool
otherwise = Rect
begin forall a. a -> [a] -> [a]
: [Rect]
middle forall a. [a] -> [a] -> [a]
++ [Rect]
end where
      begin :: Rect
begin = Int -> Int -> Int -> Rect
makeRect Int
selX1 (Int -> Int
lineLen Int
selY1) Int
selY1
      middleLines :: Seq TextLine
middleLines = forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY1 forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Seq a -> Seq a
Seq.take Int
selY2 forall a b. (a -> b) -> a -> b
$ Seq TextLine
textLines
      middle :: [Rect]
middle = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall {b} {b}.
(HasY b Double, HasH b Double, HasW b b, Ord b, Num b) =>
b -> b
updateRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasRect s a => Lens' s a
L.rect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
middleLines)
      end :: [Rect]
end = [Int -> Int -> Int -> Rect
makeRect Int
0 Int
selX2 Int
selY2]

stateFromText
  :: WidgetEnv s e -> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText :: forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
text = TextAreaState
newState where
  style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFontManager s a => Lens' s a
L.fontManager
  newTextMetrics :: TextMetrics
newTextMetrics = forall s e. WidgetEnv s e -> StyleState -> TextMetrics
getTextMetrics WidgetEnv s e
wenv StyleState
style
  tmpTextLines :: Seq TextLine
tmpTextLines = FontManager
-> StyleState -> Double -> TextTrim -> Text -> Seq TextLine
fitTextToWidth FontManager
fontMgr StyleState
style forall a. RealFloat a => a
maxNumericValue TextTrim
KeepSpaces Text
text
  totalH :: Double
totalH = TextMetrics
newTextMetrics forall s a. s -> Getting a s a -> a
^. forall s a. HasLineH s a => Lens' s a
L.lineH forall a. Num a => a -> a -> a
+ Seq TextLine -> Double
getSpaceV Seq TextLine
tmpTextLines
  lastRect :: Rect
lastRect = forall a. Default a => a
def
    forall a b. a -> (a -> b) -> b
& forall s a. HasY s a => Lens' s a
L.y forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
tmpTextLines) forall a. Num a => a -> a -> a
* Double
totalH
    forall a b. a -> (a -> b) -> b
& forall s a. HasH s a => Lens' s a
L.h forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
totalH

  lastTextLine :: TextLine
lastTextLine = forall a. Default a => a
def
    forall a b. a -> (a -> b) -> b
& forall s a. HasRect s a => Lens' s a
L.rect forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
lastRect
    forall a b. a -> (a -> b) -> b
& forall s a. HasSize s a => Lens' s a
L.size forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Double -> Size
Size Double
0 (Rect
lastRect forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h)
  newTextLines :: Seq TextLine
newTextLines
    | Text -> Text -> Bool
T.isSuffixOf Text
"\n" Text
text = Seq TextLine
tmpTextLines forall a. Seq a -> a -> Seq a
|> TextLine
lastTextLine
    | Bool
otherwise = Seq TextLine
tmpTextLines

  newState :: TextAreaState
newState = TextAreaState
state {
    _tasText :: Text
_tasText = Text
text,
    _tasTextMetrics :: TextMetrics
_tasTextMetrics = TextMetrics
newTextMetrics,
    _tasTextStyle :: Maybe TextStyle
_tasTextStyle = StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text,
    _tasTextLines :: Seq TextLine
_tasTextLines = Seq TextLine
newTextLines
  }

textFromState :: Seq TextLine -> Text
textFromState :: Seq TextLine -> Text
textFromState Seq TextLine
textLines = [Text] -> Text
T.unlines [Text]
lines where
  lines :: [Text]
lines = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasText s a => Lens' s a
L.text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines)

addHistory :: TextAreaState -> Bool -> TextAreaState
addHistory :: TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state Bool
False = TextAreaState
state
addHistory TextAreaState
state Bool
_ = TextAreaState
newState where
  text :: Text
text = TextAreaState -> Text
_tasText TextAreaState
state
  curPos :: (Int, Int)
curPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
  selStart :: Maybe (Int, Int)
selStart = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state
  prevStepIdx :: Int
prevStepIdx = TextAreaState -> Int
_tasHistoryIdx TextAreaState
state
  prevSteps :: Seq HistoryStep
prevSteps = TextAreaState -> Seq HistoryStep
_tasHistory TextAreaState
state
  steps :: Seq HistoryStep
steps = forall a. Int -> Seq a -> Seq a
Seq.take Int
prevStepIdx Seq HistoryStep
prevSteps
  newState :: TextAreaState
newState = TextAreaState
state {
    _tasHistory :: Seq HistoryStep
_tasHistory = Seq HistoryStep
steps forall a. Seq a -> a -> Seq a
|> Text -> (Int, Int) -> Maybe (Int, Int) -> HistoryStep
HistoryStep Text
text (Int, Int)
curPos Maybe (Int, Int)
selStart,
    _tasHistoryIdx :: Int
_tasHistoryIdx = Int
prevStepIdx forall a. Num a => a -> a -> a
+ Int
1
  }

restoreHistory
  :: WidgetEnv s e -> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory :: forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Int
idx
  | Int
idx forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
hist Bool -> Bool -> Bool
&& Int
idx forall a. Eq a => a -> a -> Bool
/= Int
histIdx = TextAreaState
newState
  | Bool
otherwise = TextAreaState
state
  where
    hist :: Seq HistoryStep
hist = TextAreaState -> Seq HistoryStep
_tasHistory TextAreaState
state
    histIdx :: Int
histIdx = TextAreaState -> Int
_tasHistoryIdx TextAreaState
state
    HistoryStep Text
text (Int, Int)
curPos Maybe (Int, Int)
selStart = forall a. Seq a -> Int -> a
Seq.index Seq HistoryStep
hist Int
idx
    tmpState :: TextAreaState
tmpState = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
text
    newState :: TextAreaState
newState = TextAreaState
tmpState {
      _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
curPos,
      _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
selStart,
      _tasHistoryIdx :: Int
_tasHistoryIdx = Int
idx
    }

getSelection
  :: TextAreaState
  -> Maybe Text
getSelection :: TextAreaState -> Maybe Text
getSelection TextAreaState
state = Maybe Text
result where
  currPos :: (Int, Int)
currPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
  currSel :: (Int, Int)
currSel = forall a. HasCallStack => Maybe a -> a
fromJust (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state)
  textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
  oldLines :: Seq Text
oldLines = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasText s a => Lens' s a
L.text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines

  ((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
    | forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (Int, Int)
currSel = ((Int, Int)
currPos, (Int, Int)
currSel)
    | Bool
otherwise = ((Int, Int)
currSel, (Int, Int)
currPos)
  newText :: Text
newText
    | Int
selY1 forall a. Eq a => a -> a -> Bool
== Int
selY2 = Text
singleLine
    | Int
selX2 forall a. Eq a => a -> a -> Bool
== Int
0 = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Text
begin forall a. a -> Seq a -> Seq a
:<| Seq Text
middle
    | Bool
otherwise = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Text
begin forall a. a -> Seq a -> Seq a
:<| (Seq Text
middle forall a. Seq a -> a -> Seq a
:|> Text
end)
    where
      singleLine :: Text
singleLine = Int -> Text -> Text
T.drop Int
selX1 forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
selX2 (forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1)
      begin :: Text
begin = Int -> Text -> Text
T.drop Int
selX1 forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1
      middle :: Seq Text
middle = forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY1 forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
Seq.take Int
selY2 Seq Text
oldLines
      end :: Text
end = Int -> Text -> Text
T.take Int
selX2 forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY2
  result :: Maybe Text
result
    | forall a. Maybe a -> Bool
isJust (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state) = forall a. a -> Maybe a
Just Text
newText
    | Bool
otherwise = forall a. Maybe a
Nothing

replaceText
  :: TextAreaState
  -> Maybe (Int, Int)
  -> Text
  -> (Text, (Int, Int), Maybe (Int, Int))
replaceText :: TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
currSel Text
newTxt
  | forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
currSel = Seq TextLine
-> (Int, Int)
-> (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection Seq TextLine
lines (Int, Int)
currPos (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
currSel) Text
newTxt
  | Bool
otherwise = Seq TextLine
-> (Int, Int)
-> (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection Seq TextLine
lines (Int, Int)
currPos (Int, Int)
currPos Text
newTxt
  where
    currPos :: (Int, Int)
currPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
    lines :: Seq TextLine
lines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state

replaceSelection
  :: Seq TextLine
  -> (Int, Int)
  -> (Int, Int)
  -> Text
  -> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection :: Seq TextLine
-> (Int, Int)
-> (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection Seq TextLine
textLines (Int, Int)
currPos (Int, Int)
currSel Text
addText = forall {a}. (Text, (Int, Int), Maybe a)
result where
  oldLines :: Seq Text
oldLines = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasText s a => Lens' s a
L.text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines
  ((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
    | forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (Int, Int)
currSel = ((Int, Int)
currPos, (Int, Int)
currSel)
    | Bool
otherwise = ((Int, Int)
currSel, (Int, Int)
currPos)
  prevLines :: Seq Text
prevLines = forall a. Int -> Seq a -> Seq a
Seq.take Int
selY1 Seq Text
oldLines
  postLines :: Seq Text
postLines = forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY2 forall a. Num a => a -> a -> a
+ Int
1) Seq Text
oldLines
  returnAdded :: Bool
returnAdded = Text -> Text -> Bool
T.isSuffixOf Text
"\n" Text
addText

  linePre :: Text
linePre
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
oldLines forall a. Ord a => a -> a -> Bool
> Int
selY1 = Int -> Text -> Text
T.take Int
selX1 (forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1)
    | Bool
otherwise = Text
""
  lineSuf :: Text
lineSuf
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
oldLines forall a. Ord a => a -> a -> Bool
> Int
selY2 = Int -> Text -> Text
T.drop Int
selX2 (forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY2)
    | Bool
otherwise = Text
""
  addLines :: Seq Text
addLines
    | Bool -> Bool
not Bool
returnAdded = forall a. [a] -> Seq a
Seq.fromList (Text -> [Text]
T.lines Text
addText)
    | Bool
otherwise = forall a. [a] -> Seq a
Seq.fromList (Text -> [Text]
T.lines Text
addText) forall a. Seq a -> a -> Seq a
:|> Text
""

  (Int
newX, Int
newY, Seq Text
midLines)
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Ord a => a -> a -> Bool
<= Int
1 = (Text -> Int
T.length (Text
linePre forall a. Semigroup a => a -> a -> a
<> Text
addText), Int
selY1, Seq Text
singleLine)
    | Bool
otherwise = (Text -> Int
T.length Text
end, Int
selY1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Num a => a -> a -> a
- Int
1, Seq Text
multiline)
    where
      singleLine :: Seq Text
singleLine = forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Text
linePre forall a. Semigroup a => a -> a -> a
<> Text
addText forall a. Semigroup a => a -> a -> a
<> Text
lineSuf
      begin :: Text
begin = forall a. Seq a -> Int -> a
Seq.index Seq Text
addLines Int
0
      middle :: Seq Text
middle = forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
Seq.take (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Num a => a -> a -> a
- Int
1) Seq Text
addLines
      end :: Text
end = forall a. Seq a -> Int -> a
Seq.index Seq Text
addLines (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Num a => a -> a -> a
- Int
1)
      multiline :: Seq Text
multiline = (Text
linePre forall a. Semigroup a => a -> a -> a
<> Text
begin) forall a. a -> Seq a -> Seq a
:<| (Seq Text
middle forall a. Seq a -> a -> Seq a
:|> (Text
end forall a. Semigroup a => a -> a -> a
<> Text
lineSuf))

  newLines :: Seq Text
newLines = Seq Text
prevLines forall a. Semigroup a => a -> a -> a
<> Seq Text
midLines forall a. Semigroup a => a -> a -> a
<> Seq Text
postLines
  newText :: Text
newText = Int -> Text -> Text
T.dropEnd Int
1 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Text
newLines)
  result :: (Text, (Int, Int), Maybe a)
result = (Text
newText, (Int
newX, Int
newY), forall a. Maybe a
Nothing)

findClosestGlyphPos :: TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos :: TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state Point
point = (Int
newPos, Int
lineIdx) where
  Point Double
x Double
y = Point
point
  TextMetrics Double
_ Double
_ Double
lineh Double
_ = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
  textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state

  totalH :: Double
totalH = Double
lineh forall a. Num a => a -> a -> a
+ Seq TextLine -> Double
getSpaceV Seq TextLine
textLines
  lineIdx :: Int
lineIdx = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Num a => a -> a -> a
- Int
1) (forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
y forall a. Fractional a => a -> a -> a
/ Double
totalH))
  lineGlyphs :: Seq GlyphPos
lineGlyphs
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq TextLine
textLines = forall a. Seq a
Seq.empty
    | Bool
otherwise = forall a. Seq a -> Int -> a
Seq.index (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasGlyphs s a => Lens' s a
L.glyphs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines) Int
lineIdx
  textLen :: Double
textLen = Seq GlyphPos -> Double
getGlyphsMax Seq GlyphPos
lineGlyphs

  glyphs :: Seq GlyphPos
glyphs
    | forall a. Seq a -> Bool
Seq.null Seq GlyphPos
lineGlyphs = forall a. Seq a
Seq.empty
    | Bool
otherwise = Seq GlyphPos
lineGlyphs forall a. Seq a -> a -> Seq a
|> Char
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> GlyphPos
GlyphPos Char
' ' Double
0 Double
textLen Double
0 Double
0 Double
0 Double
0 Double
0
  glyphStart :: a -> GlyphPos -> (a, Double)
glyphStart a
i GlyphPos
g = (a
i, forall a. Num a => a -> a
abs (GlyphPos -> Double
_glpXMin GlyphPos
g forall a. Num a => a -> a -> a
- Double
x))

  pairs :: Seq (Int, Double)
pairs = forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex forall {a}. a -> GlyphPos -> (a, Double)
glyphStart Seq GlyphPos
glyphs
  cpm :: (a, a) -> (a, a) -> Ordering
cpm (a
_, a
g1) (a
_, a
g2) = forall a. Ord a => a -> a -> Ordering
compare a
g1 a
g2
  diffs :: Seq (Int, Double)
diffs = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cpm Seq (Int, Double)
pairs
  newPos :: Int
newPos = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a b. (a, b) -> a
fst (forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq (Int, Double)
diffs)

getSpaceV :: Seq TextLine -> Double
getSpaceV :: Seq TextLine -> Double
getSpaceV Seq TextLine
textLines = Double
spaceV where
  spaceV :: Double
spaceV = FontSpace -> Double
unFontSpace forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Default a => a
def (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasFontSpaceV s a => Lens' s a
L.fontSpaceV) (Seq TextLine
textLines forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0)

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