{-|
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'.
-}
{-# 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_
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (^?), (.~), (%~), (<>~), ALens', ix, view)
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 :: Int
defCaretMs :: Int
defCaretMs = Int
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.
- '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 {
  TextAreaCfg s e -> Maybe Double
_tacCaretWidth :: Maybe Double,
  TextAreaCfg s e -> Maybe Int
_tacCaretMs :: Maybe Int,
  TextAreaCfg s e -> Maybe Int
_tacMaxLength :: Maybe Int,
  TextAreaCfg s e -> Maybe Int
_tacMaxLines :: Maybe Int,
  TextAreaCfg s e -> Maybe Bool
_tacAcceptTab :: Maybe Bool,
  TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus :: Maybe Bool,
  TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq :: [Path -> WidgetRequest s e],
  TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq :: [Path -> WidgetRequest 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 :: forall s e.
Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [Text -> WidgetRequest s e]
-> TextAreaCfg s e
TextAreaCfg {
    _tacCaretWidth :: Maybe Double
_tacCaretWidth = Maybe Double
forall a. Maybe a
Nothing,
    _tacCaretMs :: Maybe Int
_tacCaretMs = Maybe Int
forall a. Maybe a
Nothing,
    _tacMaxLength :: Maybe Int
_tacMaxLength = Maybe Int
forall a. Maybe a
Nothing,
    _tacMaxLines :: Maybe Int
_tacMaxLines = Maybe Int
forall a. Maybe a
Nothing,
    _tacAcceptTab :: Maybe Bool
_tacAcceptTab = Maybe Bool
forall a. Maybe a
Nothing,
    _tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = Maybe Bool
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 :: forall s e.
Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [Text -> WidgetRequest s e]
-> TextAreaCfg s e
TextAreaCfg {
    _tacCaretWidth :: Maybe Double
_tacCaretWidth = TextAreaCfg s e -> Maybe Double
forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextAreaCfg s e -> Maybe Double
forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
t1,
    _tacCaretMs :: Maybe Int
_tacCaretMs = TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacCaretMs TextAreaCfg s e
t2 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacCaretMs TextAreaCfg s e
t1,
    _tacMaxLength :: Maybe Int
_tacMaxLength = TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
t2 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
t1,
    _tacMaxLines :: Maybe Int
_tacMaxLines = TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
t2 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
t1,
    _tacAcceptTab :: Maybe Bool
_tacAcceptTab = TextAreaCfg s e -> Maybe Bool
forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextAreaCfg s e -> Maybe Bool
forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
t1,
    _tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = TextAreaCfg s e -> Maybe Bool
forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextAreaCfg s e -> Maybe Bool
forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
t1,
    _tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = TextAreaCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> TextAreaCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
t2,
    _tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = TextAreaCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> TextAreaCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
t2,
    _tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = TextAreaCfg s e -> [Text -> WidgetRequest s e]
forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
t1 [Text -> WidgetRequest s e]
-> [Text -> WidgetRequest s e] -> [Text -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> TextAreaCfg s e -> [Text -> WidgetRequest s e]
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 = TextAreaCfg s e
forall a. Default a => a
def

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

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

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

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

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

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

instance WidgetEvent e => CmbOnFocus (TextAreaCfg s e) e Path where
  onFocus :: (Path -> e) -> TextAreaCfg s e
onFocus Path -> e
fn = TextAreaCfg s e
forall a. Default a => a
def {
    _tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
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 = TextAreaCfg s e
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 = TextAreaCfg s e
forall a. Default a => a
def {
    _tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
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 = TextAreaCfg s e
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 = TextAreaCfg s e
forall a. Default a => a
def {
    _tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Text -> e) -> Text -> WidgetRequest s e
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 = TextAreaCfg s e
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
(HistoryStep -> HistoryStep -> Bool)
-> (HistoryStep -> HistoryStep -> Bool) -> Eq HistoryStep
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
(Int -> HistoryStep -> ShowS)
-> (HistoryStep -> String)
-> ([HistoryStep] -> ShowS)
-> Show HistoryStep
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. HistoryStep -> Rep HistoryStep x)
-> (forall x. Rep HistoryStep x -> HistoryStep)
-> Generic HistoryStep
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 -> Int
_tasFocusStart :: Int
} deriving (TextAreaState -> TextAreaState -> Bool
(TextAreaState -> TextAreaState -> Bool)
-> (TextAreaState -> TextAreaState -> Bool) -> Eq TextAreaState
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
(Int -> TextAreaState -> ShowS)
-> (TextAreaState -> String)
-> ([TextAreaState] -> ShowS)
-> Show TextAreaState
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. TextAreaState -> Rep TextAreaState x)
-> (forall x. Rep TextAreaState x -> TextAreaState)
-> Generic TextAreaState
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 :: Text
-> TextMetrics
-> Maybe TextStyle
-> (Int, Int)
-> Maybe (Int, Int)
-> Seq TextLine
-> Seq HistoryStep
-> Int
-> Int
-> TextAreaState
TextAreaState {
    _tasText :: Text
_tasText = Text
"",
    _tasTextMetrics :: TextMetrics
_tasTextMetrics = TextMetrics
forall a. Default a => a
def,
    _tasTextStyle :: Maybe TextStyle
_tasTextStyle = Maybe TextStyle
forall a. Default a => a
def,
    _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
forall a. Default a => a
def,
    _tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
forall a. Default a => a
def,
    _tasTextLines :: Seq TextLine
_tasTextLines = Seq TextLine
forall a. Seq a
Seq.empty,
    _tasHistory :: Seq HistoryStep
_tasHistory = Seq HistoryStep
forall a. Seq a
Seq.empty,
    _tasHistoryIdx :: Int
_tasHistoryIdx = Int
0,
    _tasFocusStart :: Int
_tasFocusStart = Int
0
  }

-- | Creates a text area using the given lens.
textArea :: WidgetEvent e => ALens' s Text -> WidgetNode s e
textArea :: ALens' s Text -> WidgetNode s e
textArea ALens' s Text
field = ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ ALens' s Text
field [TextAreaCfg s e]
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_ :: ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ ALens' s Text
field [TextAreaCfg s e]
configs = WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
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 = ALens' s Text -> WidgetData s Text
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 :: Text -> (Text -> e) -> WidgetNode s e
textAreaV Text
value Text -> e
handler = Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ Text
value Text -> e
handler [TextAreaCfg s e]
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_ :: Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ Text
value Text -> e
handler [TextAreaCfg s e]
configs = WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
textAreaD_ WidgetData s Text
forall s. WidgetData s Text
wdata [TextAreaCfg s e]
newConfig where
  wdata :: WidgetData s Text
wdata = Text -> WidgetData s Text
forall s a. a -> WidgetData s a
WidgetValue Text
value
  newConfig :: [TextAreaCfg s e]
newConfig = (Text -> e) -> TextAreaCfg s e
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Text -> e
handler TextAreaCfg s e -> [TextAreaCfg s e] -> [TextAreaCfg s e]
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_ :: 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 = [TextAreaCfg s e] -> TextAreaCfg s e
forall a. Monoid a => [a] -> a
mconcat [TextAreaCfg s e]
configs
  widget :: Widget s e
widget = WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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
forall a. Default a => a
def
  node :: WidgetNode s e
node = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"textArea" Widget s e
widget
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
  scrollCfg :: [ScrollCfg s e]
scrollCfg = [ALens' ThemeState StyleState -> ScrollCfg s e
forall s e. ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle ALens' ThemeState StyleState
forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle, (WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
forall s e.
(WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle WidgetEnv s e -> Style -> (Style, Style)
forall s e. WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault]
  scrollNode :: WidgetNode s e
scrollNode = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [ScrollCfg s e]
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 :: 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 = TextAreaState -> Single s e TextAreaState -> Widget s e
forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle TextAreaState
state Single s e Any
forall a. Default a => a
def {
    singleInit :: SingleInitHandler s e
singleInit = SingleInitHandler s e
init,
    singleMerge :: SingleMergeHandler s e TextAreaState
singleMerge = SingleMergeHandler s e TextAreaState
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> TextAreaState -> WidgetResult s e
merge,
    singleDispose :: SingleInitHandler s e
singleDispose = SingleInitHandler s e
forall p s e. p -> WidgetNode s e -> WidgetResult s e
dispose,
    singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = SingleEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = SingleGetSizeReqHandler s e
forall a b p p. (CmbMinWidth a, CmbMinHeight b) => p -> p -> (a, b)
getSizeReq,
    singleRender :: SingleRenderHandler s e
singleRender = SingleRenderHandler s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
  }

  !caretMs :: Int
caretMs = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defCaretMs (TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacCaretMs TextAreaCfg s e
config)
  !maxLength :: Maybe Int
maxLength = TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
config
  !maxLines :: Maybe Int
maxLines = TextAreaCfg s e -> Maybe Int
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
config
  getModelValue :: WidgetEnv s e -> Text
getModelValue !WidgetEnv s e
wenv = s -> WidgetData s Text -> Text
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound Maybe Int
maxLength
    validLines :: Bool
validLines = Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
lines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound Maybe Int
maxLines
  line :: Int -> Text
line !Int
idx
    | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines = Seq TextLine -> Int -> TextLine
forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx TextLine -> Getting Text TextLine Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextLine Text
forall s a. HasText s a => Lens' s a
L.text
    | Bool
otherwise = Text
""
  !lineLen :: Int -> Int
lineLen = Text -> Int
T.length (Text -> Int) -> (Int -> Text) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
line
  !totalLines :: Int
totalLines = Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines
  !lastPos :: (Int, Int)
lastPos = (Int -> Int
lineLen (Int
totalLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1), Int
totalLines)

  init :: SingleInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    text :: Text
text = WidgetEnv s e -> Text
forall e. WidgetEnv s e -> Text
getModelValue WidgetEnv s e
wenv
    newState :: TextAreaState
newState = WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
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
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetNode s e -> WidgetResult s e
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 = WidgetEnv s e -> Text
forall e. WidgetEnv s e -> Text
getModelValue WidgetEnv s e
wenv
    newState :: TextAreaState
newState
      | Text
oldText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newText = WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
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
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    reqs :: [WidgetRequest s e]
reqs = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId]

  handleKeyPress :: WidgetEnv s e
-> KeyMod -> KeyCode -> Maybe (Text, (Int, Int), Maybe (Int, Int))
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code
    | Bool
isDelBackWordNoSel = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just (Text, (Int, Int), Maybe (Int, Int))
removeWordL
    | Bool
isDelBackWord = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
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 = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just (Text, (Int, Int), Maybe (Int, Int))
removeCharL
    | Bool
isBackspace = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
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 = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
tpY) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveRight = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
tpY) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveUp = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveDown = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMovePageUp = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vpLines) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMovePageDown = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vpLines) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveWordL = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
prevWordPos Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveWordR = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
nextWordPos Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveLineL = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
tpY) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveLineR = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int -> Int
lineLen Int
tpY, Int
tpY) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveFullUp = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isMoveFullDn = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
lastPos Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isSelectAll = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
lastPos)
    | Bool
