{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Manipulator.TextArea (
  TextAreaHandler(..)
  , makeTextAreaHandler
) where

import           Relude

import           Potato.Flow.Controller.Handler
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.Manipulator.Common
import           Potato.Flow.Llama
import           Potato.Flow.Math
import           Potato.Flow.Owl
import           Potato.Flow.OwlWorkspace
import           Potato.Flow.SElts
import           Potato.Flow.Types

import           Data.Default
import           Data.Dependent.Sum                        (DSum ((:=>)))
import qualified Data.IntMap                               as IM
import qualified Data.Map                                  as Map
import qualified Data.Text                                 as T


getSTextArea :: CanvasSelection -> (REltId, STextArea)
getSTextArea :: CanvasSelection -> (Int, STextArea)
getSTextArea CanvasSelection
selection = case SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl of
  SEltTextArea STextArea
stextarea -> (Int
rid, STextArea
stextarea)
  SElt
selt                   -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected SBox, got " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  where
    sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
selection
    rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl

data TextAreaHandler = TextAreaHandler {
    TextAreaHandler -> SomePotatoHandler
_textAreaHandler_prevHandler :: SomePotatoHandler
    , TextAreaHandler -> XY
_textAreaHandler_relCursor :: XY
  }

getCursorPosHelper :: CanvasSelection -> RelMouseDrag -> (XY, Bool)
getCursorPosHelper :: CanvasSelection -> RelMouseDrag -> (XY, Bool)
getCursorPosHelper CanvasSelection
selection (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
..}) = (XY, Bool)
r where
  (Int
_, STextArea {Bool
TextAreaMapping
LBox
_sTextArea_transparent :: STextArea -> Bool
_sTextArea_text :: STextArea -> TextAreaMapping
_sTextArea_box :: STextArea -> LBox
_sTextArea_transparent :: Bool
_sTextArea_text :: TextAreaMapping
_sTextArea_box :: LBox
..}) = CanvasSelection -> (Int, STextArea)
getSTextArea CanvasSelection
selection
  CanonicalLBox Bool
_ Bool
_ lbox :: LBox
lbox@(LBox XY
p (V2 Int
_ Int
_)) = LBox -> CanonicalLBox
canonicalLBox_from_lBox LBox
_sTextArea_box
  newrelpos :: XY
newrelpos = XY
_mouseDrag_to forall a. Num a => a -> a -> a
- XY
p
  clickinside :: Bool
clickinside = LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbox XY
_mouseDrag_to
  r :: (XY, Bool)
r = (XY
newrelpos, Bool
clickinside)

makeTextAreaHandler :: SomePotatoHandler -> CanvasSelection -> RelMouseDrag -> Bool -> TextAreaHandler
makeTextAreaHandler :: SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> Bool -> TextAreaHandler
makeTextAreaHandler SomePotatoHandler
prev CanvasSelection
selection RelMouseDrag
rmd Bool
creation = TextAreaHandler
r where
  (XY
newrelpos, Bool
_) = CanvasSelection -> RelMouseDrag -> (XY, Bool)
getCursorPosHelper CanvasSelection
selection RelMouseDrag
rmd
  r :: TextAreaHandler
r = TextAreaHandler {
    _textAreaHandler_prevHandler :: SomePotatoHandler
_textAreaHandler_prevHandler = SomePotatoHandler
prev
    -- we want the cursor at the beginning if we are creating TextAreaHandler right after creating a new text area
    , _textAreaHandler_relCursor :: XY
_textAreaHandler_relCursor = if Bool
creation then XY
0 else XY
newrelpos
  }

instance PotatoHandler TextAreaHandler where
  pHandlerName :: TextAreaHandler -> Text
pHandlerName TextAreaHandler
_ = Text
handlerName_textArea
  pHandlerDebugShow :: TextAreaHandler -> Text
pHandlerDebugShow TextAreaHandler
tah = Text
"TextAreaHandler, cursor: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (TextAreaHandler -> XY
_textAreaHandler_relCursor TextAreaHandler
tah)
  pHandleMouse :: TextAreaHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse TextAreaHandler
tah phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
      (XY
newrelpos, Bool
clickinside) = CanvasSelection -> RelMouseDrag -> (XY, Bool)
getCursorPosHelper CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd
    in
      case MouseDragState
