{-# LANGUAGE RecordWildCards #-}

-- TODO probably move this to Manipulator.Box.Text
module Potato.Flow.Controller.Manipulator.BoxText (
  BoxTextHandler(..)
  , TextInputState(..)
  , makeBoxTextHandler
  , BoxLabelHandler(..)
  , makeBoxLabelHandler
  , lBox_to_boxLabelBox

  -- exposed for testing
  , makeTextInputState
  , mouseText

) where

import           Relude

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

import           Control.Exception
import           Data.Default
import           Data.Dependent.Sum                        (DSum ((:=>)))
import qualified Data.IntMap                               as IM
import qualified Data.Sequence                             as Seq
import qualified Potato.Data.Text.Zipper                          as TZ
import qualified Text.Pretty.Simple as Pretty
import qualified Data.Text.Lazy as LT

getSBox :: CanvasSelection -> (REltId, SBox)
getSBox :: CanvasSelection -> (Int, SBox)
getSBox CanvasSelection
selection = case SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl of
  SEltBox SBox
sbox -> (Int
rid, SBox
sbox)
  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

-- | shrink an LBox uniformly in each direction, but don't allow it to become negative
shrink_lBox_no_negative :: LBox -> Int -> Int -> LBox
shrink_lBox_no_negative :: LBox -> Int -> Int -> LBox
shrink_lBox_no_negative (LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) Int
dw Int
dh = V2 Int -> V2 Int -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
nx Int
ny) (forall a. a -> a -> V2 a
V2 Int
nw Int
nh) where
  (Int
nx, Int
nw) = if Int
w forall a. Ord a => a -> a -> Bool
<= Int
2forall a. Num a => a -> a -> a
*Int
dw 
    then if Int
w forall a. Ord a => a -> a -> Bool
<= Int
dw 
      -- prioritize shrinking from the right
      then (Int
x, Int
0)
      else (Int
x forall a. Num a => a -> a -> a
+ (Int
w forall a. Num a => a -> a -> a
- Int
dw), Int
0)
    else (Int
xforall a. Num a => a -> a -> a
+Int
dw, Int
wforall a. Num a => a -> a -> a
-Int
2forall a. Num a => a -> a -> a
*Int
dw)
  (Int
ny, Int
nh) = if Int
h forall a. Ord a => a -> a -> Bool
<= Int
2forall a. Num a => a -> a -> a
*Int
dh
    then if Int
h forall a. Ord a => a -> a -> Bool
<= Int
dh
      -- prioritize shrinking from the bottom
      then (Int
y, Int
0)
      else (Int
y forall a. Num a => a -> a -> a
+ (Int
h forall a. Num a => a -> a -> a
- Int
dh), Int
0)
    else (Int
yforall a. Num a => a -> a -> a
+Int
dh, Int
hforall a. Num a => a -> a -> a
-Int
2forall a. Num a => a -> a -> a
*Int
dh)


getSBoxTextBox :: SBox -> CanonicalLBox 
getSBoxTextBox :: SBox -> CanonicalLBox
getSBoxTextBox SBox
sbox = CanonicalLBox
r where
  CanonicalLBox Bool
fx Bool
fy LBox
box' = LBox -> CanonicalLBox
canonicalLBox_from_lBox forall a b. (a -> b) -> a -> b
$ SBox -> LBox
_sBox_box SBox
sbox
  r :: CanonicalLBox
r = Bool -> Bool -> LBox -> CanonicalLBox
CanonicalLBox Bool
fx Bool
fy forall a b. (a -> b) -> a -> b
$  if SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox)
    then LBox -> Int -> Int -> LBox
shrink_lBox_no_negative LBox
box' Int
1 Int
1
    else LBox
box'


updateTextInputStateWithSBox :: SBox -> TextInputState -> TextInputState
updateTextInputStateWithSBox :: SBox -> TextInputState -> TextInputState
updateTextInputStateWithSBox SBox
sbox TextInputState
btis = TextInputState
r where
  alignment :: TextAlignment