isSelectLeft = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
tpY) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectRight = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
tpY) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectUp = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectDown = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectPageUp = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vpLines) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectPageDown = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vpLines) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectWordL = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
prevWordPos ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectWordR = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
nextWordPos ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectLineL = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
tpY) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectLineR = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int -> Int
lineLen Int
tpY, Int
tpY) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectFullUp = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isSelectFullDn = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
lastPos ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
tp)
    | Bool
isDeselectLeft = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
minTpSel Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isDeselectRight = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
maxTpSel Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isDeselectUp = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
minTpSel Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
isDeselectDown = (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a. a -> Maybe a
Just ((Text, (Int, Int), Maybe (Int, Int))
 -> Maybe (Text, (Int, Int), Maybe (Int, Int)))
-> (Text, (Int, Int), Maybe (Int, Int))
-> Maybe (Text, (Int, Int), Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text
-> (Int, Int)
-> Maybe (Int, Int)
-> (Text, (Int, Int), Maybe (Int, Int))
forall a.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
maxTpSel Maybe (Int, Int)
forall a. Maybe a
Nothing
    | Bool
otherwise = Maybe (Text, (Int, Int), Maybe (Int, Int))
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)
        | (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap (Int, Int)
tp (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart) = ((Int, Int)
tp, Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart)
        | Bool
otherwise = (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart, (Int, Int)
tp)
      emptySel :: Bool
emptySel = Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Int, Int)
selStart
      vpLines :: Int
vpLines = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (WidgetEnv s e
wenv WidgetEnv s e -> Getting Double (WidgetEnv s e) Double -> Double
forall s a. s -> Getting a s a -> a
^. (Rect -> Const Double Rect)
-> WidgetEnv s e -> Const Double (WidgetEnv s e)
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Const Double Rect)
 -> WidgetEnv s e -> Const Double (WidgetEnv s e))
