module Reflex.Vty.Widget.Input.Text
( module Reflex.Vty.Widget.Input.Text
, def
) where
import Control.Monad (join)
import Control.Monad.Fix (MonadFix)
import Data.Default (Default(..))
import Data.Function ((&))
import Data.Text (Text)
import Data.Text.Zipper
import qualified Graphics.Vty as V
import Reflex
import Reflex.Vty.Widget
import Reflex.Vty.Widget.Layout
import Reflex.Vty.Widget.Input.Mouse
data TextInputConfig t = TextInputConfig
{ TextInputConfig t -> TextZipper
_textInputConfig_initialValue :: TextZipper
, TextInputConfig t -> Event t (TextZipper -> TextZipper)
_textInputConfig_modify :: Event t (TextZipper -> TextZipper)
, TextInputConfig t -> Int
_textInputConfig_tabWidth :: Int
, TextInputConfig t -> Dynamic t (Char -> Char)
_textInputConfig_display :: Dynamic t (Char -> Char)
}
instance Reflex t => Default (TextInputConfig t) where
def :: TextInputConfig t
def = TextZipper
-> Event t (TextZipper -> TextZipper)
-> Int
-> Dynamic t (Char -> Char)
-> TextInputConfig t
forall k (t :: k).
TextZipper
-> Event t (TextZipper -> TextZipper)
-> Int
-> Dynamic t (Char -> Char)
-> TextInputConfig t
TextInputConfig TextZipper
empty Event t (TextZipper -> TextZipper)
forall k (t :: k) a. Reflex t => Event t a
never Int
4 ((Char -> Char) -> Dynamic t (Char -> Char)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char -> Char
forall a. a -> a
id)
data TextInput t = TextInput
{ TextInput t -> Dynamic t Text
_textInput_value :: Dynamic t Text
, TextInput t -> Event t TextZipper
_textInput_userInput :: Event t TextZipper
, TextInput t -> Dynamic t Int
_textInput_lines :: Dynamic t Int
}
textInput
:: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasTheme t m, HasDisplayRegion t m, HasImageWriter t m, HasDisplayRegion t m)
=> TextInputConfig t
-> m (TextInput t)
textInput :: TextInputConfig t -> m (TextInput t)
textInput TextInputConfig t
cfg = do
Event t VtyEvent
i <- m (Event t VtyEvent)
forall k (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
Dynamic t Bool
f <- m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *).
HasFocusReader t m =>
m (Dynamic t Bool)
focus
Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
Dynamic t Int
dw <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
Behavior t Attr
bt <- m (Behavior t Attr)
forall k (t :: k) (m :: * -> *).
HasTheme t m =>
m (Behavior t Attr)
theme
Attr
attr0 <- Behavior t Attr -> m Attr
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Attr
bt
rec
let valueChangedByCaller :: Event t (TextZipper -> TextZipper)
valueChangedByCaller = TextInputConfig t -> Event t (TextZipper -> TextZipper)
forall k (t :: k).
TextInputConfig t -> Event t (TextZipper -> TextZipper)
_textInputConfig_modify TextInputConfig t
cfg
let valueChangedByUI :: Event t (TextZipper -> TextZipper)
valueChangedByUI = ((TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper)
-> [Event t (TextZipper -> TextZipper)]
-> Event t (TextZipper -> TextZipper)
forall k (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
[ (Int -> VtyEvent -> TextZipper -> TextZipper)
-> (Int, VtyEvent) -> TextZipper -> TextZipper
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Int -> VtyEvent -> TextZipper -> TextZipper
updateTextZipper (TextInputConfig t -> Int
forall k (t :: k). TextInputConfig t -> Int
_textInputConfig_tabWidth TextInputConfig t
cfg)) ((Int, VtyEvent) -> TextZipper -> TextZipper)
-> Event t (Int, VtyEvent) -> Event t (TextZipper -> TextZipper)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Int -> Event t VtyEvent -> Event t (Int, VtyEvent)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh) Event t VtyEvent
i
, let displayInfo :: Behavior t (DisplayLines Attr, Int)
displayInfo = (,) (DisplayLines Attr -> Int -> (DisplayLines Attr, Int))
-> Behavior t (DisplayLines Attr)
-> Behavior t (Int -> (DisplayLines Attr, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr) -> Behavior t (DisplayLines Attr)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (DisplayLines Attr)
rows Behavior t (Int -> (DisplayLines Attr, Int))
-> Behavior t Int -> Behavior t (DisplayLines Attr, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Int
scrollTop
in Event t ((DisplayLines Attr, Int), MouseDown)
-> (((DisplayLines Attr, Int), MouseDown)
-> TextZipper -> TextZipper)
-> Event t (TextZipper -> TextZipper)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Behavior t (DisplayLines Attr, Int)
-> Event t MouseDown
-> Event t ((DisplayLines Attr, Int), MouseDown)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach Behavior t (DisplayLines Attr, Int)
displayInfo Event t MouseDown
click) ((((DisplayLines Attr, Int), MouseDown)
-> TextZipper -> TextZipper)
-> Event t (TextZipper -> TextZipper))
-> (((DisplayLines Attr, Int), MouseDown)
-> TextZipper -> TextZipper)
-> Event t (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ \((DisplayLines Attr
dl, Int
st), MouseDown Button
_ (Int
mx, Int
my) [Modifier]
_) ->
Int -> Int -> DisplayLines Attr -> TextZipper -> TextZipper
forall tag.
Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
goToDisplayLinePosition Int
mx (Int
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
my) DisplayLines Attr
dl
]
Dynamic t TextZipper
v <- ((TextZipper -> TextZipper) -> TextZipper -> TextZipper)
-> TextZipper
-> Event t (TextZipper -> TextZipper)
-> m (Dynamic t TextZipper)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
($) (TextInputConfig t -> TextZipper
forall k (t :: k). TextInputConfig t -> TextZipper
_textInputConfig_initialValue TextInputConfig t
cfg) (Event t (TextZipper -> TextZipper) -> m (Dynamic t TextZipper))
-> Event t (TextZipper -> TextZipper) -> m (Dynamic t TextZipper)
forall a b. (a -> b) -> a -> b
$ ((TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper)
-> [Event t (TextZipper -> TextZipper)]
-> Event t (TextZipper -> TextZipper)
forall k (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
[ Event t (TextZipper -> TextZipper)
valueChangedByCaller
, Event t (TextZipper -> TextZipper)
valueChangedByUI
]
Event t MouseDown
click <- Button -> m (Event t MouseDown)
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft
let toCursorAttrs :: Attr -> Attr
toCursorAttrs Attr
attr = Attr -> Style -> Attr
V.withStyle Attr
attr Style
V.reverseVideo
rowInputDyn :: Dynamic t (Int, TextZipper, Bool)
rowInputDyn = (,,)
(Int -> TextZipper -> Bool -> (Int, TextZipper, Bool))
-> Dynamic t Int
-> Dynamic t (TextZipper -> Bool -> (Int, TextZipper, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw
Dynamic t (TextZipper -> Bool -> (Int, TextZipper, Bool))
-> Dynamic t TextZipper
-> Dynamic t (Bool -> (Int, TextZipper, Bool))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Char -> Char) -> TextZipper -> TextZipper
mapZipper ((Char -> Char) -> TextZipper -> TextZipper)
-> Dynamic t (Char -> Char) -> Dynamic t (TextZipper -> TextZipper)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextInputConfig t -> Dynamic t (Char -> Char)
forall k (t :: k). TextInputConfig t -> Dynamic t (Char -> Char)
_textInputConfig_display TextInputConfig t
cfg Dynamic t (TextZipper -> TextZipper)
-> Dynamic t TextZipper -> Dynamic t TextZipper
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t TextZipper
v)
Dynamic t (Bool -> (Int, TextZipper, Bool))
-> Dynamic t Bool -> Dynamic t (Int, TextZipper, Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Bool
f
toDisplayLines :: Attr -> (Int, TextZipper, Bool) -> DisplayLines Attr
toDisplayLines Attr
attr (Int
w, TextZipper
s, Bool
x) =
let c :: Attr
c = if Bool
x then Attr -> Attr
toCursorAttrs Attr
attr else Attr
attr
in Int -> Attr -> Attr -> TextZipper -> DisplayLines Attr
forall tag. Int -> tag -> tag -> TextZipper -> DisplayLines tag
displayLines Int
w Attr
attr Attr
c TextZipper
s
Dynamic t Attr
attrDyn <- Attr -> Event t Attr -> m (Dynamic t Attr)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Attr
attr0 (Event t Attr -> m (Dynamic t Attr))
-> Event t Attr -> m (Dynamic t Attr)
forall a b. (a -> b) -> a -> b
$ ((Int, TextZipper, Bool) -> PushM t Attr)
-> Event t (Int, TextZipper, Bool) -> Event t Attr
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t b) -> Event t a -> Event t b
pushAlways (\(Int, TextZipper, Bool)
_ -> Behavior t Attr -> PushM t Attr
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Attr
bt) (Dynamic t (Int, TextZipper, Bool)
-> Event t (Int, TextZipper, Bool)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Int, TextZipper, Bool)
rowInputDyn)
let rows :: Dynamic t (DisplayLines Attr)
rows = Dynamic t Attr
-> Dynamic t (Int, TextZipper, Bool)
-> (Attr -> (Int, TextZipper, Bool) -> DisplayLines Attr)
-> Dynamic t (DisplayLines Attr)
forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Attr
attrDyn Dynamic t (Int, TextZipper, Bool)
rowInputDyn Attr -> (Int, TextZipper, Bool) -> DisplayLines Attr
toDisplayLines
img :: Dynamic t [Image]
img = [[Span Attr]] -> [Image]
images ([[Span Attr]] -> [Image])
-> (DisplayLines Attr -> [[Span Attr]])
-> DisplayLines Attr
-> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayLines Attr -> [[Span Attr]]
forall tag. DisplayLines tag -> [[Span tag]]
_displayLines_spans (DisplayLines Attr -> [Image])
-> Dynamic t (DisplayLines Attr) -> Dynamic t [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr)
rows
Dynamic t Int
y <- Dynamic t Int -> m (Dynamic t Int)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Int -> m (Dynamic t Int))
-> Dynamic t Int -> m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int)
-> (DisplayLines Attr -> (Int, Int)) -> DisplayLines Attr -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> b
snd DisplayLines Attr -> (Int, Int)
forall tag. DisplayLines tag -> (Int, Int)
_displayLines_cursorPos (DisplayLines Attr -> Int)
-> Dynamic t (DisplayLines Attr) -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr)
rows
let newScrollTop :: Int -> (Int, Int) -> Int
newScrollTop :: Int -> (Int, Int) -> Int
newScrollTop Int
st (Int
h, Int
cursorY)
| Int
cursorY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
st = Int
cursorY
| Int
cursorY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h = Int
cursorY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
| Bool
otherwise = Int
st
let hy :: Event t Int
hy = (Int -> (Int, Int) -> Int)
-> Behavior t Int -> Event t (Int, Int) -> Event t Int
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith Int -> (Int, Int) -> Int
newScrollTop Behavior t Int
scrollTop (Event t (Int, Int) -> Event t Int)
-> Event t (Int, Int) -> Event t Int
forall a b. (a -> b) -> a -> b
$ Dynamic t (Int, Int) -> Event t (Int, Int)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated (Dynamic t (Int, Int) -> Event t (Int, Int))
-> Dynamic t (Int, Int) -> Event t (Int, Int)
forall a b. (a -> b) -> a -> b
$ Dynamic t Int -> Dynamic t Int -> Dynamic t (Int, Int)
forall k (t :: k) a b.
Reflex t =>
Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
zipDyn Dynamic t Int
dh Dynamic t Int
y
Behavior t Int
scrollTop <- Int -> Event t Int -> m (Behavior t Int)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Int
0 Event t Int
hy
Behavior t [Image] -> m ()
forall k (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (Behavior t [Image] -> m ()) -> Behavior t [Image] -> m ()
forall a b. (a -> b) -> a -> b
$ (\[Image]
imgs Int
st -> (Image -> [Image] -> [Image]
forall a. a -> [a] -> [a]
:[]) (Image -> [Image]) -> ([Image] -> Image) -> [Image] -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image] -> Image
V.vertCat ([Image] -> [Image]) -> [Image] -> [Image]
forall a b. (a -> b) -> a -> b
$ Int -> [Image] -> [Image]
forall a. Int -> [a] -> [a]
drop Int
st [Image]
imgs) ([Image] -> Int -> [Image])
-> Behavior t [Image] -> Behavior t (Int -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t [Image] -> Behavior t [Image]
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t [Image]
img Behavior t (Int -> [Image]) -> Behavior t Int -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Int
scrollTop
TextInput t -> m (TextInput t)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextInput t -> m (TextInput t)) -> TextInput t -> m (TextInput t)
forall a b. (a -> b) -> a -> b
$ TextInput :: forall k (t :: k).
Dynamic t Text
-> Event t TextZipper -> Dynamic t Int -> TextInput t
TextInput
{ _textInput_value :: Dynamic t Text
_textInput_value = TextZipper -> Text
value (TextZipper -> Text) -> Dynamic t TextZipper -> Dynamic t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t TextZipper
v
, _textInput_userInput :: Event t TextZipper
_textInput_userInput = (TextZipper -> (TextZipper -> TextZipper) -> TextZipper)
-> Behavior t TextZipper
-> Event t (TextZipper -> TextZipper)
-> Event t TextZipper
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith TextZipper -> (TextZipper -> TextZipper) -> TextZipper
forall a b. a -> (a -> b) -> b
(&) (Dynamic t TextZipper -> Behavior t TextZipper
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t TextZipper
v) Event t (TextZipper -> TextZipper)
valueChangedByUI
, _textInput_lines :: Dynamic t Int
_textInput_lines = [[Span Attr]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Span Attr]] -> Int)
-> (DisplayLines Attr -> [[Span Attr]]) -> DisplayLines Attr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayLines Attr -> [[Span Attr]]
forall tag. DisplayLines tag -> [[Span tag]]
_displayLines_spans (DisplayLines Attr -> Int)
-> Dynamic t (DisplayLines Attr) -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr)
rows
}
multilineTextInput
:: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasTheme t m, HasDisplayRegion t m, HasImageWriter t m)
=> TextInputConfig t
-> m (TextInput t)
multilineTextInput :: TextInputConfig t -> m (TextInput t)
multilineTextInput TextInputConfig t
cfg = do
Event t VtyEvent
i <- m (Event t VtyEvent)
forall k (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
TextInputConfig t -> m (TextInput t)
forall k (t :: k) (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m,
HasFocusReader t m, HasTheme t m, HasDisplayRegion t m,
HasImageWriter t m, HasDisplayRegion t m) =>
TextInputConfig t -> m (TextInput t)
textInput (TextInputConfig t -> m (TextInput t))
-> TextInputConfig t -> m (TextInput t)
forall a b. (a -> b) -> a -> b
$ TextInputConfig t
cfg
{ _textInputConfig_modify :: Event t (TextZipper -> TextZipper)
_textInputConfig_modify = ((TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper)
-> [Event t (TextZipper -> TextZipper)]
-> Event t (TextZipper -> TextZipper)
forall k (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
[ Event t VtyEvent
-> (VtyEvent -> Maybe (TextZipper -> TextZipper))
-> Event t (TextZipper -> TextZipper)
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
i ((VtyEvent -> Maybe (TextZipper -> TextZipper))
-> Event t (TextZipper -> TextZipper))
-> (VtyEvent -> Maybe (TextZipper -> TextZipper))
-> Event t (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ \case
V.EvKey Key
V.KEnter [] -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ Text -> TextZipper -> TextZipper
insert Text
"\n"
VtyEvent
_ -> Maybe (TextZipper -> TextZipper)
forall a. Maybe a
Nothing
, TextInputConfig t -> Event t (TextZipper -> TextZipper)
forall k (t :: k).
TextInputConfig t -> Event t (TextZipper -> TextZipper)
_textInputConfig_modify TextInputConfig t
cfg
]
}
textInputTile
:: (MonadFix m, MonadHold t m, HasLayout t m, HasInput t m, HasFocus t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m, HasTheme t m)
=> m (TextInput t)
-> Dynamic t Int
-> m (TextInput t)
textInputTile :: m (TextInput t) -> Dynamic t Int -> m (TextInput t)
textInputTile m (TextInput t)
txt Dynamic t Int
width = do
Dynamic t Orientation
o <- m (Dynamic t Orientation)
forall k (t :: k) (m :: * -> *).
HasLayout t m =>
m (Dynamic t Orientation)
askOrientation
rec TextInput t
t <- Dynamic t Constraint -> m (TextInput t) -> m (TextInput t)
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile (Int -> Constraint
Constraint_Fixed (Int -> Constraint) -> Dynamic t Int -> Dynamic t Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
sz) m (TextInput t)
txt
let sz :: Dynamic t Int
sz = Dynamic t (Dynamic t Int) -> Dynamic t Int
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Dynamic t (Dynamic t Int) -> Dynamic t Int)
-> Dynamic t (Dynamic t Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ Dynamic t Orientation
-> (Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Orientation
o ((Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int))
-> (Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ \case
Orientation
Orientation_Column -> TextInput t -> Dynamic t Int
forall k (t :: k). TextInput t -> Dynamic t Int
_textInput_lines TextInput t
t
Orientation
Orientation_Row -> Dynamic t Int
width
TextInput t -> m (TextInput t)
forall (m :: * -> *) a. Monad m => a -> m a
return TextInput t
t
images :: [[Span V.Attr]] -> [V.Image]
images :: [[Span Attr]] -> [Image]
images = ([Span Attr] -> Image) -> [[Span Attr]] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map ([Image] -> Image
V.horizCat ([Image] -> Image)
-> ([Span Attr] -> [Image]) -> [Span Attr] -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span Attr -> Image) -> [Span Attr] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map Span Attr -> Image
spanToImage)
image :: [[Span V.Attr]] -> V.Image
image :: [[Span Attr]] -> Image
image = [Image] -> Image
V.vertCat ([Image] -> Image)
-> ([[Span Attr]] -> [Image]) -> [[Span Attr]] -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Span Attr]] -> [Image]
images
spanToImage :: Span V.Attr -> V.Image
spanToImage :: Span Attr -> Image
spanToImage (Span Attr
attrs Text
t) = Attr -> Text -> Image
V.text' Attr
attrs Text
t
updateTextZipper
:: Int
-> Int
-> V.Event
-> TextZipper
-> TextZipper
updateTextZipper :: Int -> Int -> VtyEvent -> TextZipper -> TextZipper
updateTextZipper Int
tabWidth Int
pageSize VtyEvent
ev = case VtyEvent
ev of
V.EvKey (V.KChar Char
'\t') [] -> Int -> TextZipper -> TextZipper
tab Int
tabWidth
V.EvKey (V.KChar Char
k) [] -> Char -> TextZipper -> TextZipper
insertChar Char
k
V.EvKey Key
V.KBS [] -> TextZipper -> TextZipper
deleteLeft
V.EvKey Key
V.KDel [] -> TextZipper -> TextZipper
deleteRight
V.EvKey (V.KChar Char
'u') [Modifier
V.MCtrl] -> TextZipper -> TextZipper -> TextZipper
forall a b. a -> b -> a
const TextZipper
empty
V.EvKey (V.KChar Char
'w') [Modifier
V.MCtrl] -> TextZipper -> TextZipper
deleteLeftWord
V.EvKey Key
V.KLeft [] -> TextZipper -> TextZipper
left
V.EvKey Key
V.KRight [] -> TextZipper -> TextZipper
right
V.EvKey Key
V.KUp [] -> TextZipper -> TextZipper
up
V.EvKey Key
V.KDown [] -> TextZipper -> TextZipper
down
V.EvKey Key
V.KHome [] -> TextZipper -> TextZipper
home
V.EvKey Key
V.KEnd [] -> TextZipper -> TextZipper
end
V.EvKey Key
V.KPageUp [] -> Int -> TextZipper -> TextZipper
pageUp Int
pageSize
V.EvKey Key
V.KPageDown [] -> Int -> TextZipper -> TextZipper
pageDown Int
pageSize
VtyEvent
_ -> TextZipper -> TextZipper
forall a. a -> a
id