_mouseDrag_state of
        MouseDragState
MouseDragState_Down -> Maybe PotatoHandlerOutput
r where
          r :: Maybe PotatoHandlerOutput
r = if Bool
clickinside
            then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
                _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler TextAreaHandler
tah {
                    _textAreaHandler_relCursor :: XY
_textAreaHandler_relCursor = XY
newrelpos
                  }
              }
            -- pass the input on to the base handler (so that you can interact with BoxHandler mouse manipulators too)
            else forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (TextAreaHandler -> SomePotatoHandler
_textAreaHandler_prevHandler TextAreaHandler
tah) PotatoHandlerInput
phi RelMouseDrag
rmd

        -- TODO "painting" mode someday
        MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange TextAreaHandler
tah
        MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange TextAreaHandler
tah
        MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange TextAreaHandler
tah

  pHandleKeyboard :: TextAreaHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard TextAreaHandler
tah PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} (KeyboardData KeyboardKey
k [KeyModifier]
_) = let
      (Int
rid, STextArea {Bool
TextAreaMapping
LBox
_sTextArea_transparent :: Bool
_sTextArea_text :: TextAreaMapping
_sTextArea_box :: LBox
_sTextArea_transparent :: STextArea -> Bool
_sTextArea_text :: STextArea -> TextAreaMapping
_sTextArea_box :: STextArea -> LBox
..}) = CanvasSelection -> (Int, STextArea)
getSTextArea CanvasSelection
_potatoHandlerInput_canvasSelection
      CanonicalLBox Bool
_ Bool
_ (LBox XY
_ (V2 Int
width Int
height)) = LBox -> CanonicalLBox
canonicalLBox_from_lBox LBox
_sTextArea_box
      wrapBox :: XY -> XY
wrapBox (V2 Int
x Int
y) = forall a. a -> a -> V2 a
V2 (Int
x forall a. Integral a => a -> a -> a
`mod` Int
width) (Int
y forall a. Integral a => a -> a -> a
`mod` Int
height)


      getCursorChar :: TextAreaHandler -> Maybe PChar
getCursorChar TextAreaHandler
h = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (TextAreaHandler -> XY
_textAreaHandler_relCursor TextAreaHandler
h) TextAreaMapping
_sTextArea_text
      -- combinators
      start :: (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start = (forall k a. Map k a
Map.empty, TextAreaHandler
tah)
      finish :: (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish (Map XY (Maybe PChar, Maybe PChar)
mc, TextAreaHandler
h) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
          _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler TextAreaHandler
h
          , _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map XY (Maybe PChar, Maybe PChar)
mc
            then forall a. Maybe a
Nothing
            -- TODO if you store mc in TextAreaHandler you can continue to build on it which would allow you to set "undoFirst" paremeter to True
            else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
False, OwlPFCmd -> Llama
makePFCLlama forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton Int
rid DSum CTag Identity
controller)
        } where
          controller :: DSum CTag Identity
controller = CTag CTextArea
CTagTextArea forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> (forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ DeltaTextArea -> CTextArea
CTextArea (Map XY (Maybe PChar, Maybe PChar) -> DeltaTextArea
DeltaTextArea Map XY (Maybe PChar, Maybe PChar)
mc))
      moveAndWrap :: XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap XY