-> ((Double -> Const Double Double) -> Rect -> Const Double Rect)
-> Getting Double (WidgetEnv s e) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double) -> Rect -> Const Double Rect
forall s a. HasH s a => Lens' s a
L.h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ TextMetrics
textMetrics TextMetrics -> Getting Double TextMetrics Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double TextMetrics Double
forall s a. HasLineH s a => Lens' s a
L.lineH)
      activeSel :: Bool
activeSel = Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart

      prevTxt :: Text
prevTxt
        | Int
tpX Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      prevWordStart :: Text
prevWordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
delim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
prevTxt
      prevWordPos :: (Int, Int)
prevWordPos
        | Int
tpX Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
tpY Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
tpX, Int
tpY)
        | Int
tpX Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

      nextTxt :: Text
nextTxt
        | Int
tpX Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      nextWordEnd :: Text
nextWordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
delim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
nextTxt
      nextWordPos :: (Int, Int)
nextWordPos
        | Int
tpX Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
lineLen Int
tpY Bool -> Bool -> Bool
&& Int
tpY Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = (Int
tpX, Int
tpY)
        | Int
tpX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
lineLen Int
tpY = (Int -> Int
lineLen Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd, Int
tpY)
        | Bool
otherwise = (Int -> Int
lineLen (Int
tpY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd, Int
tpY Int -> Int -> Int
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
        | WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
      isLineMod :: Bool
isLineMod
        | WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod Bool -> Bool -> Bool
|| KeyMod -> Bool
_kmLeftGUI KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
      isAllMod :: Bool
isAllMod
        | WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftGUI KeyMod
mod
        | Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod

      isBackspace :: Bool
isBackspace = KeyCode -> Bool
isKeyBackspace KeyCode
code
      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 ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just ((Int, Int) -> Maybe (Int, Int)) -> (Int, Int) -> Maybe (Int, Int)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int
tpX Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1), Int
tpY Int -> Int -> Int
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
        | Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart Bool -> Bool -> Bool
&& Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Int, Int)
newSel = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
forall a. Maybe a
Nothing)
        | Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart Bool -> Bool -> Bool