alignment = TextAlign -> TextAlignment
convertTextAlignToTextZipperTextAlignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> TextAlign
_textStyle_alignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxText -> TextStyle
_sBoxText_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text forall a b. (a -> b) -> a -> b
$ SBox
sbox
  CanonicalLBox Bool
_ Bool
_ newBox :: LBox
newBox@(LBox V2 Int
_ (V2 Int
width Int
_)) = SBox -> CanonicalLBox
getSBoxTextBox SBox
sbox
  r :: TextInputState
r = TextInputState
btis {
      _textInputState_box :: LBox
_textInputState_box = LBox
newBox
      , _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
alignment Int
width () () (TextInputState -> TextZipper
_textInputState_zipper TextInputState
btis)
    }

-- TODO I think you need to pad empty lines in the zipper to fill out the box D:
-- ok, no you don't, that's only for the non-paragraph text area that we don't actually have yet
makeTextInputState :: REltId -> SBox -> RelMouseDrag -> TextInputState
makeTextInputState :: Int -> SBox -> RelMouseDrag -> TextInputState
makeTextInputState Int
rid SBox
sbox RelMouseDrag
rmd = TextInputState
r where
  ogtext :: Text
ogtext = SBoxText -> Text
_sBoxText_text forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text forall a b. (a -> b) -> a -> b
$ SBox
sbox
  ogtz :: TextZipper
ogtz = Text -> TextZipper
TZ.fromText Text
ogtext
  r' :: TextInputState
r' = TextInputState {
      _textInputState_rid :: Int
_textInputState_rid = Int
rid
      , _textInputState_original :: Maybe Text
_textInputState_original   = forall a. a -> Maybe a
Just Text
ogtext
      , _textInputState_zipper :: TextZipper
_textInputState_zipper   = TextZipper
ogtz

      -- these fields get updated in next pass
      , _textInputState_box :: LBox
_textInputState_box = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected to be filled"
      , _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected to be filled"

      --, _textInputState_selected = 0
    }
  r'' :: TextInputState
r'' = SBox -> TextInputState -> TextInputState
updateTextInputStateWithSBox SBox
sbox TextInputState
r'
  r :: TextInputState
r = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
r'' RelMouseDrag
rmd

-- TODO support shift selecting text someday meh
-- | returns zipper in TextInputState after keyboard input has been applied
-- Bool indicates if there was any real input
inputBoxTextZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputBoxTextZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputBoxTextZipper 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_Up      -> (Bool
False, TextZipper -> TextZipper
TZ.up TextZipper
oldZip)
    KeyboardKey
KeyboardKey_Down    -> (Bool
False, TextZipper -> TextZipper
TZ.down 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_PageUp -> (Bool
False, Int -> TextZipper -> TextZipper
TZ.pageUp Int
5 TextZipper
oldZip)
    KeyboardKey
KeyboardKey_PageDown -> (Bool
False, Int -> TextZipper -> TextZipper
TZ.pageDown Int
5 TextZipper
oldZip)

    KeyboardKey
KeyboardKey_Return  -> (Bool
True, Char -> TextZipper -> TextZipper
TZ.insertChar Char
'\n' TextZipper
oldZip)
    KeyboardKey
KeyboardKey_Space   -> (Bool
True, Char -> TextZipper -> TextZipper
TZ.insertChar Char
' ' TextZipper
oldZip)
    KeyboardKey
KeyboardKey_Delete  -> (Bool
True, TextZipper -> TextZipper
TZ.deleteRight TextZipper
oldZip)
    KeyboardKey
KeyboardKey_Backspace -> (Bool
True, 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
k                   -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"unexpected keyboard char (event should have been handled outside of this handler)" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show KeyboardKey
k

inputBoxText :: TextInputState -> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe WSEvent)
inputBoxText :: TextInputState
-> Bool
-> SuperOwl
-> KeyboardKey
-> (TextInputState, Maybe WSEvent)
inputBoxText TextInputState
tais Bool
undoFirst SuperOwl
sowl KeyboardKey
kk = (TextInputState
newtais, Maybe WSEvent
mop) where
  (Bool
changed, TextInputState
newtais) = TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputBoxTextZipper TextInputState
tais KeyboardKey
kk
  controller :: DSum CTag Identity
controller = CTag CBoxText
CTagBoxText 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
$ CBoxText {
      _cBoxText_deltaText :: DeltaText
_cBoxText_deltaText = (forall a. a -> Maybe a -> a
fromMaybe Text
"" (TextInputState -> Maybe Text
_textInputState_original TextInputState
tais), TextZipper -> Text
TZ.value (TextInputState -> TextZipper
_textInputState_zipper TextInputState
newtais))
    })
  mop :: Maybe WSEvent