dp (Map XY (Maybe PChar, Maybe PChar)
mc, TextAreaHandler
h) = (Map XY (Maybe PChar, Maybe PChar)
mc, TextAreaHandler
h {
          _textAreaHandler_relCursor :: XY
_textAreaHandler_relCursor = XY -> XY
wrapBox forall a b. (a -> b) -> a -> b
$ (TextAreaHandler -> XY
_textAreaHandler_relCursor TextAreaHandler
tah) forall a. Num a => a -> a -> a
+ XY
dp
        })
      -- TODO
      setChar :: PChar
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
setChar PChar
c (Map XY (Maybe PChar, Maybe PChar)
mc, TextAreaHandler
h) = (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (TextAreaHandler -> XY
_textAreaHandler_relCursor TextAreaHandler
h) (TextAreaHandler -> Maybe PChar
getCursorChar TextAreaHandler
h, forall a. a -> Maybe a
Just PChar
c) Map XY (Maybe PChar, Maybe PChar)
mc, TextAreaHandler
h)
      deleteChar :: (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
deleteChar (Map XY (Maybe PChar, Maybe PChar)
mc, TextAreaHandler
h) = (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (TextAreaHandler -> XY
_textAreaHandler_relCursor TextAreaHandler
h) (TextAreaHandler -> Maybe PChar
getCursorChar TextAreaHandler
h, forall a. Maybe a
Nothing) Map XY (Maybe PChar, Maybe PChar)
mc, TextAreaHandler
h)


    in case KeyboardKey
k of
      KeyboardKey
KeyboardKey_Esc -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just (TextAreaHandler -> SomePotatoHandler
_textAreaHandler_prevHandler TextAreaHandler
tah) }
      KeyboardKey
KeyboardKey_Left -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 (-Int
1) Int
0) forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey
KeyboardKey_Right -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
.  XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 Int
1 Int
0) forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey
KeyboardKey_Down -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 Int
0 Int
1) forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey
KeyboardKey_Up -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 Int
0 (-Int
1)) forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey
KeyboardKey_Return  -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 Int
0 Int
1) forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey
KeyboardKey_Space   -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 Int
1 Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PChar
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
setChar PChar
' ' forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey
KeyboardKey_Delete  -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
deleteChar forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey
KeyboardKey_Backspace -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
deleteChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 (-Int
1) Int
0) forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey_Char PChar
c  -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 Int
1 Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PChar
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
setChar PChar
c forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start
      KeyboardKey_Paste Text
t -> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> Maybe PotatoHandlerOutput
finish forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
acc PChar
c -> XY
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
moveAndWrap (forall a. a -> a -> V2 a
V2 Int
1 Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PChar
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
-> (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
setChar PChar
c forall a b. (a -> b) -> a -> b
$ (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
acc) (Map XY (Maybe PChar, Maybe PChar), TextAreaHandler)
start (Text -> String
T.unpack Text
t)
      KeyboardKey
_ -> forall a. Maybe a
Nothing

  pRefreshHandler :: TextAreaHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler TextAreaHandler
_ PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = forall a. Maybe a
Nothing
  pRenderHandler :: TextAreaHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler TextAreaHandler
tah phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where

    -- TODO maybe version of this

    -- TODO maybe store instead of pull from selection?
    (Int
_, STextArea {Bool
TextAreaMapping
LBox
_sTextArea_transparent :: Bool
_sTextArea_text :: TextAreaMapping
_sTextArea_box :: LBox
_sTextArea_transparent :: STextArea -> Bool
_sTextArea_text :: STextArea -> TextAreaMapping
_sTextArea_box :: STextArea -> LBox
..}) = CanvasSelection -> (Int, STextArea)
getSTextArea CanvasSelection
_potatoHandlerInput_canvasSelection
    CanonicalLBox Bool
_ Bool
_ (LBox XY
p (V2 Int
_ Int
_)) = LBox -> CanonicalLBox
canonicalLBox_from_lBox LBox
_sTextArea_box
    cursor :: RenderHandle
cursor = RenderHandle {
        _renderHandle_box :: LBox
_renderHandle_box = XY -> XY -> LBox
LBox (XY
p forall a. Num a => a -> a -> a
+ TextAreaHandler -> XY
_textAreaHandler_relCursor TextAreaHandler
tah) (forall a. a -> a -> V2 a
V2 Int
1 Int
1)
        , _renderHandle_char :: Maybe PChar
_renderHandle_char = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (TextAreaHandler -> XY
_textAreaHandler_relCursor TextAreaHandler
tah) TextAreaMapping
_sTextArea_text
        , _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Default
      }
    r :: HandlerRenderOutput
r = forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (TextAreaHandler -> SomePotatoHandler
_textAreaHandler_prevHandler TextAreaHandler
tah) PotatoHandlerInput
phi forall a. Semigroup a => a -> a -> a
<>  [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle
cursor]
  pIsHandlerActive :: TextAreaHandler -> Bool
pIsHandlerActive TextAreaHandler
_ = Bool
False