&& (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
fixedPos Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
selStart = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
forall a. Maybe a
Nothing)
        | Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
selStart)
        | (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
fixedPos Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
fixedSel = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
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 = ((Int, Int) -> (Int, Int)) -> Maybe (Int, Int) -> Maybe (Int, Int)
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 = Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines
        vcY :: Int
vcY = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
nlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
cY
        vcX :: Int
vcX = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int
lineLen Int
tpY) Int
cX
        ncX :: Int
ncX = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int
lineLen Int
vcY) Int
cX
        sameX :: Bool
sameX = Int
vcX Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tpX
        sameY :: Bool
sameY = Int
vcY Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tpY
        result :: (Int, Int)
result
          | Bool
sameY Bool -> Bool -> Bool
&& Int
cX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
vcY Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
0, Int
0)
          | Bool
sameY Bool -> Bool -> Bool
&& Int
cX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
vcY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Int -> Int
lineLen (Int
vcY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cX Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
vcY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          | Bool
sameY Bool -> Bool -> Bool
&& Int
cX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
lineLen Int
vcY Bool -> Bool -> Bool
&& Int
vcY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = (Int
cX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
lineLen Int
vcY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
vcY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
sameX Bool -> Bool -> Bool
&& Int
cX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
lineLen Int
vcY = (Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        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 = Maybe (Int, Int)
forall a. Maybe a
Nothing
        }
        newNode :: WidgetNode s e
newNode = WidgetNode s e
node
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]

    -- Select word if clicked twice in a row
    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks Int -> Int -> Bool
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 = Seq TextLine -> Int -> TextLine
forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
ty TextLine -> Getting Text TextLine Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextLine Text
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 (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part1
        wordStartIdx :: Int
wordStartIdx = Text -> Int
T.length Text
wordStart
        wordEnd :: Text
wordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part2
        wordEndIdx :: Int
wordEndIdx = Int
txtLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
wordEnd
        newPos :: (Int, Int)
newPos = (Int
wordStartIdx, Int
ty)
        newSel :: Maybe (Int, Int)
newSel = (Int, Int) -> Maybe (Int, Int)
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
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
totalLines = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce])
          | Bool
otherwise = Maybe (WidgetResult s e)
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 Int -> Int -> Bool
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 = Seq TextLine -> Int -> TextLine
forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
ty TextLine
-> Getting (Seq GlyphPos) TextLine (Seq GlyphPos) -> Seq GlyphPos
forall s a. s -> Getting a s a -> a
^. Getting (Seq GlyphPos) TextLine (Seq GlyphPos)
forall s a. HasGlyphs s a => Lens' s a
L.glyphs
        newPos :: (Int, Int)
newPos = (Int
0, Int
ty)
        newSel :: Maybe (Int, Int)
newSel = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Seq GlyphPos -> Int
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
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
totalLines = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce])
          | Bool
otherwise = Maybe (WidgetResult s e)
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 -> Maybe (WidgetResult s e)
result where
        glyphs :: Seq GlyphPos
glyphs = Seq TextLine -> Int -> TextLine
forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines (Int
totalLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TextLine
-> Getting (Seq GlyphPos) TextLine (Seq GlyphPos) -> Seq GlyphPos
forall s a. s -> Getting a s a -> a
^. Getting (Seq GlyphPos) TextLine (Seq GlyphPos)
forall s a. HasGlyphs s a => Lens' s a
L.glyphs
        newPos :: (Int, Int)
newPos = (Int
0, Int
0)
        newSel :: Maybe (Int, Int)
newSel = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Seq GlyphPos -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs, Int
totalLines Int -> Int -> Int
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
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce])
          | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    Move Point