mop = if Bool
changed
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
undoFirst, 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.fromList [(SuperOwl -> Int
_superOwl_id SuperOwl
sowl,DSum CTag Identity
controller)])
    else forall a. Maybe a
Nothing

data BoxTextHandler = BoxTextHandler {
    -- TODO rename to active
    BoxTextHandler -> Bool
_boxTextHandler_isActive      :: Bool
    , BoxTextHandler -> TextInputState
_boxTextHandler_state       :: TextInputState
    -- TODO you can prob delete this now, we don't persist state between sub handlers in this case
    , BoxTextHandler -> SomePotatoHandler
_boxTextHandler_prevHandler :: SomePotatoHandler
    , BoxTextHandler -> Bool
_boxTextHandler_undoFirst   :: Bool
  }

makeBoxTextHandler :: SomePotatoHandler -> CanvasSelection -> RelMouseDrag -> BoxTextHandler
makeBoxTextHandler :: SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> BoxTextHandler
makeBoxTextHandler SomePotatoHandler
prev CanvasSelection
selection RelMouseDrag
rmd = BoxTextHandler {
      _boxTextHandler_isActive :: Bool
_boxTextHandler_isActive = Bool
False
      , _boxTextHandler_state :: TextInputState
_boxTextHandler_state = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> SBox -> RelMouseDrag -> TextInputState
makeTextInputState (CanvasSelection -> (Int, SBox)
getSBox CanvasSelection
selection) RelMouseDrag
rmd
      , _boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_prevHandler = SomePotatoHandler
prev
      , _boxTextHandler_undoFirst :: Bool
_boxTextHandler_undoFirst = Bool
False
    }

updateBoxTextHandlerState :: Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState :: Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
reset CanvasSelection
selection tah :: BoxTextHandler
tah@BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_state :: TextInputState
_boxTextHandler_isActive :: Bool
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
tzIsCorrect BoxTextHandler
r where
  (Int
_, SBox
sbox) = CanvasSelection -> (Int, SBox)
getSBox CanvasSelection
selection

  newText :: Text
newText = SBoxText -> Text
_sBoxText_text forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text forall a b. (a -> b) -> a -> b
$ SBox
sbox

  recomputetz :: TextZipper
recomputetz = Text -> TextZipper
TZ.fromText Text
newText
  oldtz :: TextZipper
oldtz = TextInputState -> TextZipper
_textInputState_zipper TextInputState
_boxTextHandler_state
  -- NOTE that recomputetz won't have the same cursor position
  -- TODO delete this check, not very meaningful, but good for development purposes I guess
  tzIsCorrect :: Bool
tzIsCorrect = TextZipper -> Text
TZ.value TextZipper
oldtz forall a. Eq a => a -> a -> Bool
== TextZipper -> Text
TZ.value TextZipper
recomputetz

  nextstate :: TextInputState
nextstate = SBox -> TextInputState -> TextInputState
updateTextInputStateWithSBox SBox
sbox TextInputState
_boxTextHandler_state

  r :: BoxTextHandler
