{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Manipulator.TextInputState where

import Relude

import           Potato.Flow.Math
import           Potato.Flow.SElts
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextInputState] -> ShowS
$cshowList :: [TextInputState] -> ShowS
show :: TextInputState -> String
$cshow :: TextInputState -> String
showsPrec :: Int -> TextInputState -> ShowS
$cshowsPrec :: Int -> TextInputState -> ShowS
Show)


moveToEol :: TextInputState -> TextInputState
moveToEol :: TextInputState -> TextInputState
moveToEol TextInputState
tais = TextInputState
tais { _textInputState_zipper :: TextZipper
_textInputState_zipper = TextZipper -> TextZipper
TZ.end (TextInputState -> TextZipper
_textInputState_zipper TextInputState
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_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
..} = 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 = forall tag.
Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
TZ.goToDisplayLinePosition (Int
mousexforall a. Num a => a -> a -> a
-Int
x) (Int
mouseyforall a. Num a => a -> a -> a
-Int
y) (TextInputState -> DisplayLines ()
_textInputState_displayLines TextInputState
tais) TextZipper
ogtz
  r :: TextInputState
r = TextInputState
tais { _textInputState_zipper :: TextZipper
_textInputState_zipper = TextZipper
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 :: TextZipper
_textInputState_zipper = TextZipper
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 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 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
  origBox :: LBox
origBox = TextInputState -> LBox
_textInputState_box forall a b. (a -> b) -> a -> b
$ TextInputState
btis
  (Int
x, Int
y) = forall tag. DisplayLines tag -> (Int, Int)
TZ._displayLines_cursorPos DisplayLines ()
dls
  offsetMap :: OffsetMapWithAlignment
offsetMap = forall tag. DisplayLines tag -> OffsetMapWithAlignment
TZ._displayLines_offsetMap DisplayLines ()
dls

  mCursorChar :: Maybe Char
mCursorChar = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper -> Text
TZ._textZipper_after forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextInputState -> TextZipper
_textInputState_zipper 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
_) <- 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 forall a b. (a -> b) -> a -> b
$ TextInputState
btis
      cursorh :: RenderHandle
cursorh = RenderHandle {
          _renderHandle_box :: LBox
_renderHandle_box = XY -> XY -> LBox
LBox (XY
p forall a. Num a => a -> a -> a
+ (forall a. a -> a -> V2 a
V2 (Int
x forall a. Num a => a -> a -> a
+ Int
alignxoff) Int
y)) (forall a. a -> a -> V2 a
V2 Int
1 Int
1)
          , _renderHandle_char :: Maybe Char
_renderHandle_char = Maybe Char
mCursorChar
          , _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Default
        }
    forall (m :: * -> *) a. Monad m => a -> m a
return [RenderHandle
cursorh]

  r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] Maybe [RenderHandle]
mlbox