point
      | WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
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 Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int, Int) -> Maybe (Int, Int)
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 = WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
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
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce WidgetRequest s e -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. a -> [a] -> [a]
: [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReq)

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

        resultCopy :: WidgetResult s e
resultCopy = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
clipboardReq]
        resultPaste :: WidgetResult s e
resultPaste = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
GetClipboard WidgetId
widgetId]
        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
""
          WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. a -> Seq a
Seq.singleton WidgetRequest s e
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
"    "
          WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. a -> Seq a
Seq.singleton WidgetRequest s e
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq HistoryStep -> Int
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 = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Seq HistoryStep -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
history) (Int
historyIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
steps)
          newState :: TextAreaState
newState = WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
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
            WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newText)
          newState :: TextAreaState
newState = (WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
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
            WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
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 -> WidgetResult s e -> Maybe (WidgetResult s e)
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) -> WidgetResult s e -> Maybe (WidgetResult s e)
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 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
      selectOnFocus :: Bool
selectOnFocus = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (TextAreaCfg s e -> Maybe Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = TextAreaState
state {
            _tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
lastPos,
            _tasSelStart :: Maybe (Int, Int)
_tasSelStart = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
0, Int
0)
          }
        | Bool
otherwise = TextAreaState
state
      newState :: TextAreaState
newState = TextAreaState
tmpState {
        _tasFocusStart :: Int
_tasFocusStart = WidgetEnv s e
wenv WidgetEnv s e -> Getting Int (WidgetEnv s e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (WidgetEnv s e) Int
forall s a. HasTimestamp s a => Lens' s a
L.timestamp
      }
      reqs :: [WidgetRequest s e]
reqs = [WidgetId -> Int -> Maybe Int -> WidgetRequest s e
forall s e. WidgetId -> Int -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Int
caretMs Maybe Int
forall a. Maybe a
Nothing, Rect -> WidgetRequest s e
forall s e. Rect -> WidgetRequest s e
StartTextInput Rect
viewport]
      newNode :: WidgetNode s e
newNode = WidgetNode s e
node
        WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs
      focusRs :: Maybe (WidgetResult s e)
focusRs = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
newNode Path
prev (TextAreaCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
config)
      result :: WidgetResult s e
result = WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e)
-> Maybe (WidgetResult s e)
-> WidgetResult s e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult WidgetResult s e -> WidgetResult s e -> WidgetResult s e
forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
focusRs

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

    where
      widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      viewport :: Rect
viewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
      style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      Rect Double
cx Double
cy Double
cw Double
ch = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newText)
    newState :: TextAreaState
newState = (WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
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
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
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 = WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
newReqs
      | Bool
otherwise = WidgetNode s e -> WidgetResult s e
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 [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqScroll where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
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 = WidgetData s Text -> Text -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s Text
wdata Text
newText
    reqOnChange :: [WidgetRequest s e]
reqOnChange = ((Text -> WidgetRequest s e) -> WidgetRequest s e)
-> [Text -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> WidgetRequest s e) -> Text -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Text
newText) (TextAreaCfg s e -> [Text -> WidgetRequest s e]
forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
config)
    reqResize :: [WidgetRequest s e]
reqResize = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgetsImmediate WidgetId
widgetId]
    reqScroll :: [WidgetRequest s e]
reqScroll = WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newText = [WidgetRequest s e]
forall e. [WidgetRequest s e]
reqUpdate [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
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 = [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReq where
    style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    scPath :: Path
scPath = WidgetNode s e -> Path
forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
node
    scWid :: Maybe WidgetId
scWid = WidgetEnv s e -> Path -> Maybe WidgetId
forall s e. WidgetEnv s e -> Path -> Maybe WidgetId
findWidgetIdFromPath WidgetEnv s e
wenv Path
scPath
    contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
    offset :: Point
offset = Double -> Double -> Point
Point (Rect
contentArea Rect
-> ((Double -> Const Double Double) -> Rect -> Const Double Rect)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double) -> Rect -> Const Double Rect
forall s a. HasX s a => Lens' s a
L.x) (Rect
contentArea Rect
-> ((Double -> Const Double Double) -> Rect -> Const Double Rect)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double) -> Rect -> Const Double Rect
forall s a. HasY s a => Lens' s a
L.y)
    caretRect :: Rect