r = BoxTextHandler
tah {
    _boxTextHandler_state :: TextInputState
_boxTextHandler_state = if Bool
reset
      then TextInputState
nextstate {
          _textInputState_original :: Maybe Text
_textInputState_original = forall a. a -> Maybe a
Just Text
newText
        }
      else TextInputState
nextstate
    , _boxTextHandler_undoFirst :: Bool
_boxTextHandler_undoFirst = if Bool
reset
      then Bool
False
      else Bool
_boxTextHandler_undoFirst
  }

instance PotatoHandler BoxTextHandler where
  pHandlerName :: BoxTextHandler -> Text
pHandlerName BoxTextHandler
_ = Text
handlerName_boxText
  pHandlerDebugShow :: BoxTextHandler -> Text
pHandlerDebugShow BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_state :: TextInputState
_boxTextHandler_isActive :: Bool
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
..} = Text -> Text
LT.toStrict forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
Pretty.pShowNoColor TextInputState
_boxTextHandler_state
  pHandleMouse :: BoxTextHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse BoxTextHandler
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]
V2 Int
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> V2 Int
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> V2 Int
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: V2 Int
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: V2 Int
..}) = let
      tah :: BoxTextHandler
tah@BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_state :: TextInputState
_boxTextHandler_isActive :: Bool
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
..} = Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxTextHandler
tah'
    in case MouseDragState
_mouseDrag_state of
      MouseDragState
MouseDragState_Down -> Maybe PotatoHandlerOutput
r where
        clickInside :: Bool
clickInside = LBox -> V2 Int -> Bool
does_lBox_contains_XY (TextInputState -> LBox
_textInputState_box TextInputState
_boxTextHandler_state) V2 Int
_mouseDrag_to
        newState :: TextInputState
newState = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
_boxTextHandler_state RelMouseDrag
rmd
        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 BoxTextHandler
tah {
                  _boxTextHandler_isActive :: Bool
_boxTextHandler_isActive = Bool
True
                  , _boxTextHandler_state :: TextInputState
_boxTextHandler_state = TextInputState
newState
                }
            }
          -- 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 SomePotatoHandler
_boxTextHandler_prevHandler PotatoHandlerInput
phi RelMouseDrag
rmd

      -- TODO drag select text someday
      MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxTextHandler
tah

      MouseDragState
MouseDragState_Up -> 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 BoxTextHandler
tah {
              _boxTextHandler_isActive :: Bool
_boxTextHandler_isActive = Bool
False
              --, _boxTextHandler_undoFirst = False -- this variant adds new undo point each time cursor is moved
            }
        }
      MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxTextHandler
tah

  pHandleKeyboard :: BoxTextHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard BoxTextHandler
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]
_) = 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 (BoxTextHandler -> SomePotatoHandler
_boxTextHandler_prevHandler BoxTextHandler
tah') }
    -- TODO should only capture stuff caught by inputBoxTextZipper

    KeyboardKey
_ -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
      -- this regenerates displayLines unecessarily but who cares
      tah :: BoxTextHandler
tah@BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_state :: TextInputState
_boxTextHandler_isActive :: Bool
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
..} = Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxTextHandler
tah'
      sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection

      -- TODO decide what to do with mods

      (TextInputState
nexttais, Maybe WSEvent
mev) = TextInputState
-> Bool
-> SuperOwl
-> KeyboardKey
-> (TextInputState, Maybe WSEvent)
inputBoxText TextInputState
_boxTextHandler_state Bool
_boxTextHandler_undoFirst SuperOwl
sowl KeyboardKey
k
      r :: PotatoHandlerOutput
r = 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 BoxTextHandler
tah {
              _boxTextHandler_state :: TextInputState
_boxTextHandler_state  = TextInputState
nexttais
              , _boxTextHandler_undoFirst :: Bool
_boxTextHandler_undoFirst = case Maybe WSEvent
mev of
                Maybe WSEvent
Nothing -> Bool
_boxTextHandler_undoFirst
                --Nothing -> False -- this variant adds new undo point each time cursoer is moved
                Just WSEvent
_  -> Bool
True
            }
          , _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = Maybe WSEvent
