{-# LANGUAGE RecordWildCards #-}
module Potato.Flow.Controller.Manipulator.TextInputState where
import Relude
import Potato.Flow.Math
import Potato.Flow.Serialization.Snake
import Potato.Flow.Controller.Input
import Potato.Flow.Controller.Handler
import qualified Data.Text as T
import qualified Potato.Data.Text.Zipper as TZ
import qualified Data.Map as Map
data TextInputState = TextInputState {
TextInputState -> Int
_textInputState_rid :: REltId
, TextInputState -> Maybe Text
_textInputState_original :: Maybe Text
, TextInputState -> LBox
_textInputState_box :: LBox
, TextInputState -> TextZipper
_textInputState_zipper :: TZ.TextZipper
, TextInputState -> DisplayLines ()
_textInputState_displayLines :: TZ.DisplayLines ()
} deriving (Int -> TextInputState -> ShowS
[TextInputState] -> ShowS
TextInputState -> String
(Int -> TextInputState -> ShowS)
-> (TextInputState -> String)
-> ([TextInputState] -> ShowS)
-> Show TextInputState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextInputState -> ShowS
showsPrec :: Int -> TextInputState -> ShowS
$cshow :: TextInputState -> String
show :: TextInputState -> String
$cshowList :: [TextInputState] -> ShowS
showList :: [TextInputState] -> ShowS
Show)
moveToEol :: TextInputState -> TextInputState
moveToEol :: TextInputState -> TextInputState
moveToEol TextInputState
tais = TextInputState
tais { _textInputState_zipper = TZ.end (_textInputState_zipper tais) }
mouseText :: TextInputState -> RelMouseDrag -> TextInputState
mouseText :: TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
tais RelMouseDrag
rmd = TextInputState
r where
lbox :: LBox
lbox = TextInputState -> LBox
_textInputState_box TextInputState
tais
RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
..} = RelMouseDrag
rmd
ogtz :: TextZipper
ogtz = TextInputState -> TextZipper
_textInputState_zipper TextInputState
tais
CanonicalLBox Bool
_ Bool
_ (LBox (V2 Int
x Int
y) (V2 Int
_ Int
_)) = LBox -> CanonicalLBox
canonicalLBox_from_lBox LBox
lbox
V2 Int
mousex Int
mousey = XY
_mouseDrag_to
newtz :: TextZipper
newtz = Int -> Int -> DisplayLines () -> TextZipper -> TextZipper
forall tag.
Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
TZ.goToDisplayLinePosition (Int
mousexInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) (Int
mouseyInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y) (TextInputState -> DisplayLines ()
_textInputState_displayLines TextInputState
tais) TextZipper
ogtz
r :: TextInputState
r = TextInputState
tais { _textInputState_zipper = newtz }
inputSingleLineZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputSingleLineZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputSingleLineZipper TextInputState
tais KeyboardKey
kk = (Bool
changed, TextInputState
tais { _textInputState_zipper = newZip }) where
oldZip :: TextZipper
oldZip = TextInputState -> TextZipper
_textInputState_zipper TextInputState
tais
(Bool
changed, TextZipper
newZip) = case KeyboardKey
kk of
KeyboardKey
KeyboardKey_Left -> (Bool
False, TextZipper -> TextZipper
TZ.left TextZipper
oldZip)
KeyboardKey
KeyboardKey_Right -> (Bool
False, TextZipper -> TextZipper
TZ.right TextZipper
oldZip)
KeyboardKey
KeyboardKey_Home -> (Bool
False, TextZipper -> TextZipper
TZ.home TextZipper
oldZip)
KeyboardKey
KeyboardKey_End -> (Bool
False, TextZipper -> TextZipper
TZ.end TextZipper
oldZip)
KeyboardKey
KeyboardKey_Space -> (Bool
True, Char -> TextZipper -> TextZipper
TZ.insertChar Char
' ' TextZipper
oldZip)
KeyboardKey
KeyboardKey_Delete -> (TextZipper
newtz TextZipper -> TextZipper -> Bool
forall a. Eq a => a -> a -> Bool
/= TextZipper
oldZip, TextZipper -> TextZipper
TZ.deleteRight TextZipper
oldZip) where newtz :: TextZipper
newtz = TextZipper -> TextZipper
TZ.deleteRight TextZipper
oldZip
KeyboardKey
KeyboardKey_Backspace -> (TextZipper
newtz TextZipper -> TextZipper -> Bool
forall a. Eq a => a -> a -> Bool
/= TextZipper
oldZip, TextZipper
newtz) where newtz :: TextZipper
newtz = TextZipper -> TextZipper
TZ.deleteLeft TextZipper
oldZip
KeyboardKey_Char Char
c -> (Bool
True, Char -> TextZipper -> TextZipper
TZ.insertChar Char
c TextZipper
oldZip)
KeyboardKey_Paste Text
t -> (Bool
True, Text -> TextZipper -> TextZipper
TZ.insert Text
t TextZipper
oldZip)
KeyboardKey
_ -> (Bool
False, TextZipper
oldZip)
makeTextHandlerRenderOutput :: TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput :: TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput TextInputState
btis = HandlerRenderOutput
r where
dls :: DisplayLines ()
dls = TextInputState -> DisplayLines ()
_textInputState_displayLines TextInputState
btis
(Int
x, Int
y) = DisplayLines () -> (Int, Int)
forall tag. DisplayLines tag -> (Int, Int)
TZ._displayLines_cursorPos DisplayLines ()
dls
offsetMap :: OffsetMapWithAlignment
offsetMap = DisplayLines () -> OffsetMapWithAlignment
forall tag. DisplayLines tag -> OffsetMapWithAlignment
TZ._displayLines_offsetMap DisplayLines ()
dls
mCursorChar :: Maybe Char
mCursorChar = (((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Maybe (Char, Text) -> Maybe Char)
-> (TextInputState -> Maybe (Char, Text))
-> TextInputState
-> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text))
-> (TextInputState -> Text) -> TextInputState -> Maybe (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper -> Text
TZ._textZipper_after (TextZipper -> Text)
-> (TextInputState -> TextZipper) -> TextInputState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextInputState -> TextZipper
_textInputState_zipper (TextInputState -> Maybe Char) -> TextInputState -> Maybe Char
forall a b. (a -> b) -> a -> b
$ TextInputState
btis
mlbox :: Maybe [RenderHandle]
mlbox = do
(Int
alignxoff,Int
_) <- Int -> OffsetMapWithAlignment -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
y OffsetMapWithAlignment
offsetMap
let
LBox XY
p XY
_ = TextInputState -> LBox
_textInputState_box (TextInputState -> LBox) -> TextInputState -> LBox
forall a b. (a -> b) -> a -> b
$ TextInputState
btis
cursorh :: RenderHandle
cursorh = RenderHandle {
_renderHandle_box :: LBox
_renderHandle_box = XY -> XY -> LBox
LBox (XY
p XY -> XY -> XY
forall a. Num a => a -> a -> a
+ (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
y)) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
, _renderHandle_char :: Maybe Char
_renderHandle_char = case Maybe Char
mCursorChar of
Maybe Char
Nothing -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
Maybe Char
x -> Maybe Char
x
, _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Default
}
[RenderHandle] -> Maybe [RenderHandle]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
return [RenderHandle
cursorh]
r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ([RenderHandle] -> HandlerRenderOutput)
-> [RenderHandle] -> HandlerRenderOutput
forall a b. (a -> b) -> a -> b
$ [RenderHandle] -> Maybe [RenderHandle] -> [RenderHandle]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RenderHandle]
mlbox