caretRect = TextAreaCfg s e -> TextAreaState -> Bool -> Rect
forall s e. TextAreaCfg s e -> TextAreaState -> Bool -> Rect
getCaretRect TextAreaCfg s e
config TextAreaState
newState Bool
True
    -- Padding/border added to show left/top borders when moving near them
    scrollRect :: Rect
scrollRect = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
caretRect (StyleState -> Rect -> Maybe Rect
addOuterBounds StyleState
style Rect
caretRect)
    scrollMsg :: ScrollMessage
scrollMsg = Rect -> ScrollMessage
ScrollTo (Rect -> ScrollMessage) -> Rect -> ScrollMessage
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 WidgetEnv s e -> Getting Rect (WidgetEnv s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. Getting Rect (WidgetEnv s e) Rect
forall s a. HasViewport s a => Lens' s a
L.viewport) Bool -> Bool -> Bool
|| Maybe WidgetId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe WidgetId
scWid = []
      | Bool
otherwise = [WidgetId -> ScrollMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage (Maybe WidgetId -> WidgetId
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 = (Double -> a
forall t. CmbMinWidth t => Double -> t
minWidth (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
100 Double
w), Double -> b
forall t. CmbMinHeight t => Double -> t
minHeight (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
20 (Double
h Double -> Double -> Double
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
selRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Rect] -> (Rect -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Rect]
selRects ((Rect -> IO ()) -> IO ()) -> (Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Rect
rect ->
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Rect
rect Rect
-> ((Double -> Const Double Double) -> Rect -> Const Double Rect)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double) -> Rect -> Const Double Rect
forall s a. HasW s a => Lens' s a
L.w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
rect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
selColor) Maybe Radius
forall a. Maybe a
Nothing

      Seq TextLine -> (TextLine -> IO ()) -> IO ()
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)

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

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

      selRequired :: Bool
selRequired = Maybe (Int, Int) -> Bool
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 -> Bool -> Rect
getCaretRect :: TextAreaCfg s e -> TextAreaState -> Bool -> Rect
getCaretRect TextAreaCfg s e
config TextAreaState
state Bool
addSpcV = Rect
caretRect where
  caretW :: Double
caretW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (TextAreaCfg s e -> Maybe Double
forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
config)
  (Int
cursorX, Int
cursorY) = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
  TextMetrics Double
_ Double
_ Double
lineh Double
_ = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
  textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state

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

  Rect Double
tx Double
ty Double
_ Double
_ = Rect
lineRect
  totalH :: Double
totalH
    | Bool
addSpcV = Double
lineh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FontSpace -> Double
unFontSpace FontSpace
spaceV
    | Bool
otherwise = Double
lineh

  caretPos :: Double
caretPos
    | Int
cursorX Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
cursorX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Seq GlyphPos -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = Double
0
    | Int
cursorX Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq GlyphPos -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = GlyphPos -> Double
_glpXMax (Seq GlyphPos -> Int -> GlyphPos
forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs (Int
cursorX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
    | Bool
otherwise = GlyphPos -> Double
_glpXMin (Seq GlyphPos -> Int -> GlyphPos
forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs Int
cursorX)
  caretX :: Double
caretX = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
caretPos)
  caretY :: Double
caretY
    | Int
cursorY Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cursorY Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalH
    | Bool
otherwise = Double
ty
  caretRect :: Rect
caretRect = Double -> Double -> Double -> Double -> Rect
Rect Double
caretX Double
caretY Double
caretW Double
totalH

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 = (Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int, Int)
forall a. Default a => a
def (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state)
  TextMetrics Double
_ Double
_ 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
    | Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
idx = Seq TextLine -> Int -> TextLine
forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx TextLine -> Getting Text TextLine Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextLine Text
forall s a. HasText s a => Lens' s a
L.text
    | Bool
otherwise = Text
""
  lineLen :: Int -> Int
lineLen = Text -> Int
T.length (Text -> Int) -> (Int -> Text) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
line

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

  ((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
    | (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int) -> (Int, Int)
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)

  updateRect :: b -> b
updateRect b
rect = b
rect
    b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> b -> Identity b
forall s a. HasH s a => Lens' s a
L.h ((Double -> Identity Double) -> b -> Identity b)
-> Double -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
lineh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
spaceV
    b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
forall s a. HasW s a => Lens' s a
L.w ((a -> Identity a) -> b -> Identity b) -> (a -> a) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> a -> a
forall a. Ord a => a -> a -> a
max a
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rx
    ry :: Double
ry = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
lineh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
spaceV)
    rh :: Double
rh = Double
lineh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
spaceV
  rects :: [Rect]
rects
    | Int
selY1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
selY2 = [Int -> Int -> Int -> Rect
makeRect Int
selX1 Int
selX2 Int
selY1]
    | Bool
otherwise = Rect
begin Rect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
: [Rect]
middle [Rect] -> [Rect] -> [Rect]
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 = Int -> Seq TextLine -> Seq TextLine
forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Seq TextLine -> Seq TextLine)
-> (Seq TextLine -> Seq TextLine) -> Seq TextLine -> Seq TextLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq TextLine -> Seq TextLine
forall a. Int -> Seq a -> Seq a
Seq.take Int
selY2 (Seq TextLine -> Seq TextLine) -> Seq TextLine -> Seq TextLine
forall a b. (a -> b) -> a -> b
$ Seq TextLine
textLines
      middle :: [Rect]
middle = Seq Rect -> [Rect]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Rect -> Rect
forall b a. (HasH b Double, HasW b a, Ord a, Num a) => b -> b
updateRect (Rect -> Rect) -> (TextLine -> Rect) -> TextLine -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Rect TextLine Rect -> TextLine -> Rect
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Rect TextLine Rect
forall s a. HasRect s a => Lens' s a
L.rect (TextLine -> Rect) -> Seq TextLine -> Seq 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 :: 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 = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
L.fontManager
  newTextMetrics :: TextMetrics
newTextMetrics = WidgetEnv s e -> StyleState -> TextMetrics
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 Double
forall a. RealFloat a => a
maxNumericValue TextTrim
KeepSpaces Text
text
  totalH :: Double
totalH = TextMetrics
newTextMetrics TextMetrics -> Getting Double TextMetrics Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double TextMetrics Double
forall s a. HasLineH s a => Lens' s a
L.lineH Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Seq TextLine -> Double
getSpaceV Seq TextLine
tmpTextLines
  lastRect :: Rect
lastRect = Rect
forall a. Default a => a
def
    Rect -> (Rect -> Rect) -> Rect
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> Rect -> Identity Rect
forall s a. HasY s a => Lens' s a
L.y ((Double -> Identity Double) -> Rect -> Identity Rect)
-> Double -> Rect -> Rect
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
tmpTextLines) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalH
    Rect -> (Rect -> Rect) -> Rect
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> Rect -> Identity Rect
forall s a. HasH s a => Lens' s a
L.h ((Double -> Identity Double) -> Rect -> Identity Rect)
-> Double -> Rect -> Rect
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
totalH

  lastTextLine :: TextLine
lastTextLine = TextLine
forall a. Default a => a
def
    TextLine -> (TextLine -> TextLine) -> TextLine
forall a b. a -> (a -> b) -> b
& (Rect -> Identity Rect) -> TextLine -> Identity TextLine
forall s a. HasRect s a => Lens' s a
L.rect ((Rect -> Identity Rect) -> TextLine -> Identity TextLine)
-> Rect -> TextLine -> TextLine
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
lastRect
    TextLine -> (TextLine -> TextLine) -> TextLine
forall a b. a -> (a -> b) -> b
& (Size -> Identity Size) -> TextLine -> Identity TextLine
forall s a. HasSize s a => Lens' s a
L.size ((Size -> Identity Size) -> TextLine -> Identity TextLine)
-> Size -> TextLine -> TextLine
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Double -> Size
Size Double
0 (Rect
lastRect Rect
-> ((Double -> Const Double Double) -> Rect -> Const Double Rect)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double) -> Rect -> Const Double Rect
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 Seq TextLine -> TextLine -> Seq TextLine
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 StyleState
-> Getting (Maybe TextStyle) StyleState (Maybe TextStyle)
-> Maybe TextStyle
forall s a. s -> Getting a s a -> a
^. Getting (Maybe TextStyle) StyleState (Maybe TextStyle)
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 = Seq Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Getting Text TextLine Text -> TextLine -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text TextLine Text
forall s a. HasText s a => Lens' s a
L.text (TextLine -> Text) -> Seq TextLine -> Seq 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 = Int -> Seq HistoryStep -> Seq HistoryStep
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 Seq HistoryStep -> HistoryStep -> Seq HistoryStep
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  }