mev
        }

  -- TODO do you need to reset _boxTextHandler_prevHandler as well?
  pRefreshHandler :: BoxTextHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler BoxTextHandler
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
..} = if forall a. Seq a -> Bool
Seq.null (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
    then forall a. Maybe a
Nothing -- selection was deleted or something
    else if Int
rid forall a. Eq a => a -> a -> Bool
/= (TextInputState -> Int
_textInputState_rid forall a b. (a -> b) -> a -> b
$ BoxTextHandler -> TextInputState
_boxTextHandler_state BoxTextHandler
tah)
      then forall a. Maybe a
Nothing -- selection was change to something else
      else case SElt
selt of
        SEltBox SBox
sbox -> if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ SBoxType -> Bool
sBoxType_isText (SBox -> SBoxType
_sBox_boxType SBox
sbox)
          then forall a. Maybe a
Nothing -- SEltBox type changed to non-text
          -- TODO this needs to merge the TextZipper if change came due to remote event
          else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
True CanvasSelection
_potatoHandlerInput_canvasSelection BoxTextHandler
tah
        SElt
_ -> forall a. Maybe a
Nothing
      where
        sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
        rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
        selt :: SElt
selt = SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl

  pRenderHandler :: BoxTextHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler BoxTextHandler
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
    tah :: BoxTextHandler
tah = Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxTextHandler
tah'
    btis :: TextInputState
btis = BoxTextHandler -> TextInputState
_boxTextHandler_state BoxTextHandler
tah
    r :: HandlerRenderOutput
r = forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (BoxTextHandler -> SomePotatoHandler
_boxTextHandler_prevHandler BoxTextHandler
tah) PotatoHandlerInput
phi forall a. Semigroup a => a -> a -> a
<> TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput TextInputState
btis

  pIsHandlerActive :: BoxTextHandler -> Bool
pIsHandlerActive = BoxTextHandler -> Bool
_boxTextHandler_isActive




-- BOX LABEL STUFF STARTS HERE
data BoxLabelHandler = BoxLabelHandler {
    BoxLabelHandler -> Bool
_boxLabelHandler_active      :: Bool
    -- NOTE some fields in here are ignored or interpreted differently from BoxTextHandler
    , BoxLabelHandler -> TextInputState
_boxLabelHandler_state       :: TextInputState
    , BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_prevHandler :: SomePotatoHandler
    , BoxLabelHandler -> Bool
_boxLabelHandler_undoFirst   :: Bool
  }

lBox_to_boxLabelBox :: LBox -> LBox
lBox_to_boxLabelBox :: LBox -> LBox
lBox_to_boxLabelBox LBox
lbx = LBox
r where
  CanonicalLBox Bool
_ Bool
_ (LBox (V2 Int
x Int
y) (V2 Int
w Int
_)) = LBox -> CanonicalLBox
canonicalLBox_from_lBox LBox
lbx
  width :: Int
width = forall a. Ord a => a -> a -> a
max Int
0 (Int
w forall a. Num a => a -> a -> a
- Int
2)
  r :: LBox
r = V2 Int -> V2 Int -> LBox
LBox (forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
+Int
1) Int
y) (forall a. a -> a -> V2 a
V2 Int
width Int
1)


updateBoxLabelInputStateWithSBox :: SBox -> TextInputState -> TextInputState
updateBoxLabelInputStateWithSBox :: SBox -> TextInputState -> TextInputState
updateBoxLabelInputStateWithSBox SBox
sbox TextInputState
btis = TextInputState
r where
  alignment :: TextAlignment
alignment = TextAlign -> TextAlignment
convertTextAlignToTextZipperTextAlignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxTitle -> TextAlign
_sBoxTitle_align forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxTitle
_sBox_title forall a b. (a -> b) -> a -> b
$ SBox
sbox
  newBox :: LBox
newBox =  LBox -> LBox
lBox_to_boxLabelBox forall a b. (a -> b) -> a -> b
$ SBox -> LBox
_sBox_box SBox
sbox
  width :: Int
