{-# 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 -- needed to properly create DeltaText for undo
  , TextInputState -> LBox
_textInputState_box          :: LBox -- we can always pull this from selection, but may as well store it
  , TextInputState -> TextZipper
_textInputState_zipper       :: TZ.TextZipper
  , TextInputState -> DisplayLines ()
_textInputState_displayLines :: TZ.DisplayLines ()
  --, _textInputState_selected :: Int -- WIP
} 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) }

-- TODO support shift selecting someday
-- TODO define behavior for when you click outside box or assert
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 }



-- TODO support shift selecting text someday meh
-- | returns zipper in TextInputState after keyboard input has been applied for single line entry (does not allow line breaks)
-- Bool indicates if there was any real input
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)

    -- TODO remove new line characters
    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
    -- empty boxes are used with line labels
    --guard $ lBox_area origBox > 0

    -- TODO would be nice to assert that this exists...
    (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