restoreHistory
  :: WidgetEnv s e -> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory :: WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Int
idx
  | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq HistoryStep -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
hist Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
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 = Seq HistoryStep -> Int -> HistoryStep
forall a. Seq a -> Int -> a
Seq.index Seq HistoryStep
hist Int
idx
    tmpState :: TextAreaState
tmpState = WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
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 = Maybe (Int, Int) -> (Int, Int)
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 = Getting Text TextLine Text -> TextLine -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text TextLine Text
forall s a. HasText s a => Lens' s a
L.text (TextLine -> Text) -> Seq TextLine -> Seq Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines

  ((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
    | (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int) -> (Int, Int)
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
selY2 = Text
singleLine
    | Int
selX2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Text] -> Text
T.unlines ([Text] -> Text) -> (Seq Text -> [Text]) -> Seq Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Text -> Text) -> Seq Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
begin Text -> Seq Text -> Seq Text
forall a. a -> Seq a -> Seq a
:<| Seq Text
middle
    | Bool
otherwise = [Text] -> Text
T.unlines ([Text] -> Text) -> (Seq Text -> [Text]) -> Seq Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Text -> Text) -> Seq Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
begin Text -> Seq Text -> Seq Text
forall a. a -> Seq a -> Seq a
:<| (Seq Text
middle Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
:|> Text
end)
    where
      singleLine :: Text