width = forall a. Bounded a => a
maxBound :: Int -- box label text always overflows
  r :: TextInputState
r = TextInputState
btis {
      _textInputState_box :: LBox
_textInputState_box = LBox
newBox
      , _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
alignment Int
width () () (TextInputState -> TextZipper
_textInputState_zipper TextInputState
btis)
    }

makeBoxLabelInputState :: REltId -> SBox -> RelMouseDrag -> TextInputState
makeBoxLabelInputState :: Int -> SBox -> RelMouseDrag -> TextInputState
makeBoxLabelInputState Int
rid SBox
sbox RelMouseDrag
rmd = TextInputState
r where
  mogtext :: Maybe Text
mogtext = SBoxTitle -> Maybe Text
_sBoxTitle_title forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxTitle
_sBox_title forall a b. (a -> b) -> a -> b
$ SBox
sbox
  ogtz :: TextZipper
ogtz = Text -> TextZipper
TZ.fromText (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mogtext)
  r' :: TextInputState
r' = TextInputState {
      _textInputState_rid :: Int
_textInputState_rid = Int
rid
      , _textInputState_original :: Maybe Text
_textInputState_original   = Maybe Text
mogtext
      , _textInputState_zipper :: TextZipper
_textInputState_zipper   = TextZipper
ogtz

      -- these fields get updated in next pass
      , _textInputState_box :: LBox
_textInputState_box = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected to be filled"
      , _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected to be filled"
    }
  r'' :: TextInputState
r'' = SBox -> TextInputState -> TextInputState
updateBoxLabelInputStateWithSBox SBox
sbox TextInputState
r'
  r :: TextInputState
r = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
r'' RelMouseDrag
rmd

makeBoxLabelHandler :: SomePotatoHandler -> CanvasSelection -> RelMouseDrag -> BoxLabelHandler
makeBoxLabelHandler :: SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> BoxLabelHandler
makeBoxLabelHandler SomePotatoHandler
prev CanvasSelection
selection RelMouseDrag
rmd = BoxLabelHandler {
      _boxLabelHandler_active :: Bool
_boxLabelHandler_active = Bool
False
      , _boxLabelHandler_state :: TextInputState
_boxLabelHandler_state = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> SBox -> RelMouseDrag -> TextInputState
makeBoxLabelInputState (CanvasSelection -> (Int, SBox)
getSBox CanvasSelection
selection) RelMouseDrag
rmd
      , _boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_prevHandler = SomePotatoHandler
prev
      , _boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_undoFirst = Bool
False
    }


-- UNTESTED
updateBoxLabelHandlerState :: Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState :: Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
reset CanvasSelection
selection tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_active :: Bool
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
tzIsCorrect BoxLabelHandler
r where
  (Int
_, SBox
sbox) = CanvasSelection -> (Int, SBox)
getSBox CanvasSelection
selection

  mNewText :: Maybe Text
mNewText = SBoxTitle -> Maybe Text
_sBoxTitle_title forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxTitle
_sBox_title forall a b. (a -> b) -> a -> b
$ SBox
sbox

  recomputetz :: TextZipper
recomputetz = Text -> TextZipper
TZ.fromText (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mNewText)
  oldtz :: TextZipper
oldtz = TextInputState -> TextZipper
_textInputState_zipper TextInputState
_boxLabelHandler_state
  -- NOTE that recomputetz won't have the same cursor position
  -- TODO delete this check, not very meaningful, but good for development purposes I guess
  tzIsCorrect :: Bool
tzIsCorrect = TextZipper -> Text
TZ.value TextZipper
oldtz forall a. Eq a => a -> a -> Bool
== TextZipper -> Text
TZ.value TextZipper
recomputetz
  nextstate :: TextInputState
nextstate = SBox -> TextInputState -> TextInputState
updateBoxLabelInputStateWithSBox SBox
sbox TextInputState
_boxLabelHandler_state

  r :: BoxLabelHandler
