{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Singles.TextArea (
TextAreaCfg,
textArea,
textArea_,
textAreaV,
textAreaV_,
textAreaD_
) where
import Control.Applicative ((<|>))
import Control.Lens hiding ((|>))
import Control.Monad (forM_, when)
import Data.Default
import Data.Foldable (toList)
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Tuple (swap)
import Data.Text (Text)
import GHC.Generics
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import Monomer.Helper
import Monomer.Widgets.Containers.Scroll
import Monomer.Widgets.Single
import qualified Monomer.Lens as L
defCaretW :: Double
defCaretW :: Double
defCaretW = Double
2
defCaretMs :: Millisecond
defCaretMs :: Millisecond
defCaretMs = Millisecond
500
data TextAreaCfg s e = TextAreaCfg {
forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth :: Maybe Double,
forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs :: Maybe Millisecond,
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength :: Maybe Int,
forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines :: Maybe Int,
forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab :: Maybe Bool,
forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus :: Maybe Bool,
forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly :: Maybe Bool,
forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq :: [Path -> WidgetRequest s e],
forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq :: [Path -> WidgetRequest s e],
forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq :: [Text -> WidgetRequest s e]
}
instance Default (TextAreaCfg s e) where
def :: TextAreaCfg s e
def = TextAreaCfg {
_tacCaretWidth :: Maybe Double
_tacCaretWidth = forall a. Maybe a
Nothing,
_tacCaretMs :: Maybe Millisecond
_tacCaretMs = forall a. Maybe a
Nothing,
_tacMaxLength :: Maybe Int
_tacMaxLength = forall a. Maybe a
Nothing,
_tacMaxLines :: Maybe Int
_tacMaxLines = forall a. Maybe a
Nothing,
_tacAcceptTab :: Maybe Bool
_tacAcceptTab = forall a. Maybe a
Nothing,
_tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = forall a. Maybe a
Nothing,
_tacReadOnly :: Maybe Bool
_tacReadOnly = forall a. Maybe a
Nothing,
_tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = [],
_tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = [],
_tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = []
}
instance Semigroup (TextAreaCfg s e) where
<> :: TextAreaCfg s e -> TextAreaCfg s e -> TextAreaCfg s e
(<>) TextAreaCfg s e
t1 TextAreaCfg s e
t2 = TextAreaCfg {
_tacCaretWidth :: Maybe Double
_tacCaretWidth = forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
t1,
_tacCaretMs :: Maybe Millisecond
_tacCaretMs = forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs TextAreaCfg s e
t1,
_tacMaxLength :: Maybe Int
_tacMaxLength = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
t1,
_tacMaxLines :: Maybe Int
_tacMaxLines = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
t1,
_tacAcceptTab :: Maybe Bool
_tacAcceptTab = forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
t1,
_tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
t1,
_tacReadOnly :: Maybe Bool
_tacReadOnly = forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly TextAreaCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly TextAreaCfg s e
t1,
_tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
t2,
_tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
t2,
_tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
t2
}
instance Monoid (TextAreaCfg s e) where
mempty :: TextAreaCfg s e
mempty = forall a. Default a => a
def
instance CmbCaretWidth (TextAreaCfg s e) Double where
caretWidth :: Double -> TextAreaCfg s e
caretWidth Double
w = forall a. Default a => a
def {
_tacCaretWidth :: Maybe Double
_tacCaretWidth = forall a. a -> Maybe a
Just Double
w
}
instance CmbCaretMs (TextAreaCfg s e) Millisecond where
caretMs :: Millisecond -> TextAreaCfg s e
caretMs Millisecond
ms = forall a. Default a => a
def {
_tacCaretMs :: Maybe Millisecond
_tacCaretMs = forall a. a -> Maybe a
Just Millisecond
ms
}
instance CmbMaxLength (TextAreaCfg s e) where
maxLength :: Int -> TextAreaCfg s e
maxLength Int
len = forall a. Default a => a
def {
_tacMaxLength :: Maybe Int
_tacMaxLength = forall a. a -> Maybe a
Just Int
len
}
instance CmbMaxLines (TextAreaCfg s e) where
maxLines :: Int -> TextAreaCfg s e
maxLines Int
lines = forall a. Default a => a
def {
_tacMaxLines :: Maybe Int
_tacMaxLines = forall a. a -> Maybe a
Just Int
lines
}
instance CmbAcceptTab (TextAreaCfg s e) where
acceptTab_ :: Bool -> TextAreaCfg s e
acceptTab_ Bool
accept = forall a. Default a => a
def {
_tacAcceptTab :: Maybe Bool
_tacAcceptTab = forall a. a -> Maybe a
Just Bool
accept
}
instance CmbSelectOnFocus (TextAreaCfg s e) where
selectOnFocus_ :: Bool -> TextAreaCfg s e
selectOnFocus_ Bool
sel = forall a. Default a => a
def {
_tacSelectOnFocus :: Maybe Bool
_tacSelectOnFocus = forall a. a -> Maybe a
Just Bool
sel
}
instance CmbReadOnly (TextAreaCfg s e) where
readOnly_ :: Bool -> TextAreaCfg s e
readOnly_ Bool
ro = forall a. Default a => a
def {
_tacReadOnly :: Maybe Bool
_tacReadOnly = forall a. a -> Maybe a
Just Bool
ro
}
instance WidgetEvent e => CmbOnFocus (TextAreaCfg s e) e Path where
onFocus :: (Path -> e) -> TextAreaCfg s e
onFocus Path -> e
fn = forall a. Default a => a
def {
_tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
}
instance CmbOnFocusReq (TextAreaCfg s e) s e Path where
onFocusReq :: (Path -> WidgetRequest s e) -> TextAreaCfg s e
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
_tacOnFocusReq :: [Path -> WidgetRequest s e]
_tacOnFocusReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnBlur (TextAreaCfg s e) e Path where
onBlur :: (Path -> e) -> TextAreaCfg s e
onBlur Path -> e
fn = forall a. Default a => a
def {
_tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
}
instance CmbOnBlurReq (TextAreaCfg s e) s e Path where
onBlurReq :: (Path -> WidgetRequest s e) -> TextAreaCfg s e
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
_tacOnBlurReq :: [Path -> WidgetRequest s e]
_tacOnBlurReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnChange (TextAreaCfg s e) Text e where
onChange :: (Text -> e) -> TextAreaCfg s e
onChange Text -> e
fn = forall a. Default a => a
def {
_tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> e
fn]
}
instance CmbOnChangeReq (TextAreaCfg s e) s e Text where
onChangeReq :: (Text -> WidgetRequest s e) -> TextAreaCfg s e
onChangeReq Text -> WidgetRequest s e
req = forall a. Default a => a
def {
_tacOnChangeReq :: [Text -> WidgetRequest s e]
_tacOnChangeReq = [Text -> WidgetRequest s e
req]
}
data HistoryStep = HistoryStep {
HistoryStep -> Text
_tahText :: !Text,
HistoryStep -> (Int, Int)
_tahCursorPos :: !(Int, Int),
HistoryStep -> Maybe (Int, Int)
_tahSelStart :: Maybe (Int, Int)
} deriving (HistoryStep -> HistoryStep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryStep -> HistoryStep -> Bool
$c/= :: HistoryStep -> HistoryStep -> Bool
== :: HistoryStep -> HistoryStep -> Bool
$c== :: HistoryStep -> HistoryStep -> Bool
Eq, Int -> HistoryStep -> ShowS
[HistoryStep] -> ShowS
HistoryStep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryStep] -> ShowS
$cshowList :: [HistoryStep] -> ShowS
show :: HistoryStep -> String
$cshow :: HistoryStep -> String
showsPrec :: Int -> HistoryStep -> ShowS
$cshowsPrec :: Int -> HistoryStep -> ShowS
Show, forall x. Rep HistoryStep x -> HistoryStep
forall x. HistoryStep -> Rep HistoryStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistoryStep x -> HistoryStep
$cfrom :: forall x. HistoryStep -> Rep HistoryStep x
Generic)
data TextAreaState = TextAreaState {
TextAreaState -> Text
_tasText :: Text,
TextAreaState -> TextMetrics
_tasTextMetrics :: TextMetrics,
TextAreaState -> Maybe TextStyle
_tasTextStyle :: Maybe TextStyle,
TextAreaState -> (Int, Int)
_tasCursorPos :: (Int, Int),
TextAreaState -> Maybe (Int, Int)
_tasSelStart :: Maybe (Int, Int),
TextAreaState -> Seq TextLine
_tasTextLines :: Seq TextLine,
TextAreaState -> Seq HistoryStep
_tasHistory :: Seq HistoryStep,
TextAreaState -> Int
_tasHistoryIdx :: Int,
TextAreaState -> Millisecond
_tasFocusStart :: Millisecond
} deriving (TextAreaState -> TextAreaState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextAreaState -> TextAreaState -> Bool
$c/= :: TextAreaState -> TextAreaState -> Bool
== :: TextAreaState -> TextAreaState -> Bool
$c== :: TextAreaState -> TextAreaState -> Bool
Eq, Int -> TextAreaState -> ShowS
[TextAreaState] -> ShowS
TextAreaState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextAreaState] -> ShowS
$cshowList :: [TextAreaState] -> ShowS
show :: TextAreaState -> String
$cshow :: TextAreaState -> String
showsPrec :: Int -> TextAreaState -> ShowS
$cshowsPrec :: Int -> TextAreaState -> ShowS
Show, forall x. Rep TextAreaState x -> TextAreaState
forall x. TextAreaState -> Rep TextAreaState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextAreaState x -> TextAreaState
$cfrom :: forall x. TextAreaState -> Rep TextAreaState x
Generic)
instance Default TextAreaState where
def :: TextAreaState
def = TextAreaState {
_tasText :: Text
_tasText = Text
"",
_tasTextMetrics :: TextMetrics
_tasTextMetrics = forall a. Default a => a
def,
_tasTextStyle :: Maybe TextStyle
_tasTextStyle = forall a. Default a => a
def,
_tasCursorPos :: (Int, Int)
_tasCursorPos = forall a. Default a => a
def,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = forall a. Default a => a
def,
_tasTextLines :: Seq TextLine
_tasTextLines = forall a. Seq a
Seq.empty,
_tasHistory :: Seq HistoryStep
_tasHistory = forall a. Seq a
Seq.empty,
_tasHistoryIdx :: Int
_tasHistoryIdx = Int
0,
_tasFocusStart :: Millisecond
_tasFocusStart = Millisecond
0
}
textArea :: WidgetEvent e => ALens' s Text -> WidgetNode s e
textArea :: forall e s. WidgetEvent e => ALens' s Text -> WidgetNode s e
textArea ALens' s Text
field = forall e s.
WidgetEvent e =>
ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ ALens' s Text
field forall a. Default a => a
def
textArea_
:: WidgetEvent e => ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ :: forall e s.
WidgetEvent e =>
ALens' s Text -> [TextAreaCfg s e] -> WidgetNode s e
textArea_ ALens' s Text
field [TextAreaCfg s e]
configs = forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
textAreaD_ WidgetData s Text
wdata [TextAreaCfg s e]
configs where
wdata :: WidgetData s Text
wdata = forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Text
field
textAreaV :: WidgetEvent e => Text -> (Text -> e) -> WidgetNode s e
textAreaV :: forall e s. WidgetEvent e => Text -> (Text -> e) -> WidgetNode s e
textAreaV Text
value Text -> e
handler = forall e s.
WidgetEvent e =>
Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ Text
value Text -> e
handler forall a. Default a => a
def
textAreaV_
:: WidgetEvent e => Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ :: forall e s.
WidgetEvent e =>
Text -> (Text -> e) -> [TextAreaCfg s e] -> WidgetNode s e
textAreaV_ Text
value Text -> e
handler [TextAreaCfg s e]
configs = forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
textAreaD_ forall {s}. WidgetData s Text
wdata [TextAreaCfg s e]
newConfig where
wdata :: WidgetData s Text
wdata = forall s a. a -> WidgetData s a
WidgetValue Text
value
newConfig :: [TextAreaCfg s e]
newConfig = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Text -> e
handler forall a. a -> [a] -> [a]
: [TextAreaCfg s e]
configs
textAreaD_
:: WidgetEvent e
=> WidgetData s Text
-> [TextAreaCfg s e]
-> WidgetNode s e
textAreaD_ :: forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextAreaCfg s e] -> WidgetNode s e
textAreaD_ WidgetData s Text
wdata [TextAreaCfg s e]
configs = WidgetNode s e
scrollNode where
config :: TextAreaCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [TextAreaCfg s e]
configs
widget :: Widget s e
widget = forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config forall a. Default a => a
def
node :: WidgetNode s e
node = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"textArea" Widget s e
widget
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
scrollCfg :: [ScrollCfg s e]
scrollCfg = [forall s e. ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle forall s a. HasTextAreaStyle s a => Lens' s a
L.textAreaStyle, forall s e.
(WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle forall s e. WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault]
scrollNode :: WidgetNode s e
scrollNode = forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ forall {s} {e}. [ScrollCfg s e]
scrollCfg WidgetNode s e
node
makeTextArea
:: WidgetEvent e
=> WidgetData s Text
-> TextAreaCfg s e
-> TextAreaState
-> Widget s e
makeTextArea :: forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea !WidgetData s Text
wdata !TextAreaCfg s e
config !TextAreaState
state = Widget s e
widget where
widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle TextAreaState
state forall a. Default a => a
def {
singleInit :: SingleInitHandler s e
singleInit = SingleInitHandler s e
init,
singleMerge :: SingleMergeHandler s e TextAreaState
singleMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> TextAreaState -> WidgetResult s e
merge,
singleDispose :: SingleInitHandler s e
singleDispose = forall {p} {s} {e}. p -> WidgetNode s e -> WidgetResult s e
dispose,
singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = forall {a} {b} {p} {p}.
(CmbMinWidth a, CmbMinHeight b) =>
p -> p -> (a, b)
getSizeReq,
singleRender :: SingleRenderHandler s e
singleRender = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
}
!caretMs :: Millisecond
caretMs = forall a. a -> Maybe a -> a
fromMaybe Millisecond
defCaretMs (forall s e. TextAreaCfg s e -> Maybe Millisecond
_tacCaretMs TextAreaCfg s e
config)
!maxLength :: Maybe Int
maxLength = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLength TextAreaCfg s e
config
!maxLines :: Maybe Int
maxLines = forall s e. TextAreaCfg s e -> Maybe Int
_tacMaxLines TextAreaCfg s e
config
!editable :: Bool
editable = forall s e. TextAreaCfg s e -> Maybe Bool
_tacReadOnly TextAreaCfg s e
config forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True
getModelValue :: WidgetEnv s e -> Text
getModelValue !WidgetEnv s e
wenv = forall s a. s -> WidgetData s a -> a
widgetDataGet (forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) WidgetData s Text
wdata
!currText :: Text
currText = TextAreaState -> Text
_tasText TextAreaState
state
!textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
validText :: TextAreaState -> Bool
validText !TextAreaState
state = Bool
validLen Bool -> Bool -> Bool
&& Bool
validLines where
text :: Text
text = TextAreaState -> Text
_tasText TextAreaState
state
lines :: Seq TextLine
lines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
validLen :: Bool
validLen = Text -> Int
T.length Text
text forall a. Ord a => a -> a -> Bool
<= forall a. a -> Maybe a -> a
fromMaybe forall a. Bounded a => a
maxBound Maybe Int
maxLength
validLines :: Bool
validLines = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
lines forall a. Ord a => a -> a -> Bool
<= forall a. a -> Maybe a -> a
fromMaybe forall a. Bounded a => a
maxBound Maybe Int
maxLines
line :: Int -> Text
line !Int
idx
| Int
idx forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text
| Bool
otherwise = Text
""
!lineLen :: Int -> Int
lineLen = Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
line
!totalLines :: Int
totalLines = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines
!lastPos :: (Int, Int)
lastPos = (Int -> Int
lineLen (Int
totalLines forall a. Num a => a -> a -> a
- Int
1), Int
totalLines)
init :: SingleInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
text :: Text
text = forall {e}. WidgetEnv s e -> Text
getModelValue WidgetEnv s e
wenv
newState :: TextAreaState
newState = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
text
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
merge :: WidgetEnv s e
-> WidgetNode s e -> p -> TextAreaState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode TextAreaState
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
oldText :: Text
oldText = TextAreaState -> Text
_tasText TextAreaState
oldState
newText :: Text
newText = forall {e}. WidgetEnv s e -> Text
getModelValue WidgetEnv s e
wenv
newState :: TextAreaState
newState
| Text
oldText forall a. Eq a => a -> a -> Bool
/= Text
newText = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
newText
| Bool
otherwise = TextAreaState
oldState
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
dispose :: p -> WidgetNode s e -> WidgetResult s e
dispose p
wenv WidgetNode s e
node = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
reqs :: [WidgetRequest s e]
reqs = [forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId]
handleKeyPress :: WidgetEnv s e
-> KeyMod -> KeyCode -> Maybe (Text, (Int, Int), Maybe (Int, Int))
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code
| Bool
isDelBackWordNoSel Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (Text, (Int, Int), Maybe (Int, Int))
removeWordL
| Bool
isDelBackWord Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
selStart Text
"")
| Bool
isBackspace Bool -> Bool -> Bool
&& Bool
emptySel Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (Text, (Int, Int), Maybe (Int, Int))
removeCharL
| Bool
isBackspace Bool -> Bool -> Bool
&& Bool
editable = forall a. a -> Maybe a
Just (TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
selStart Text
"")
| Bool
isMoveLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
- Int
1, Int
tpY) forall a. Maybe a
Nothing
| Bool
isMoveRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
+ Int
1, Int
tpY) forall a. Maybe a
Nothing
| Bool
isMoveUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
1) forall a. Maybe a
Nothing
| Bool
isMoveDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
1) forall a. Maybe a
Nothing
| Bool
isMovePageUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
vpLines) forall a. Maybe a
Nothing
| Bool
isMovePageDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
vpLines) forall a. Maybe a
Nothing
| Bool
isMoveWordL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
prevWordPos forall a. Maybe a
Nothing
| Bool
isMoveWordR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
nextWordPos forall a. Maybe a
Nothing
| Bool
isMoveLineL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
tpY) forall a. Maybe a
Nothing
| Bool
isMoveLineR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int -> Int
lineLen Int
tpY, Int
tpY) forall a. Maybe a
Nothing
| Bool
isMoveFullUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) forall a. Maybe a
Nothing
| Bool
isMoveFullDn = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
lastPos forall a. Maybe a
Nothing
| Bool
isSelectAll = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) (forall a. a -> Maybe a
Just (Int, Int)
lastPos)
| Bool
isSelectLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
- Int
1, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX forall a. Num a => a -> a -> a
+ Int
1, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
1) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectPageUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
- Int
vpLines) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectPageDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
tpX, Int
tpY forall a. Num a => a -> a -> a
+ Int
vpLines) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectWordL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
prevWordPos (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectWordR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
nextWordPos (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectLineL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectLineR = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int -> Int
lineLen Int
tpY, Int
tpY) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectFullUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int
0, Int
0) (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isSelectFullDn = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
lastPos (forall a. a -> Maybe a
Just (Int, Int)
tp)
| Bool
isDeselectLeft = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
minTpSel forall a. Maybe a
Nothing
| Bool
isDeselectRight = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
maxTpSel forall a. Maybe a
Nothing
| Bool
isDeselectUp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
minTpSel forall a. Maybe a
Nothing
| Bool
isDeselectDown = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}.
a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor Text
txt (Int, Int)
maxTpSel forall a. Maybe a
Nothing
| Bool
otherwise = forall a. Maybe a
Nothing
where
txt :: Text
txt = Text
currText
txtLen :: Int
txtLen = Text -> Int
T.length Text
txt
textMetrics :: TextMetrics
textMetrics = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
tp :: (Int, Int)
tp@(Int
tpX, Int
tpY) = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
selStart :: Maybe (Int, Int)
selStart = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state
((Int, Int)
minTpSel, (Int, Int)
maxTpSel)
| forall a b. (a, b) -> (b, a)
swap (Int, Int)
tp forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart) = ((Int, Int)
tp, forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart)
| Bool
otherwise = (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
selStart, (Int, Int)
tp)
emptySel :: Bool
emptySel = forall a. Maybe a -> Bool
isNothing Maybe (Int, Int)
selStart
vpLines :: Int
vpLines = forall a b. (RealFrac a, Integral b) => a -> b
round (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasH s a => Lens' s a
L.h forall a. Fractional a => a -> a -> a
/ TextMetrics
textMetrics forall s a. s -> Getting a s a -> a
^. forall s a. HasLineH s a => Lens' s a
L.lineH)
activeSel :: Bool
activeSel = forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart
prevTxt :: Text
prevTxt
| Int
tpX forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Text -> Text
T.take Int
tpX (Int -> Text
line Int
tpY)
| Bool
otherwise = Int -> Text
line (Int
tpY forall a. Num a => a -> a -> a
- Int
1)
prevWordStart :: Text
prevWordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
delim forall a b. (a -> b) -> a -> b
$ Text
prevTxt
prevWordPos :: (Int, Int)
prevWordPos
| Int
tpX forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
tpY forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
tpX, Int
tpY)
| Int
tpX forall a. Ord a => a -> a -> Bool
> Int
0 = (Text -> Int
T.length Text
prevWordStart, Int
tpY)
| Bool
otherwise = (Text -> Int
T.length Text
prevWordStart, Int
tpY forall a. Num a => a -> a -> a
- Int
1)
nextTxt :: Text
nextTxt
| Int
tpX forall a. Ord a => a -> a -> Bool
< Int -> Int
lineLen Int
tpY = Int -> Text -> Text
T.drop Int
tpX (Int -> Text
line Int
tpY)
| Bool
otherwise = Int -> Text
line (Int
tpY forall a. Num a => a -> a -> a
+ Int
1)
nextWordEnd :: Text
nextWordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
delim forall a b. (a -> b) -> a -> b
$ Text
nextTxt
nextWordPos :: (Int, Int)
nextWordPos
| Int
tpX forall a. Eq a => a -> a -> Bool
== Int -> Int
lineLen Int
tpY Bool -> Bool -> Bool
&& Int
tpY forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Num a => a -> a -> a
- Int
1 = (Int
tpX, Int
tpY)
| Int
tpX forall a. Ord a => a -> a -> Bool
< Int -> Int
lineLen Int
tpY = (Int -> Int
lineLen Int
tpY forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd, Int
tpY)
| Bool
otherwise = (Int -> Int
lineLen (Int
tpY forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
nextWordEnd, Int
tpY forall a. Num a => a -> a -> a
+ Int
1)
isShift :: Bool
isShift = KeyMod -> Bool
_kmLeftShift KeyMod
mod
isLeft :: Bool
isLeft = KeyCode -> Bool
isKeyLeft KeyCode
code
isRight :: Bool
isRight = KeyCode -> Bool
isKeyRight KeyCode
code
isUp :: Bool
isUp = KeyCode -> Bool
isKeyUp KeyCode
code
isDown :: Bool
isDown = KeyCode -> Bool
isKeyDown KeyCode
code
isHome :: Bool
isHome = KeyCode -> Bool
isKeyHome KeyCode
code
isEnd :: Bool
isEnd = KeyCode -> Bool
isKeyEnd KeyCode
code
isPageUp :: Bool
isPageUp = KeyCode -> Bool
isKeyPageUp KeyCode
code
isPageDown :: Bool
isPageDown = KeyCode -> Bool
isKeyPageDown KeyCode
code
isWordMod :: Bool
isWordMod
| forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
| Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
isLineMod :: Bool
isLineMod
| forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod Bool -> Bool -> Bool
|| KeyMod -> Bool
_kmLeftGUI KeyMod
mod
| Bool
otherwise = KeyMod -> Bool
_kmLeftAlt KeyMod
mod
isAllMod :: Bool
isAllMod
| forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv = KeyMod -> Bool
_kmLeftGUI KeyMod
mod
| Bool
otherwise = KeyMod -> Bool
_kmLeftCtrl KeyMod
mod
isBackspace :: Bool
isBackspace = KeyCode -> Bool
isKeyBackspace KeyCode
code
isDelBackWord :: Bool
isDelBackWord = Bool
isBackspace Bool -> Bool -> Bool
&& Bool
isWordMod
isDelBackWordNoSel :: Bool
isDelBackWordNoSel = Bool
isDelBackWord Bool -> Bool -> Bool
&& Bool
emptySel
isMove :: Bool
isMove = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isMoveWord :: Bool
isMoveWord = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isMoveLine :: Bool
isMoveLine = Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isLineMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod
isSelect :: Bool
isSelect = Bool
isShift Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isSelectWord :: Bool
isSelectWord = Bool
isShift Bool -> Bool -> Bool
&& Bool
isWordMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLineMod
isSelectLine :: Bool
isSelectLine = Bool
isShift Bool -> Bool -> Bool
&& Bool
isLineMod Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWordMod
isMoveLeft :: Bool
isMoveLeft = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isLeft
isMoveRight :: Bool
isMoveRight = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isRight
isMoveWordL :: Bool
isMoveWordL = Bool
isMoveWord Bool -> Bool -> Bool
&& Bool
isLeft
isMoveWordR :: Bool
isMoveWordR = Bool
isMoveWord Bool -> Bool -> Bool
&& Bool
isRight
isMoveLineL :: Bool
isMoveLineL = (Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isLeft) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isHome)
isMoveLineR :: Bool
isMoveLineR = (Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isRight) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isShift Bool -> Bool -> Bool
&& Bool
isEnd)
isMoveFullUp :: Bool
isMoveFullUp = Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isUp
isMoveFullDn :: Bool
isMoveFullDn = Bool
isMoveLine Bool -> Bool -> Bool
&& Bool
isDown
isMoveUp :: Bool
isMoveUp = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isUp
isMoveDown :: Bool
isMoveDown = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isDown
isMovePageUp :: Bool
isMovePageUp = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isPageUp
isMovePageDown :: Bool
isMovePageDown = Bool
isMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
activeSel Bool -> Bool -> Bool
&& Bool
isPageDown
isSelectAll :: Bool
isSelectAll = Bool
isAllMod Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyA KeyCode
code
isSelectLeft :: Bool
isSelectLeft = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isLeft
isSelectRight :: Bool
isSelectRight = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isRight
isSelectUp :: Bool
isSelectUp = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isUp
isSelectDown :: Bool
isSelectDown = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isDown
isSelectPageUp :: Bool
isSelectPageUp = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isPageUp
isSelectPageDown :: Bool
isSelectPageDown = Bool
isSelect Bool -> Bool -> Bool
&& Bool
isPageDown
isSelectWordL :: Bool
isSelectWordL = Bool
isSelectWord Bool -> Bool -> Bool
&& Bool
isLeft
isSelectWordR :: Bool
isSelectWordR = Bool
isSelectWord Bool -> Bool -> Bool
&& Bool
isRight
isSelectLineL :: Bool
isSelectLineL = (Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isLeft) Bool -> Bool -> Bool
|| (Bool
isShift Bool -> Bool -> Bool
&& Bool
isHome)
isSelectLineR :: Bool
isSelectLineR = (Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isRight) Bool -> Bool -> Bool
|| (Bool
isShift Bool -> Bool -> Bool
&& Bool
isEnd)
isSelectFullUp :: Bool
isSelectFullUp = Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isUp
isSelectFullDn :: Bool
isSelectFullDn = Bool
isSelectLine Bool -> Bool -> Bool
&& Bool
isDown
isDeselectLeft :: Bool
isDeselectLeft = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isLeft
isDeselectRight :: Bool
isDeselectRight = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isRight
isDeselectUp :: Bool
isDeselectUp = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isUp
isDeselectDown :: Bool
isDeselectDown = Bool
isMove Bool -> Bool -> Bool
&& Bool
activeSel Bool -> Bool -> Bool
&& Bool
isDown
replaceFix :: (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int, Int)
sel Text
text = TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int) -> (Int, Int)
fixPos (Int, Int)
sel) Text
text
removeCharL :: (Text, (Int, Int), Maybe (Int, Int))
removeCharL
| Int
tpX forall a. Ord a => a -> a -> Bool
> Int
0 = (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int
tpX forall a. Num a => a -> a -> a
- Int
1, Int
tpY) Text
""
| Bool
otherwise = (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int -> Int
lineLen (Int
tpY forall a. Num a => a -> a -> a
- Int
1), Int
tpY forall a. Num a => a -> a -> a
- Int
1) Text
""
removeWordL :: (Text, (Int, Int), Maybe (Int, Int))
removeWordL = (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceFix (Int, Int)
prevWordPos Text
""
moveCursor :: a
-> (Int, Int)
-> Maybe (Int, Int)
-> (a, (Int, Int), Maybe (Int, Int))
moveCursor a
txt (Int, Int)
newPos Maybe (Int, Int)
newSel
| forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe (Int, Int)
newSel = (a
txt, (Int, Int)
fixedPos, forall a. Maybe a
Nothing)
| forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart Bool -> Bool -> Bool
&& forall a. a -> Maybe a
Just (Int, Int)
fixedPos forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
selStart = (a
txt, (Int, Int)
fixedPos, forall a. Maybe a
Nothing)
| forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
selStart = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
selStart)
| forall a. a -> Maybe a
Just (Int, Int)
fixedPos forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
fixedSel = (a
txt, (Int, Int)
fixedPos, forall a. Maybe a
Nothing)
| Bool
otherwise = (a
txt, (Int, Int)
fixedPos, Maybe (Int, Int)
fixedSel)
where
fixedPos :: (Int, Int)
fixedPos = (Int, Int) -> (Int, Int)
fixPos (Int, Int)
newPos
fixedSel :: Maybe (Int, Int)
fixedSel = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> (Int, Int)
fixPos Maybe (Int, Int)
newSel
fixPos :: (Int, Int) -> (Int, Int)
fixPos (Int
cX, Int
cY) = (Int, Int)
result where
nlines :: Int
nlines = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines
vcY :: Int
vcY = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
nlines forall a. Num a => a -> a -> a
- Int
1) Int
cY
vcX :: Int
vcX = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int
lineLen Int
tpY) Int
cX
ncX :: Int
ncX = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int
lineLen Int
vcY) Int
cX
sameX :: Bool
sameX = Int
vcX forall a. Eq a => a -> a -> Bool
== Int
tpX
sameY :: Bool
sameY = Int
vcY forall a. Eq a => a -> a -> Bool
== Int
tpY
result :: (Int, Int)
result
| Bool
sameY Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
vcY forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
0, Int
0)
| Bool
sameY Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
vcY forall a. Ord a => a -> a -> Bool
> Int
0 = (Int -> Int
lineLen (Int
vcY forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
cX forall a. Num a => a -> a -> a
+ Int
1, Int
vcY forall a. Num a => a -> a -> a
- Int
1)
| Bool
sameY Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
> Int -> Int
lineLen Int
vcY Bool -> Bool -> Bool
&& Int
vcY forall a. Ord a => a -> a -> Bool
< Int
nlines forall a. Num a => a -> a -> a
- Int
1 = (Int
cX forall a. Num a => a -> a -> a
- Int -> Int
lineLen Int
vcY forall a. Num a => a -> a -> a
- Int
1, Int
vcY forall a. Num a => a -> a -> a
+ Int
1)
| Bool
sameX Bool -> Bool -> Bool
&& Int
cX forall a. Ord a => a -> a -> Bool
> Int -> Int
lineLen Int
vcY = (forall a. Ord a => a -> a -> a
min Int
cX (Int -> Int
lineLen Int
vcY), Int
vcY)
| Bool
otherwise = (Int
ncX, Int
vcY)
handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
| Int
clicks forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
newPos :: (Int, Int)
newPos = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
newState :: TextAreaState
newState = TextAreaState
state {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = forall a. Maybe a
Nothing
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce]
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Int
clicks forall a. Eq a => a -> a -> Bool
== Int
2 -> Maybe (WidgetResult s e)
result where
(Int
tx, Int
ty) = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
currText :: Text
currText = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
ty forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text
(Text
part1, Text
part2) = Int -> Text -> (Text, Text)
T.splitAt Int
tx Text
currText
txtLen :: Int
txtLen = Text -> Int
T.length Text
currText
wordStart :: Text
wordStart = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part1
wordStartIdx :: Int
wordStartIdx = Text -> Int
T.length Text
wordStart
wordEnd :: Text
wordEnd = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
delim) Text
part2
wordEndIdx :: Int
wordEndIdx = Int
txtLen forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
wordEnd
newPos :: (Int, Int)
newPos = (Int
wordStartIdx, Int
ty)
newSel :: Maybe (Int, Int)
newSel = forall a. a -> Maybe a
Just (Int
wordEndIdx, Int
ty)
newState :: TextAreaState
newState = TextAreaState
state {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
result :: Maybe (WidgetResult s e)
result
| Int
ty forall a. Ord a => a -> a -> Bool
< Int
totalLines = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce])
| Bool
otherwise = forall a. Maybe a
Nothing
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Int
clicks forall a. Eq a => a -> a -> Bool
== Int
3 -> Maybe (WidgetResult s e)
result where
(Int
tx, Int
ty) = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
glyphs :: Seq GlyphPos
glyphs = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
ty forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs
newPos :: (Int, Int)
newPos = (Int
0, Int
ty)
newSel :: Maybe (Int, Int)
newSel = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs, Int
ty)
newState :: TextAreaState
newState = TextAreaState
state {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
result :: Maybe (WidgetResult s e)
result
| Int
ty forall a. Ord a => a -> a -> Bool
< Int
totalLines = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce])
| Bool
otherwise = forall a. Maybe a
Nothing
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Int
clicks forall a. Eq a => a -> a -> Bool
== Int
4 -> Maybe (WidgetResult s e)
result where
glyphs :: Seq GlyphPos
glyphs = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines (Int
totalLines forall a. Num a => a -> a -> a
- Int
1) forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs
newPos :: (Int, Int)
newPos = (Int
0, Int
0)
newSel :: Maybe (Int, Int)
newSel = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs, Int
totalLines forall a. Num a => a -> a -> a
- Int
1)
newState :: TextAreaState
newState = TextAreaState
state {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
result :: Maybe (WidgetResult s e)
result
| Int
totalLines forall a. Ord a => a -> a -> Bool
> Int
0 = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce])
| Bool
otherwise = forall a. Maybe a
Nothing
Move Point
point
| forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node -> forall a. a -> Maybe a
Just WidgetResult s e
result where
curPos :: (Int, Int)
curPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
selStart :: Maybe (Int, Int)
selStart = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state
newPos :: (Int, Int)
newPos = TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state (Point -> Point
localPoint Point
point)
newSel :: Maybe (Int, Int)
newSel = Maybe (Int, Int)
selStart forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just (Int, Int)
curPos
newState :: TextAreaState
newState = TextAreaState
state {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
}
scrollReq :: [WidgetRequest s e]
scrollReq = forall {s} {e} {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateScrollReq WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (forall s e. WidgetRequest s e
RenderOnce forall a. a -> [a] -> [a]
: forall {s} {e}. [WidgetRequest s e]
scrollReq)
KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCopy WidgetEnv s e
wenv SystemEvent
evt -> forall a. a -> Maybe a
Just WidgetResult s e
resultCopy
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardPaste WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultPaste
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCut WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultCut
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardUndo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextAreaState -> Int -> WidgetResult s e
moveHistory TextAreaState
bwdState (-Int
1)
| forall s e. WidgetEnv s e -> SystemEvent -> Bool
isKeyboardRedo WidgetEnv s e
wenv SystemEvent
evt Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextAreaState -> Int -> WidgetResult s e
moveHistory TextAreaState
state Int
1
| KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultReturn
| KeyCode -> Bool
isKeyTab KeyCode
code Bool -> Bool -> Bool
&& Bool
acceptTab Bool -> Bool -> Bool
&& Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
resultTab
| Bool
otherwise -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, (Int, Int), Maybe (Int, Int)) -> WidgetResult s e
handleKeyRes (forall {s} {e}.
WidgetEnv s e
-> KeyMod -> KeyCode -> Maybe (Text, (Int, Int), Maybe (Int, Int))
handleKeyPress WidgetEnv s e
wenv KeyMod
mod KeyCode
code)
where
acceptTab :: Bool
acceptTab = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e. TextAreaCfg s e -> Maybe Bool
_tacAcceptTab TextAreaCfg s e
config)
selectedText :: Text
selectedText = forall a. a -> Maybe a -> a
fromMaybe Text
"" (TextAreaState -> Maybe Text
getSelection TextAreaState
state)
clipboardReq :: WidgetRequest s e
clipboardReq = forall s e. ClipboardData -> WidgetRequest s e
SetClipboard (Text -> ClipboardData
ClipboardText Text
selectedText)
resultCopy :: WidgetResult s e
resultCopy = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
clipboardReq]
resultPaste :: WidgetResult s e
resultPaste = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
GetClipboard WidgetId
widgetId]
resultCut :: WidgetResult s e
resultCut = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
""
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. a -> Seq a
Seq.singleton forall s e. WidgetRequest s e
clipboardReq
resultReturn :: WidgetResult s e
resultReturn = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
"\n"
resultTab :: WidgetResult s e
resultTab = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
" "
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. a -> Seq a
Seq.singleton forall s e. WidgetRequest s e
IgnoreParentEvents
history :: Seq HistoryStep
history = TextAreaState -> Seq HistoryStep
_tasHistory TextAreaState
state
historyIdx :: Int
historyIdx = TextAreaState -> Int
_tasHistoryIdx TextAreaState
state
bwdState :: TextAreaState
bwdState = TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state (Int
historyIdx forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
history)
moveHistory :: TextAreaState -> Int -> WidgetResult s e
moveHistory TextAreaState
state Int
steps = WidgetResult s e
result where
newIdx :: Int
newIdx = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
history) (Int
historyIdx forall a. Num a => a -> a -> a
+ Int
steps)
newState :: TextAreaState
newState = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Int
newIdx
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (forall {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState)
handleKeyRes :: (Text, (Int, Int), Maybe (Int, Int)) -> WidgetResult s e
handleKeyRes (Text
newText, (Int, Int)
newPos, Maybe (Int, Int)
newSel) = WidgetResult s e
result where
tmpState :: TextAreaState
tmpState = TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state (TextAreaState -> Text
_tasText TextAreaState
state forall a. Eq a => a -> a -> Bool
/= Text
newText)
newState :: TextAreaState
newState = (forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
tmpState Text
newText) {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode (forall {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState)
TextInput Text
newText
| Bool
editable -> forall a. a -> Maybe a
Just WidgetResult s e
result where
result :: WidgetResult s e
result = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
newText
Clipboard (ClipboardText Text
newText) -> forall a. a -> Maybe a
Just WidgetResult s e
result where
result :: WidgetResult s e
result = WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
newText
Focus Path
prev -> forall a. a -> Maybe a
Just WidgetResult s e
result where
selectOnFocus :: Bool
selectOnFocus = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e. TextAreaCfg s e -> Maybe Bool
_tacSelectOnFocus TextAreaCfg s e
config)
tmpState :: TextAreaState
tmpState
| Bool
selectOnFocus Bool -> Bool -> Bool
&& Text -> Int
T.length Text
currText forall a. Ord a => a -> a -> Bool
> Int
0 = TextAreaState
state {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
lastPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = forall a. a -> Maybe a
Just (Int
0, Int
0)
}
| Bool
otherwise = TextAreaState
state
newState :: TextAreaState
newState = TextAreaState
tmpState {
_tasFocusStart :: Millisecond
_tasFocusStart = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
}
reqs :: [WidgetRequest s e]
reqs = [forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
caretMs forall a. Maybe a
Nothing, forall s e. Rect -> WidgetRequest s e
StartTextInput Rect
viewport]
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
newResult :: WidgetResult s e
newResult = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
reqs
focusRs :: Maybe (WidgetResult s e)
focusRs = forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
newNode Path
prev (forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnFocusReq TextAreaCfg s e
config)
result :: WidgetResult s e
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
focusRs
Blur Path
next -> forall a. a -> Maybe a
Just WidgetResult s e
result where
reqs :: [WidgetRequest s e]
reqs = [forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId, forall s e. WidgetRequest s e
StopTextInput]
newResult :: WidgetResult s e
newResult = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs
blurRes :: Maybe (WidgetResult s e)
blurRes = forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (forall s e. TextAreaCfg s e -> [Path -> WidgetRequest s e]
_tacOnBlurReq TextAreaCfg s e
config)
result :: WidgetResult s e
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetResult s e
newResult (WidgetResult s e
newResult forall a. Semigroup a => a -> a -> a
<>) Maybe (WidgetResult s e)
blurRes
SystemEvent
_ -> forall a. Maybe a
Nothing
where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
viewport :: Rect
viewport = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
Rect Double
cx Double
cy Double
cw Double
ch = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
localPoint :: Point -> Point
localPoint Point
point = Point -> Point -> Point
subPoint Point
point (Double -> Double -> Point
Point Double
cx Double
cy)
insertText :: WidgetEnv s e -> WidgetNode s e -> Text -> WidgetResult s e
insertText WidgetEnv s e
wenv WidgetNode s e
node Text
addedText = WidgetResult s e
result where
currSel :: Maybe (Int, Int)
currSel = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state
(Text
newText, (Int, Int)
newPos, Maybe (Int, Int)
newSel) = TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
currSel Text
addedText
tmpState :: TextAreaState
tmpState = TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state (TextAreaState -> Text
_tasText TextAreaState
state forall a. Eq a => a -> a -> Bool
/= Text
newText)
newState :: TextAreaState
newState = (forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
tmpState Text
newText) {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
newPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
newSel
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
WidgetData s Text -> TextAreaCfg s e -> TextAreaState -> Widget s e
makeTextArea WidgetData s Text
wdata TextAreaCfg s e
config TextAreaState
newState
newReqs :: [WidgetRequest s e]
newReqs = forall {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState
result :: WidgetResult s e
result
| TextAreaState -> Bool
validText TextAreaState
newState = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
newReqs
| Bool
otherwise = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
generateReqs :: WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateReqs WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState = [WidgetRequest s e]
reqs forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
reqScroll where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
oldText :: Text
oldText = TextAreaState -> Text
_tasText TextAreaState
state
newText :: Text
newText = TextAreaState -> Text
_tasText TextAreaState
newState
reqUpdate :: [WidgetRequest s e]
reqUpdate = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s Text
wdata Text
newText
reqOnChange :: [WidgetRequest s e]
reqOnChange = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Text
newText) (forall s e. TextAreaCfg s e -> [Text -> WidgetRequest s e]
_tacOnChangeReq TextAreaCfg s e
config)
reqResize :: [WidgetRequest s e]
reqResize = [forall s e. WidgetId -> WidgetRequest s e
ResizeWidgetsImmediate WidgetId
widgetId]
reqScroll :: [WidgetRequest s e]
reqScroll = forall {s} {e} {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateScrollReq WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState
reqs :: [WidgetRequest s e]
reqs
| Text
oldText forall a. Eq a => a -> a -> Bool
/= Text
newText = forall {e}. [WidgetRequest s e]
reqUpdate forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
reqResize
| Bool
otherwise = []
generateScrollReq :: WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> [WidgetRequest s e]
generateScrollReq WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
newState = forall {s} {e}. [WidgetRequest s e]
scrollReq where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
scPath :: Path
scPath = forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
node
scWid :: Maybe WidgetId
scWid = forall s e. WidgetEnv s e -> Path -> Maybe WidgetId
widgetIdFromPath WidgetEnv s e
wenv Path
scPath
contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
offset :: Point
offset = Double -> Double -> Point
Point (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x) (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y)
caretRect :: Rect
caretRect = forall s e. TextAreaCfg s e -> TextAreaState -> Rect
getCaretRect TextAreaCfg s e
config TextAreaState
newState
scrollRect :: Rect
scrollRect = forall a. a -> Maybe a -> a
fromMaybe Rect
caretRect (StyleState -> Rect -> Maybe Rect
addOuterBounds StyleState
style Rect
caretRect)
scrollMsg :: ScrollMessage
scrollMsg = Rect -> ScrollMessage
ScrollTo forall a b. (a -> b) -> a -> b
$ Point -> Rect -> Rect
moveRect Point
offset Rect
scrollRect
scrollReq :: [WidgetRequest s e]
scrollReq
| Rect -> Rect -> Bool
rectInRect Rect
caretRect (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing Maybe WidgetId
scWid = []
| Bool
otherwise = [forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage (forall a. HasCallStack => Maybe a -> a
fromJust Maybe WidgetId
scWid) ScrollMessage
scrollMsg]
getSizeReq :: p -> p -> (a, b)
getSizeReq p
wenv p
node = (a, b)
sizeReq where
Size Double
w Double
h = Seq TextLine -> Size
getTextLinesSize Seq TextLine
textLines
spaceV :: Double
spaceV = Seq TextLine -> Double
getSpaceV Seq TextLine
textLines
sizeReq :: (a, b)
sizeReq = (forall t. CmbMinWidth t => Double -> t
minWidth (forall a. Ord a => a -> a -> a
max Double
100 Double
w), forall t. CmbMinHeight t => Double -> t
minHeight (forall a. Ord a => a -> a -> a
max Double
20 (Double
h forall a. Num a => a -> a -> a
+ Double
spaceV)))
render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer =
Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer Point
offset forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
selRequired forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Rect]
selRects forall a b. (a -> b) -> a -> b
$ \Rect
rect ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Rect
rect forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w forall a. Ord a => a -> a -> Bool
> Double
0) forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
rect (forall a. a -> Maybe a
Just Color
selColor) forall a. Maybe a
Nothing
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq TextLine
textLines (Renderer -> StyleState -> TextLine -> IO ()
drawTextLine Renderer
renderer StyleState
style)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
caretRequired forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
caretRect (forall a. a -> Maybe a
Just Color
caretColor) forall a. Maybe a
Nothing
where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
ts :: Millisecond
ts = forall s e. WidgetEnv s e -> Millisecond
_weTimestamp WidgetEnv s e
wenv
offset :: Point
offset = Double -> Double -> Point
Point (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x) (Rect
contentArea forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y)
focused :: Bool
focused = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
caretTs :: Millisecond
caretTs = Millisecond
ts forall a. Num a => a -> a -> a
- TextAreaState -> Millisecond
_tasFocusStart TextAreaState
state
caretRequired :: Bool
caretRequired = Bool
focused Bool -> Bool -> Bool
&& forall a. Integral a => a -> Bool
even (Millisecond
caretTs forall a. Integral a => a -> a -> a
`div` Millisecond
caretMs)
caretColor :: Color
caretColor = StyleState -> Color
styleFontColor StyleState
style
caretRect :: Rect
caretRect = forall s e. TextAreaCfg s e -> TextAreaState -> Rect
getCaretRect TextAreaCfg s e
config TextAreaState
state
selRequired :: Bool
selRequired = forall a. Maybe a -> Bool
isJust (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state)
selColor :: Color
selColor = StyleState -> Color
styleHlColor StyleState
style
selRects :: [Rect]
selRects = TextAreaState -> Rect -> [Rect]
getSelectionRects TextAreaState
state Rect
contentArea
getCaretRect :: TextAreaCfg s e -> TextAreaState -> Rect
getCaretRect :: forall s e. TextAreaCfg s e -> TextAreaState -> Rect
getCaretRect TextAreaCfg s e
config TextAreaState
state = Rect
caretRect where
(Int
cursorX, Int
cursorY) = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
Rect Double
tx Double
ty Double
_ Double
_ = Rect
lineRect
TextMetrics Double
asc Double
desc Double
lineh Double
_ = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
(Rect
lineRect, Seq GlyphPos
glyphs, FontSpace
fspaceV) = case forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
cursorY Seq TextLine
textLines of
Just TextLine
tl -> (TextLine
tl forall s a. s -> Getting a s a -> a
^. forall s a. HasRect s a => Lens' s a
L.rect, TextLine
tl forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs, TextLine
tl forall s a. s -> Getting a s a -> a
^. forall s a. HasFontSpaceV s a => Lens' s a
L.fontSpaceV)
Maybe TextLine
Nothing -> (forall a. Default a => a
def, forall a. Seq a
Seq.empty, forall a. Default a => a
def)
spaceV :: Double
spaceV = FontSpace -> Double
unFontSpace FontSpace
fspaceV
caretPos :: Double
caretPos
| Int
cursorX forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
cursorX forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = Double
0
| Int
cursorX forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
glyphs = GlyphPos -> Double
_glpXMax (forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs (Int
cursorX forall a. Num a => a -> a -> a
- Int
1))
| Bool
otherwise = GlyphPos -> Double
_glpXMin (forall a. Seq a -> Int -> a
Seq.index Seq GlyphPos
glyphs Int
cursorX)
caretX :: Double
caretX = forall a. Ord a => a -> a -> a
max Double
0 (Double
tx forall a. Num a => a -> a -> a
+ Double
caretPos)
caretY :: Double
caretY = Double
ty forall a. Num a => a -> a -> a
- Double
spaceV
caretW :: Double
caretW = forall a. a -> Maybe a -> a
fromMaybe Double
defCaretW (forall s e. TextAreaCfg s e -> Maybe Double
_tacCaretWidth TextAreaCfg s e
config)
caretH :: Double
caretH = Double
lineh forall a. Num a => a -> a -> a
+ Double
spaceV
caretRect :: Rect
caretRect = Double -> Double -> Double -> Double -> Rect
Rect Double
caretX Double
caretY Double
caretW Double
caretH
getSelectionRects :: TextAreaState -> Rect -> [Rect]
getSelectionRects :: TextAreaState -> Rect -> [Rect]
getSelectionRects TextAreaState
state Rect
contentArea = [Rect]
rects where
currPos :: (Int, Int)
currPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
currSel :: (Int, Int)
currSel = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state)
TextMetrics Double
asc Double
desc Double
lineh Double
_ = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
spaceV :: Double
spaceV = Seq TextLine -> Double
getSpaceV Seq TextLine
textLines
line :: Int -> Text
line Int
idx
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Ord a => a -> a -> Bool
> Int
idx = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text
| Bool
otherwise = Text
""
lineLen :: Int -> Int
lineLen = Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
line
glyphs :: Int -> Seq GlyphPos
glyphs Int
idx
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Ord a => a -> a -> Bool
> Int
idx = forall a. Seq a -> Int -> a
Seq.index Seq TextLine
textLines Int
idx forall s a. s -> Getting a s a -> a
^. forall s a. HasGlyphs s a => Lens' s a
L.glyphs
| Bool
otherwise = forall a. Seq a
Seq.empty
glyphPos :: Int -> Int -> Double
glyphPos Int
posx Int
posy
| Int
posx forall a. Eq a => a -> a -> Bool
== Int
0 = Double
0
| Int
posx forall a. Eq a => a -> a -> Bool
== Int -> Int
lineLen Int
posy = GlyphPos -> Double
_glpXMax (forall a. Seq a -> Int -> a
Seq.index (Int -> Seq GlyphPos
glyphs Int
posy) (Int
posx forall a. Num a => a -> a -> a
- Int
1))
| Bool
otherwise = GlyphPos -> Double
_glpXMin (forall a. Seq a -> Int -> a
Seq.index (Int -> Seq GlyphPos
glyphs Int
posy) Int
posx)
((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
| forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (Int, Int)
currSel = ((Int, Int)
currPos, (Int, Int)
currSel)
| Bool
otherwise = ((Int, Int)
currSel, (Int, Int)
currPos)
totalH :: Double
totalH = Double
lineh forall a. Num a => a -> a -> a
+ Double
spaceV
updateRect :: b -> b
updateRect b
rect = b
rect
forall a b. a -> (a -> b) -> b
& forall s a. HasY s a => Lens' s a
L.y forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Double
spaceV
forall a b. a -> (a -> b) -> b
& forall s a. HasH s a => Lens' s a
L.h forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
totalH
forall a b. a -> (a -> b) -> b
& forall s a. HasW s a => Lens' s a
L.w forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => a -> a -> a
max b
5
makeRect :: Int -> Int -> Int -> Rect
makeRect Int
cx1 Int
cx2 Int
cy = Double -> Double -> Double -> Double -> Rect
Rect Double
rx Double
ry Double
rw Double
rh where
rx :: Double
rx = Int -> Int -> Double
glyphPos Int
cx1 Int
cy
rw :: Double
rw = Int -> Int -> Double
glyphPos Int
cx2 Int
cy forall a. Num a => a -> a -> a
- Double
rx
ry :: Double
ry = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cy forall a. Num a => a -> a -> a
* Double
totalH forall a. Num a => a -> a -> a
- Double
spaceV
rh :: Double
rh = Double
totalH
rects :: [Rect]
rects
| Int
selY1 forall a. Eq a => a -> a -> Bool
== Int
selY2 = [Int -> Int -> Int -> Rect
makeRect Int
selX1 Int
selX2 Int
selY1]
| Bool
otherwise = Rect
begin forall a. a -> [a] -> [a]
: [Rect]
middle forall a. [a] -> [a] -> [a]
++ [Rect]
end where
begin :: Rect
begin = Int -> Int -> Int -> Rect
makeRect Int
selX1 (Int -> Int
lineLen Int
selY1) Int
selY1
middleLines :: Seq TextLine
middleLines = forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY1 forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Seq a -> Seq a
Seq.take Int
selY2 forall a b. (a -> b) -> a -> b
$ Seq TextLine
textLines
middle :: [Rect]
middle = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall {b} {b}.
(HasY b Double, HasH b Double, HasW b b, Ord b, Num b) =>
b -> b
updateRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasRect s a => Lens' s a
L.rect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
middleLines)
end :: [Rect]
end = [Int -> Int -> Int -> Rect
makeRect Int
0 Int
selX2 Int
selY2]
stateFromText
:: WidgetEnv s e -> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText :: forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
text = TextAreaState
newState where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFontManager s a => Lens' s a
L.fontManager
newTextMetrics :: TextMetrics
newTextMetrics = forall s e. WidgetEnv s e -> StyleState -> TextMetrics
getTextMetrics WidgetEnv s e
wenv StyleState
style
tmpTextLines :: Seq TextLine
tmpTextLines = FontManager
-> StyleState -> Double -> TextTrim -> Text -> Seq TextLine
fitTextToWidth FontManager
fontMgr StyleState
style forall a. RealFloat a => a
maxNumericValue TextTrim
KeepSpaces Text
text
totalH :: Double
totalH = TextMetrics
newTextMetrics forall s a. s -> Getting a s a -> a
^. forall s a. HasLineH s a => Lens' s a
L.lineH forall a. Num a => a -> a -> a
+ Seq TextLine -> Double
getSpaceV Seq TextLine
tmpTextLines
lastRect :: Rect
lastRect = forall a. Default a => a
def
forall a b. a -> (a -> b) -> b
& forall s a. HasY s a => Lens' s a
L.y forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
tmpTextLines) forall a. Num a => a -> a -> a
* Double
totalH
forall a b. a -> (a -> b) -> b
& forall s a. HasH s a => Lens' s a
L.h forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
totalH
lastTextLine :: TextLine
lastTextLine = forall a. Default a => a
def
forall a b. a -> (a -> b) -> b
& forall s a. HasRect s a => Lens' s a
L.rect forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
lastRect
forall a b. a -> (a -> b) -> b
& forall s a. HasSize s a => Lens' s a
L.size forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Double -> Size
Size Double
0 (Rect
lastRect forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h)
newTextLines :: Seq TextLine
newTextLines
| Text -> Text -> Bool
T.isSuffixOf Text
"\n" Text
text = Seq TextLine
tmpTextLines forall a. Seq a -> a -> Seq a
|> TextLine
lastTextLine
| Bool
otherwise = Seq TextLine
tmpTextLines
newState :: TextAreaState
newState = TextAreaState
state {
_tasText :: Text
_tasText = Text
text,
_tasTextMetrics :: TextMetrics
_tasTextMetrics = TextMetrics
newTextMetrics,
_tasTextStyle :: Maybe TextStyle
_tasTextStyle = StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text,
_tasTextLines :: Seq TextLine
_tasTextLines = Seq TextLine
newTextLines
}
textFromState :: Seq TextLine -> Text
textFromState :: Seq TextLine -> Text
textFromState Seq TextLine
textLines = [Text] -> Text
T.unlines [Text]
lines where
lines :: [Text]
lines = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasText s a => Lens' s a
L.text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines)
addHistory :: TextAreaState -> Bool -> TextAreaState
addHistory :: TextAreaState -> Bool -> TextAreaState
addHistory TextAreaState
state Bool
False = TextAreaState
state
addHistory TextAreaState
state Bool
_ = TextAreaState
newState where
text :: Text
text = TextAreaState -> Text
_tasText TextAreaState
state
curPos :: (Int, Int)
curPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
selStart :: Maybe (Int, Int)
selStart = TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state
prevStepIdx :: Int
prevStepIdx = TextAreaState -> Int
_tasHistoryIdx TextAreaState
state
prevSteps :: Seq HistoryStep
prevSteps = TextAreaState -> Seq HistoryStep
_tasHistory TextAreaState
state
steps :: Seq HistoryStep
steps = forall a. Int -> Seq a -> Seq a
Seq.take Int
prevStepIdx Seq HistoryStep
prevSteps
newState :: TextAreaState
newState = TextAreaState
state {
_tasHistory :: Seq HistoryStep
_tasHistory = Seq HistoryStep
steps forall a. Seq a -> a -> Seq a
|> Text -> (Int, Int) -> Maybe (Int, Int) -> HistoryStep
HistoryStep Text
text (Int, Int)
curPos Maybe (Int, Int)
selStart,
_tasHistoryIdx :: Int
_tasHistoryIdx = Int
prevStepIdx forall a. Num a => a -> a -> a
+ Int
1
}
restoreHistory
:: WidgetEnv s e -> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory :: forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Int -> TextAreaState
restoreHistory WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Int
idx
| Int
idx forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq HistoryStep
hist Bool -> Bool -> Bool
&& Int
idx forall a. Eq a => a -> a -> Bool
/= Int
histIdx = TextAreaState
newState
| Bool
otherwise = TextAreaState
state
where
hist :: Seq HistoryStep
hist = TextAreaState -> Seq HistoryStep
_tasHistory TextAreaState
state
histIdx :: Int
histIdx = TextAreaState -> Int
_tasHistoryIdx TextAreaState
state
HistoryStep Text
text (Int, Int)
curPos Maybe (Int, Int)
selStart = forall a. Seq a -> Int -> a
Seq.index Seq HistoryStep
hist Int
idx
tmpState :: TextAreaState
tmpState = forall s e.
WidgetEnv s e
-> WidgetNode s e -> TextAreaState -> Text -> TextAreaState
stateFromText WidgetEnv s e
wenv WidgetNode s e
node TextAreaState
state Text
text
newState :: TextAreaState
newState = TextAreaState
tmpState {
_tasCursorPos :: (Int, Int)
_tasCursorPos = (Int, Int)
curPos,
_tasSelStart :: Maybe (Int, Int)
_tasSelStart = Maybe (Int, Int)
selStart,
_tasHistoryIdx :: Int
_tasHistoryIdx = Int
idx
}
getSelection
:: TextAreaState
-> Maybe Text
getSelection :: TextAreaState -> Maybe Text
getSelection TextAreaState
state = Maybe Text
result where
currPos :: (Int, Int)
currPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
currSel :: (Int, Int)
currSel = forall a. HasCallStack => Maybe a -> a
fromJust (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state)
textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
oldLines :: Seq Text
oldLines = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasText s a => Lens' s a
L.text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines
((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
| forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (Int, Int)
currSel = ((Int, Int)
currPos, (Int, Int)
currSel)
| Bool
otherwise = ((Int, Int)
currSel, (Int, Int)
currPos)
newText :: Text
newText
| Int
selY1 forall a. Eq a => a -> a -> Bool
== Int
selY2 = Text
singleLine
| Int
selX2 forall a. Eq a => a -> a -> Bool
== Int
0 = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Text
begin forall a. a -> Seq a -> Seq a
:<| Seq Text
middle
| Bool
otherwise = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Text
begin forall a. a -> Seq a -> Seq a
:<| (Seq Text
middle forall a. Seq a -> a -> Seq a
:|> Text
end)
where
singleLine :: Text
singleLine = Int -> Text -> Text
T.drop Int
selX1 forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
selX2 (forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1)
begin :: Text
begin = Int -> Text -> Text
T.drop Int
selX1 forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1
middle :: Seq Text
middle = forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY1 forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
Seq.take Int
selY2 Seq Text
oldLines
end :: Text
end = Int -> Text -> Text
T.take Int
selX2 forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY2
result :: Maybe Text
result
| forall a. Maybe a -> Bool
isJust (TextAreaState -> Maybe (Int, Int)
_tasSelStart TextAreaState
state) = forall a. a -> Maybe a
Just Text
newText
| Bool
otherwise = forall a. Maybe a
Nothing
replaceText
:: TextAreaState
-> Maybe (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceText :: TextAreaState
-> Maybe (Int, Int) -> Text -> (Text, (Int, Int), Maybe (Int, Int))
replaceText TextAreaState
state Maybe (Int, Int)
currSel Text
newTxt
| forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
currSel = Seq TextLine
-> (Int, Int)
-> (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection Seq TextLine
lines (Int, Int)
currPos (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
currSel) Text
newTxt
| Bool
otherwise = Seq TextLine
-> (Int, Int)
-> (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection Seq TextLine
lines (Int, Int)
currPos (Int, Int)
currPos Text
newTxt
where
currPos :: (Int, Int)
currPos = TextAreaState -> (Int, Int)
_tasCursorPos TextAreaState
state
lines :: Seq TextLine
lines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
replaceSelection
:: Seq TextLine
-> (Int, Int)
-> (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection :: Seq TextLine
-> (Int, Int)
-> (Int, Int)
-> Text
-> (Text, (Int, Int), Maybe (Int, Int))
replaceSelection Seq TextLine
textLines (Int, Int)
currPos (Int, Int)
currSel Text
addText = forall {a}. (Text, (Int, Int), Maybe a)
result where
oldLines :: Seq Text
oldLines = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasText s a => Lens' s a
L.text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines
((Int
selX1, Int
selY1), (Int
selX2, Int
selY2))
| forall a b. (a, b) -> (b, a)
swap (Int, Int)
currPos forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> (b, a)
swap (Int, Int)
currSel = ((Int, Int)
currPos, (Int, Int)
currSel)
| Bool
otherwise = ((Int, Int)
currSel, (Int, Int)
currPos)
prevLines :: Seq Text
prevLines = forall a. Int -> Seq a -> Seq a
Seq.take Int
selY1 Seq Text
oldLines
postLines :: Seq Text
postLines = forall a. Int -> Seq a -> Seq a
Seq.drop (Int
selY2 forall a. Num a => a -> a -> a
+ Int
1) Seq Text
oldLines
returnAdded :: Bool
returnAdded = Text -> Text -> Bool
T.isSuffixOf Text
"\n" Text
addText
linePre :: Text
linePre
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
oldLines forall a. Ord a => a -> a -> Bool
> Int
selY1 = Int -> Text -> Text
T.take Int
selX1 (forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY1)
| Bool
otherwise = Text
""
lineSuf :: Text
lineSuf
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
oldLines forall a. Ord a => a -> a -> Bool
> Int
selY2 = Int -> Text -> Text
T.drop Int
selX2 (forall a. Seq a -> Int -> a
Seq.index Seq Text
oldLines Int
selY2)
| Bool
otherwise = Text
""
addLines :: Seq Text
addLines
| Bool -> Bool
not Bool
returnAdded = forall a. [a] -> Seq a
Seq.fromList (Text -> [Text]
T.lines Text
addText)
| Bool
otherwise = forall a. [a] -> Seq a
Seq.fromList (Text -> [Text]
T.lines Text
addText) forall a. Seq a -> a -> Seq a
:|> Text
""
(Int
newX, Int
newY, Seq Text
midLines)
| forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Ord a => a -> a -> Bool
<= Int
1 = (Text -> Int
T.length (Text
linePre forall a. Semigroup a => a -> a -> a
<> Text
addText), Int
selY1, Seq Text
singleLine)
| Bool
otherwise = (Text -> Int
T.length Text
end, Int
selY1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Num a => a -> a -> a
- Int
1, Seq Text
multiline)
where
singleLine :: Seq Text
singleLine = forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Text
linePre forall a. Semigroup a => a -> a -> a
<> Text
addText forall a. Semigroup a => a -> a -> a
<> Text
lineSuf
begin :: Text
begin = forall a. Seq a -> Int -> a
Seq.index Seq Text
addLines Int
0
middle :: Seq Text
middle = forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
Seq.take (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Num a => a -> a -> a
- Int
1) Seq Text
addLines
end :: Text
end = forall a. Seq a -> Int -> a
Seq.index Seq Text
addLines (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
addLines forall a. Num a => a -> a -> a
- Int
1)
multiline :: Seq Text
multiline = (Text
linePre forall a. Semigroup a => a -> a -> a
<> Text
begin) forall a. a -> Seq a -> Seq a
:<| (Seq Text
middle forall a. Seq a -> a -> Seq a
:|> (Text
end forall a. Semigroup a => a -> a -> a
<> Text
lineSuf))
newLines :: Seq Text
newLines = Seq Text
prevLines forall a. Semigroup a => a -> a -> a
<> Seq Text
midLines forall a. Semigroup a => a -> a -> a
<> Seq Text
postLines
newText :: Text
newText = Int -> Text -> Text
T.dropEnd Int
1 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Text
newLines)
result :: (Text, (Int, Int), Maybe a)
result = (Text
newText, (Int
newX, Int
newY), forall a. Maybe a
Nothing)
findClosestGlyphPos :: TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos :: TextAreaState -> Point -> (Int, Int)
findClosestGlyphPos TextAreaState
state Point
point = (Int
newPos, Int
lineIdx) where
Point Double
x Double
y = Point
point
TextMetrics Double
_ Double
_ Double
lineh Double
_ = TextAreaState -> TextMetrics
_tasTextMetrics TextAreaState
state
textLines :: Seq TextLine
textLines = TextAreaState -> Seq TextLine
_tasTextLines TextAreaState
state
totalH :: Double
totalH = Double
lineh forall a. Num a => a -> a -> a
+ Seq TextLine -> Double
getSpaceV Seq TextLine
textLines
lineIdx :: Int
lineIdx = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines forall a. Num a => a -> a -> a
- Int
1) (forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
y forall a. Fractional a => a -> a -> a
/ Double
totalH))
lineGlyphs :: Seq GlyphPos
lineGlyphs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq TextLine
textLines = forall a. Seq a
Seq.empty
| Bool
otherwise = forall a. Seq a -> Int -> a
Seq.index (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasGlyphs s a => Lens' s a
L.glyphs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
textLines) Int
lineIdx
textLen :: Double
textLen = Seq GlyphPos -> Double
getGlyphsMax Seq GlyphPos
lineGlyphs
glyphs :: Seq GlyphPos
glyphs
| forall a. Seq a -> Bool
Seq.null Seq GlyphPos
lineGlyphs = forall a. Seq a
Seq.empty
| Bool
otherwise = Seq GlyphPos
lineGlyphs forall a. Seq a -> a -> Seq a
|> Char
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> GlyphPos
GlyphPos Char
' ' Double
0 Double
textLen Double
0 Double
0 Double
0 Double
0 Double
0
glyphStart :: a -> GlyphPos -> (a, Double)
glyphStart a
i GlyphPos
g = (a
i, forall a. Num a => a -> a
abs (GlyphPos -> Double
_glpXMin GlyphPos
g forall a. Num a => a -> a -> a
- Double
x))
pairs :: Seq (Int, Double)
pairs = forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex forall {a}. a -> GlyphPos -> (a, Double)
glyphStart Seq GlyphPos
glyphs
cpm :: (a, a) -> (a, a) -> Ordering
cpm (a
_, a
g1) (a
_, a
g2) = forall a. Ord a => a -> a -> Ordering
compare a
g1 a
g2
diffs :: Seq (Int, Double)
diffs = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cpm Seq (Int, Double)
pairs
newPos :: Int
newPos = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a b. (a, b) -> a
fst (forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq (Int, Double)
diffs)
getSpaceV :: Seq TextLine -> Double
getSpaceV :: Seq TextLine -> Double
getSpaceV Seq TextLine
textLines = Double
spaceV where
spaceV :: Double
spaceV = FontSpace -> Double
unFontSpace forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Default a => a
def (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasFontSpaceV s a => Lens' s a
L.fontSpaceV) (Seq TextLine
textLines forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0)
delim :: Char -> Bool
delim :: Char -> Bool
delim Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'.', Char
',', Char
'/', Char
'-', Char
':']