singleLine = Int -> Text -> Text
T.drop Int
selX1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
selX2 (Seq Text -> Int -> Text
forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1)
      begin :: Text
begin = Int -> Text -> Text
T.drop Int
selX1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> Int -> Text
forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1
      middle :: Seq Text
middle = Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Seq Text -> Seq Text) -> Seq Text -> Seq Text
forall a b. (a -> b) -> a -> b
$ Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.take Int
selY2 Seq Text
oldLines
      end :: Text
end = Int -> Text -> Text
T.take Int
selX2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> Int -> Text
forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY2
  result :: Maybe Text
result
    | Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
newText
    | Bool
otherwise = Maybe Text
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
  | Maybe (Int, Int) -> Bool
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 (Maybe (Int, Int) -> (Int, Int)
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 = (Text, (Int, Int), Maybe (Int, Int))
forall a. (Text, (Int, Int), Maybe a)
result where
  oldLines :: Seq Text
oldLines = Getting Text TextLine Text -> TextLine -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text TextLine Text
forall s a. HasText s a => Lens' s a
L.text (TextLine -> Text) -> Seq TextLine -> Seq Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines
  ((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
    | (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int) -> (Int, Int)
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 = Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.take Int
selY1 Seq Text
oldLines
  postLines :: Seq Text
postLines = Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY2 Int -> Int -> Int
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
    | Seq Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
oldLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
selY1 = Int -> Text -> Text
T.take Int
selX1 (Seq Text -> Int -> Text
forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1)
    | Bool
otherwise = Text
""
  lineSuf :: Text
lineSuf
    | Seq Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
oldLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
selY2 = Int -> Text -> Text
T.drop Int
selX2 (Seq Text -> Int -> Text
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 = [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList (Text -> [Text]
T.lines Text
addText)
    | Bool
otherwise = [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList (Text -> [Text]
T.lines Text
addText) Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
:|> Text
""

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

  newLines :: Seq Text
newLines = Seq Text
prevLines Seq Text -> Seq Text -> Seq Text
forall a. Semigroup a => a -> a -> a
<> Seq Text
midLines Seq Text -> Seq Text -> Seq Text
forall a. Semigroup a => a -> a -> a
<> Seq Text
postLines
  newText :: Text
newText = Int -> Text -> Text
T.dropEnd Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines (Seq Text -> [Text]
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), Maybe a
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Seq TextLine -> Double
getSpaceV Seq TextLine
textLines
  lineIdx :: Int
lineIdx = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Seq TextLine -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
y Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalH))
  lineGlyphs :: Seq GlyphPos
lineGlyphs
    | Seq TextLine -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq TextLine
textLines = Seq GlyphPos
forall a. Seq a
Seq.empty
    | Bool
otherwise = Seq (Seq GlyphPos) -> Int -> Seq GlyphPos
forall a. Seq a -> Int -> a
Seq.index (Getting (Seq GlyphPos) TextLine (Seq GlyphPos)
-> TextLine -> Seq GlyphPos
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq GlyphPos) TextLine (Seq GlyphPos)
forall s a. HasGlyphs s a => Lens' s a
L.glyphs (TextLine -> Seq GlyphPos) -> Seq TextLine -> Seq (Seq GlyphPos)
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
    | Seq GlyphPos -> Bool
forall a. Seq a -> Bool
Seq.null Seq GlyphPos
lineGlyphs = Seq GlyphPos
forall a. Seq a
Seq.empty
    | Bool
otherwise = Seq GlyphPos
lineGlyphs Seq GlyphPos -> GlyphPos -> Seq GlyphPos
forall a. Seq a -> a -> Seq a
|> Char
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> GlyphPos
GlyphPos Char
' ' Double
textLen Double
0 Double
0 Double
0 Double
0 Double
0
  glyphStart :: a -> GlyphPos -> (a, Double)
glyphStart a
i GlyphPos
g = (a
i, Double -> Double
forall a. Num a => a -> a
abs (GlyphPos -> Double
_glpXMin GlyphPos
g Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x))

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

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

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