r = BoxLabelHandler
tah {
    _boxLabelHandler_state :: TextInputState
_boxLabelHandler_state = if Bool
reset
      then TextInputState
nextstate {
          _textInputState_original :: Maybe Text
_textInputState_original = Maybe Text
mNewText
        }
      else TextInputState
nextstate
    , _boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_undoFirst = if Bool
reset
      then Bool
False
      else Bool
_boxLabelHandler_undoFirst
  }


inputBoxLabel :: TextInputState -> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe WSEvent)
inputBoxLabel :: TextInputState
-> Bool
-> SuperOwl
-> KeyboardKey
-> (TextInputState, Maybe WSEvent)
inputBoxLabel TextInputState
tais Bool
undoFirst SuperOwl
sowl KeyboardKey
kk = (TextInputState
newtais, Maybe WSEvent
mop) where
  (Bool
changed, TextInputState
newtais) = TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputSingleLineZipper TextInputState
tais KeyboardKey
kk
  newtext :: Text
newtext = TextZipper -> Text
TZ.value (TextInputState -> TextZipper
_textInputState_zipper TextInputState
newtais)
  controller :: DSum CTag Identity
controller = CTag CMaybeText
CTagBoxLabelText 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
$ DeltaMaybeText -> CMaybeText
CMaybeText ((Maybe Text, Maybe Text) -> DeltaMaybeText
DeltaMaybeText (TextInputState -> Maybe Text
_textInputState_original TextInputState
tais, if Text
newtext forall a. Eq a => a -> a -> Bool
== Text
"" then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
newtext)))
  mop :: Maybe WSEvent
mop = if Bool
changed
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
undoFirst, 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.fromList [(SuperOwl -> Int
_superOwl_id SuperOwl
sowl,DSum CTag Identity
controller)])
    else forall a. Maybe a
Nothing


-- | just a helper for pHandleMouse
handleMouseDownOrFirstUpForBoxLabelHandler :: BoxLabelHandler -> PotatoHandlerInput -> RelMouseDrag -> SBox -> Bool -> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler :: BoxLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> SBox
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_active :: Bool
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
..} 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
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
V2 Int
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: V2 Int
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: V2 Int
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> V2 Int
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> V2 Int
..}) SBox
sbox Bool
isdown = Maybe PotatoHandlerOutput
r where
  clickInside :: Bool
clickInside = LBox -> V2 Int -> Bool
does_lBox_contains_XY (TextInputState -> LBox
_textInputState_box TextInputState
_boxLabelHandler_state) V2 Int
_mouseDrag_to
  newState :: TextInputState
newState = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
_boxLabelHandler_state RelMouseDrag
rmd
  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 BoxLabelHandler
tah {
            _boxLabelHandler_active :: Bool
_boxLabelHandler_active = Bool
isdown
            , _boxLabelHandler_state :: TextInputState
_boxLabelHandler_state = TextInputState
newState
          }
      }
    -- 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 SomePotatoHandler
_boxLabelHandler_prevHandler PotatoHandlerInput
phi RelMouseDrag
rmd


instance PotatoHandler BoxLabelHandler where
  pHandlerName :: BoxLabelHandler -> Text
pHandlerName BoxLabelHandler
_ = Text
handlerName_boxLabel
  pHandlerDebugShow :: BoxLabelHandler -> Text
pHandlerDebugShow BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_active :: Bool
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
..} = Text -> Text
LT.toStrict forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
Pretty.pShowNoColor TextInputState
_boxLabelHandler_state

  -- UNTESTED
  pHandleMouse :: BoxLabelHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse BoxLabelHandler
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
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
V2 Int
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: V2 Int
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: V2 Int
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> V2 Int
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> V2 Int
..}) = let
      tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_active :: Bool
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
..} = Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxLabelHandler
tah'
      (Int
_, SBox
sbox) = CanvasSelection -> (Int, SBox)
getSBox CanvasSelection
_potatoHandlerInput_canvasSelection
    in case MouseDragState
_mouseDrag_state of


      MouseDragState
MouseDragState_Down -> BoxLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> SBox
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler BoxLabelHandler
tah PotatoHandlerInput
phi RelMouseDrag
rmd SBox
sbox Bool
True

      -- TODO drag select text someday
      MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxLabelHandler
tah

      MouseDragState
MouseDragState_Up -> if Bool -> Bool
not Bool
_boxLabelHandler_active
        then BoxLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> SBox
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler BoxLabelHandler
tah PotatoHandlerInput
phi RelMouseDrag
rmd SBox
sbox Bool
False
        else 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 BoxLabelHandler
tah {
                _boxLabelHandler_active :: Bool
_boxLabelHandler_active = Bool
False
              }
          }

      MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxLabelHandler
tah

  pHandleKeyboard :: BoxLabelHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard BoxLabelHandler
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]
_) = 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 (BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_prevHandler BoxLabelHandler
tah') }
    -- TODO should only capture stuff caught by inputSingleLineZipper
    KeyboardKey
_ -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
      -- this regenerates displayLines unecessarily but who cares
      tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_active :: Bool
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
..} = Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxLabelHandler
tah'
      sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection

      -- TODO decide what to do with mods

      (TextInputState
nexttais, Maybe WSEvent
mev) = TextInputState
-> Bool
-> SuperOwl
-> KeyboardKey
-> (TextInputState, Maybe WSEvent)
inputBoxLabel TextInputState
_boxLabelHandler_state Bool
_boxLabelHandler_undoFirst SuperOwl
sowl KeyboardKey
k
      r :: PotatoHandlerOutput
r = 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 BoxLabelHandler
tah {
              _boxLabelHandler_state :: TextInputState
_boxLabelHandler_state  = TextInputState
nexttais
              , _boxLabelHandler_undoFirst :: Bool
_boxLabelHandler_undoFirst = case Maybe WSEvent
mev of
                Maybe WSEvent
Nothing -> Bool
_boxLabelHandler_undoFirst
                --Nothing -> False -- this variant adds new undo point each time cursoer is moved
                Just WSEvent
_  -> Bool
True
            }
          , _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = Maybe WSEvent
mev
        }

  -- UNTESTED
  -- TODO do you need to reset _boxLabelHandler_prevHandler as well?
  pRefreshHandler :: BoxLabelHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler BoxLabelHandler
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
..} = if forall a. Seq a -> Bool
Seq.null (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
    then forall a. Maybe a
Nothing -- selection was deleted or something
    else if Int
rid forall a. Eq a => a -> a -> Bool
/= (TextInputState -> Int
_textInputState_rid forall a b. (a -> b) -> a -> b
$ BoxLabelHandler -> TextInputState
_boxLabelHandler_state BoxLabelHandler
tah)
      then forall a. Maybe a
Nothing -- selection was change to something else
      else case SElt
selt of
        SEltBox SBox
sbox -> if SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox)
          -- TODO this needs to merge the TextZipper if change came due to remote event
          then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
True CanvasSelection
_potatoHandlerInput_canvasSelection BoxLabelHandler
tah
          -- SEltBox type changed to non-text
          else forall a. Maybe a
Nothing
        SElt
_ -> forall a. Maybe a
Nothing
      where
        sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
        rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
        selt :: SElt
selt = SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl

  pRenderHandler :: BoxLabelHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler BoxLabelHandler
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
    tah :: BoxLabelHandler
tah = Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxLabelHandler
tah'
    btis :: TextInputState
btis = BoxLabelHandler -> TextInputState
_boxLabelHandler_state BoxLabelHandler
tah
    r :: HandlerRenderOutput
r = forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_prevHandler BoxLabelHandler
tah) PotatoHandlerInput
phi forall a. Semigroup a => a -> a -> a
<> TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput TextInputState
btis

  pIsHandlerActive :: BoxLabelHandler -> Bool
pIsHandlerActive = BoxLabelHandler -> Bool
_boxLabelHandler_active