{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-unused-record-wildcards #-}
module Potato.Flow.Controller.Manipulator.BoxText (
BoxTextHandler(..)
, TextInputState(..)
, makeBoxTextHandler
, BoxLabelHandler(..)
, makeBoxLabelHandler
, lBox_to_boxLabelBox
, 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.Serialization.Snake
import Potato.Flow.Types
import Potato.Flow.Owl
import Potato.Flow.OwlWorkspace
import Potato.Flow.Llama
import Potato.Flow.Preview
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 -> Text -> (Int, SBox)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (Int, SBox)) -> Text -> (Int, SBox)
forall a b. (a -> b) -> a -> b
$ Text
"expected SBox, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SElt -> Text
forall b a. (Show a, IsString b) => a -> b
show SElt
selt
where
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
selection
rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
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 (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
nx Int
ny) (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
nw Int
nh) where
(Int
nx, Int
nw) = if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dw
then if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dw
then (Int
x, Int
0)
else (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dw), Int
0)
else (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dw, Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dw)
(Int
ny, Int
nh) = if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dh
then if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dh
then (Int
y, Int
0)
else (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dh), Int
0)
else (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dh, Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall 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 (LBox -> CanonicalLBox) -> LBox -> CanonicalLBox
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 (LBox -> CanonicalLBox) -> LBox -> CanonicalLBox
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 (TextAlign -> TextAlignment)
-> (SBox -> TextAlign) -> SBox -> TextAlignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> TextAlign
_textStyle_alignment (TextStyle -> TextAlign)
-> (SBox -> TextStyle) -> SBox -> TextAlign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxText -> TextStyle
_sBoxText_style (SBoxText -> TextStyle) -> (SBox -> SBoxText) -> SBox -> TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text (SBox -> TextAlignment) -> SBox -> TextAlignment
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 = newBox
, _textInputState_displayLines = TZ.displayLinesWithAlignment alignment width () () (_textInputState_zipper btis)
}
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 (SBoxText -> Text) -> (SBox -> SBoxText) -> SBox -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text (SBox -> Text) -> 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 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ogtext
, _textInputState_zipper :: TextZipper
_textInputState_zipper = TextZipper
ogtz
, _textInputState_box :: LBox
_textInputState_box = Text -> LBox
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected to be filled"
, _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = Text -> DisplayLines ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected to be filled"
}
r'' :: TextInputState
r'' = SBox -> TextInputState -> TextInputState
updateTextInputStateWithSBox SBox
sbox TextInputState
r'
r :: TextInputState
r = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
r'' RelMouseDrag
rmd
inputBoxTextZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputBoxTextZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputBoxTextZipper 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_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 -> Text -> (Bool, TextZipper)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (Bool, TextZipper)) -> Text -> (Bool, TextZipper)
forall a b. (a -> b) -> a -> b
$ Text
"unexpected keyboard char (event should have been handled outside of this handler)" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KeyboardKey -> Text
forall b a. (Show a, IsString b) => a -> b
show KeyboardKey
k
inputBoxText :: TextInputState -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)
inputBoxText :: TextInputState
-> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)
inputBoxText TextInputState
tais SuperOwl
sowl KeyboardKey
kk = (TextInputState
newtais, Maybe Llama
mop) where
(Bool
changed, TextInputState
newtais) = TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputBoxTextZipper TextInputState
tais KeyboardKey
kk
controller :: DSum CTag Identity
controller = CTag CBoxText
CTagBoxText CTag CBoxText -> Identity CBoxText -> DSum CTag Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> (CBoxText -> Identity CBoxText
forall a. a -> Identity a
Identity (CBoxText -> Identity CBoxText) -> CBoxText -> Identity CBoxText
forall a b. (a -> b) -> a -> b
$ CBoxText {
_cBoxText_deltaText :: DeltaText
_cBoxText_deltaText = (Text -> Maybe Text -> Text
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 Llama
mop = if Bool
changed
then Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFCmd -> Llama
makePFCLlama (OwlPFCmd -> Llama)
-> (ControllersWithId -> OwlPFCmd) -> ControllersWithId -> Llama
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate (ControllersWithId -> Llama) -> ControllersWithId -> Llama
forall a b. (a -> b) -> a -> b
$ [(Int, DSum CTag Identity)] -> ControllersWithId
forall a. [(Int, a)] -> IntMap a
IM.fromList [(SuperOwl -> Int
_superOwl_id SuperOwl
sowl,DSum CTag Identity
controller)]
else Maybe Llama
forall a. Maybe a
Nothing
data BoxTextHandler = BoxTextHandler {
BoxTextHandler -> Bool
_boxTextHandler_isActive :: Bool
, BoxTextHandler -> TextInputState
_boxTextHandler_state :: TextInputState
, BoxTextHandler -> SomePotatoHandler
_boxTextHandler_prevHandler :: SomePotatoHandler
, BoxTextHandler -> Bool
_boxTextHandler_undoFirst :: Bool
, BoxTextHandler -> Bool
_boxTextHandler_commitOnMouseUp :: Bool
}
makeBoxTextHandler :: Bool -> SomePotatoHandler -> CanvasSelection -> RelMouseDrag -> BoxTextHandler
makeBoxTextHandler :: Bool
-> SomePotatoHandler
-> CanvasSelection
-> RelMouseDrag
-> BoxTextHandler
makeBoxTextHandler Bool
commit SomePotatoHandler
prev CanvasSelection
selection RelMouseDrag
rmd = BoxTextHandler {
_boxTextHandler_isActive :: Bool
_boxTextHandler_isActive = Bool
False
, _boxTextHandler_state :: TextInputState
_boxTextHandler_state = (Int -> SBox -> RelMouseDrag -> TextInputState)
-> (Int, SBox) -> RelMouseDrag -> TextInputState
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
, _boxTextHandler_commitOnMouseUp :: Bool
_boxTextHandler_commitOnMouseUp = Bool
commit
}
updateBoxTextHandlerState :: Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState :: Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
reset CanvasSelection
selection tah :: BoxTextHandler
tah@BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_commitOnMouseUp :: BoxTextHandler -> Bool
_boxTextHandler_isActive :: Bool
_boxTextHandler_state :: TextInputState
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_commitOnMouseUp :: Bool
..} = Bool -> BoxTextHandler -> BoxTextHandler
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 (SBoxText -> Text) -> (SBox -> SBoxText) -> SBox -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text (SBox -> Text) -> 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
tzIsCorrect :: Bool
tzIsCorrect = TextZipper -> Text
TZ.value TextZipper
oldtz Text -> Text -> Bool
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 = if reset
then nextstate {
_textInputState_original = Just newText
}
else nextstate
, _boxTextHandler_undoFirst = if reset
then False
else _boxTextHandler_undoFirst
}
instance PotatoHandler BoxTextHandler where
pHandlerName :: BoxTextHandler -> Text
pHandlerName BoxTextHandler
_ = Text
handlerName_boxText
pHandlerDebugShow :: BoxTextHandler -> Text
pHandlerDebugShow BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_commitOnMouseUp :: BoxTextHandler -> Bool
_boxTextHandler_isActive :: Bool
_boxTextHandler_state :: TextInputState
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_commitOnMouseUp :: Bool
..} = Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ TextInputState -> Text
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
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
V2 Int
MouseDragState
MouseButton
_mouseDrag_from :: V2 Int
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: V2 Int
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_from :: MouseDrag -> V2 Int
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> V2 Int
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
..}) = let
(Int
rid, SBox
sbox) = CanvasSelection -> (Int, SBox)
getSBox CanvasSelection
_potatoHandlerInput_canvasSelection
tah :: BoxTextHandler
tah@BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_commitOnMouseUp :: BoxTextHandler -> Bool
_boxTextHandler_isActive :: Bool
_boxTextHandler_state :: TextInputState
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_commitOnMouseUp :: 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 PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {
_boxTextHandler_isActive = True
, _boxTextHandler_state = newState
}
}
else SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse SomePotatoHandler
_boxTextHandler_prevHandler PotatoHandlerInput
phi RelMouseDrag
rmd
MouseDragState
MouseDragState_Dragging -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ BoxTextHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxTextHandler
tah
MouseDragState
MouseDragState_Up -> Maybe PotatoHandlerOutput
r where
oldbt :: SBoxType
oldbt = SBox -> SBoxType
_sBox_boxType (SBox -> SBoxType) -> SBox -> SBoxType
forall a b. (a -> b) -> a -> b
$ SBox
sbox
istext :: Bool
istext = SBoxType -> Bool
sBoxType_isText SBoxType
oldbt
newbt :: SBoxType
newbt = Bool -> Bool -> SBoxType
make_sBoxType (SBoxType -> Bool
sBoxType_hasBorder SBoxType
oldbt) Bool
True
r :: Maybe PotatoHandlerOutput
r = if Bool -> Bool
not Bool
istext
then PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {
_boxTextHandler_isActive = False
}
, _potatoHandlerOutput_action = HOA_Preview $ Preview PO_StartAndCommit $ makePFCLlama . OwlPFCManipulate $ IM.fromList [(rid, CTagBoxType :=> Identity (CBoxType (oldbt, newbt)))]
}
else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {
_boxTextHandler_isActive = False
, _boxTextHandler_commitOnMouseUp = False
}
, _potatoHandlerOutput_action = if _boxTextHandler_commitOnMouseUp then HOA_Preview Preview_Commit else HOA_Nothing
}
MouseDragState
MouseDragState_Cancelled -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ BoxTextHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxTextHandler
tah
pHandleKeyboard :: BoxTextHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard BoxTextHandler
tah' PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} (KeyboardData KeyboardKey
k [KeyModifier]
_) = case KeyboardKey
k of
KeyboardKey
KeyboardKey_Esc -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just (_boxTextHandler_prevHandler tah') }
KeyboardKey
_ -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
tah :: BoxTextHandler
tah@BoxTextHandler {Bool
SomePotatoHandler
TextInputState
_boxTextHandler_isActive :: BoxTextHandler -> Bool
_boxTextHandler_state :: BoxTextHandler -> TextInputState
_boxTextHandler_prevHandler :: BoxTextHandler -> SomePotatoHandler
_boxTextHandler_undoFirst :: BoxTextHandler -> Bool
_boxTextHandler_commitOnMouseUp :: BoxTextHandler -> Bool
_boxTextHandler_isActive :: Bool
_boxTextHandler_state :: TextInputState
_boxTextHandler_prevHandler :: SomePotatoHandler
_boxTextHandler_undoFirst :: Bool
_boxTextHandler_commitOnMouseUp :: Bool
..} = Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxTextHandler
tah'
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
(TextInputState
nexttais, Maybe Llama
mllama) = TextInputState
-> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)
inputBoxText TextInputState
_boxTextHandler_state SuperOwl
sowl KeyboardKey
k
r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {
_boxTextHandler_state = nexttais
, _boxTextHandler_undoFirst = case mllama of
Maybe Llama
Nothing -> Bool
_boxTextHandler_undoFirst
Just Llama
_ -> Bool
True
}
, _potatoHandlerOutput_action = maybe HOA_Nothing (HOA_Preview . Preview (previewOperation_fromUndoFirst _boxTextHandler_undoFirst)) mllama
}
pRefreshHandler :: BoxTextHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler BoxTextHandler
tah PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = if Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
then Maybe SomePotatoHandler
forall a. Maybe a
Nothing
else if Int
rid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (TextInputState -> Int
_textInputState_rid (TextInputState -> Int) -> TextInputState -> Int
forall a b. (a -> b) -> a -> b
$ BoxTextHandler -> TextInputState
_boxTextHandler_state BoxTextHandler
tah)
then Maybe SomePotatoHandler
forall a. Maybe a
Nothing
else case SElt
selt of
SEltBox SBox
sbox -> if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SBoxType -> Bool
sBoxType_isText (SBox -> SBoxType
_sBox_boxType SBox
sbox)
then Maybe SomePotatoHandler
forall a. Maybe a
Nothing
else SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just (SomePotatoHandler -> Maybe SomePotatoHandler)
-> SomePotatoHandler -> Maybe SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ BoxTextHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxTextHandler -> SomePotatoHandler)
-> BoxTextHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler
updateBoxTextHandlerState Bool
True CanvasSelection
_potatoHandlerInput_canvasSelection BoxTextHandler
tah
SElt
_ -> Maybe SomePotatoHandler
forall a. Maybe a
Nothing
where
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
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
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = 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 = SomePotatoHandler -> PotatoHandlerInput -> HandlerRenderOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (BoxTextHandler -> SomePotatoHandler
_boxTextHandler_prevHandler BoxTextHandler
tah) PotatoHandlerInput
phi HandlerRenderOutput -> HandlerRenderOutput -> HandlerRenderOutput
forall a. Semigroup a => a -> a -> a
<> TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput TextInputState
btis
pIsHandlerActive :: BoxTextHandler -> HandlerActiveState
pIsHandlerActive BoxTextHandler
tah = if BoxTextHandler -> Bool
_boxTextHandler_isActive BoxTextHandler
tah then HandlerActiveState
HAS_Active_Mouse else HandlerActiveState
HAS_Active_Keyboard
data BoxLabelHandler = BoxLabelHandler {
BoxLabelHandler -> Bool
_boxLabelHandler_active :: Bool
, 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 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
r :: LBox
r = V2 Int -> V2 Int -> LBox
LBox (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
y) (Int -> Int -> V2 Int
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 (TextAlign -> TextAlignment)
-> (SBox -> TextAlign) -> SBox -> TextAlignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxTitle -> TextAlign
_sBoxTitle_align (SBoxTitle -> TextAlign)
-> (SBox -> SBoxTitle) -> SBox -> TextAlign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxTitle
_sBox_title (SBox -> TextAlignment) -> SBox -> TextAlignment
forall a b. (a -> b) -> a -> b
$ SBox
sbox
newBox :: LBox
newBox = LBox -> LBox
lBox_to_boxLabelBox (LBox -> LBox) -> LBox -> LBox
forall a b. (a -> b) -> a -> b
$ SBox -> LBox
_sBox_box SBox
sbox
width :: Int
width = Int
forall a. Bounded a => a
maxBound :: Int
r :: TextInputState
r = TextInputState
btis {
_textInputState_box = newBox
, _textInputState_displayLines = TZ.displayLinesWithAlignment alignment width () () (_textInputState_zipper 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 (SBoxTitle -> Maybe Text)
-> (SBox -> SBoxTitle) -> SBox -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxTitle
_sBox_title (SBox -> Maybe Text) -> SBox -> Maybe Text
forall a b. (a -> b) -> a -> b
$ SBox
sbox
ogtz :: TextZipper
ogtz = Text -> TextZipper
TZ.fromText (Text -> Maybe Text -> Text
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
, _textInputState_box :: LBox
_textInputState_box = Text -> LBox
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected to be filled"
, _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = Text -> 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 = (Int -> SBox -> RelMouseDrag -> TextInputState)
-> (Int, SBox) -> RelMouseDrag -> TextInputState
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
}
updateBoxLabelHandlerState :: Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState :: Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
reset CanvasSelection
selection tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_active :: Bool
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_undoFirst :: Bool
..} = Bool -> BoxLabelHandler -> BoxLabelHandler
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 (SBoxTitle -> Maybe Text)
-> (SBox -> SBoxTitle) -> SBox -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxTitle
_sBox_title (SBox -> Maybe Text) -> SBox -> Maybe Text
forall a b. (a -> b) -> a -> b
$ SBox
sbox
recomputetz :: TextZipper
recomputetz = Text -> TextZipper
TZ.fromText (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mNewText)
oldtz :: TextZipper
oldtz = TextInputState -> TextZipper
_textInputState_zipper TextInputState
_boxLabelHandler_state
tzIsCorrect :: Bool
tzIsCorrect = TextZipper -> Text
TZ.value TextZipper
oldtz Text -> Text -> Bool
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 = if reset
then nextstate {
_textInputState_original = mNewText
}
else nextstate
, _boxLabelHandler_undoFirst = if reset
then False
else _boxLabelHandler_undoFirst
}
inputBoxLabel :: TextInputState -> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)
inputBoxLabel :: TextInputState
-> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)
inputBoxLabel TextInputState
tais Bool
undoFirst SuperOwl
sowl KeyboardKey
kk = (TextInputState
newtais, Maybe Llama
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 CTag CMaybeText -> Identity CMaybeText -> DSum CTag Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> (CMaybeText -> Identity CMaybeText
forall a. a -> Identity a
Identity (CMaybeText -> Identity CMaybeText)
-> CMaybeText -> Identity CMaybeText
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
newtext)))
mop :: Maybe Llama
mop = if Bool
changed
then Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFCmd -> Llama
makePFCLlama (OwlPFCmd -> Llama)
-> (ControllersWithId -> OwlPFCmd) -> ControllersWithId -> Llama
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate (ControllersWithId -> Llama) -> ControllersWithId -> Llama
forall a b. (a -> b) -> a -> b
$ [(Int, DSum CTag Identity)] -> ControllersWithId
forall a. [(Int, a)] -> IntMap a
IM.fromList [(SuperOwl -> Int
_superOwl_id SuperOwl
sowl,DSum CTag Identity
controller)]
else Maybe Llama
forall a. Maybe a
Nothing
handleMouseDownOrFirstUpForBoxLabelHandler :: BoxLabelHandler -> PotatoHandlerInput -> RelMouseDrag -> Bool -> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler :: BoxLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_active :: Bool
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_undoFirst :: Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
V2 Int
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> V2 Int
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> V2 Int
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: V2 Int
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: V2 Int
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) 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 PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {
_boxLabelHandler_active = isdown
, _boxLabelHandler_state = newState
}
}
else SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
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_active :: BoxLabelHandler -> Bool
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_active :: Bool
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_undoFirst :: Bool
..} = Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ TextInputState -> Text
forall a. Show a => a -> Text
Pretty.pShowNoColor TextInputState
_boxLabelHandler_state
pHandleMouse :: BoxLabelHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse BoxLabelHandler
tah' phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
V2 Int
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> V2 Int
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> V2 Int
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: V2 Int
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: V2 Int
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = let
tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_active :: Bool
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_undoFirst :: Bool
..} = Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxLabelHandler
tah'
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down -> BoxLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler BoxLabelHandler
tah PotatoHandlerInput
phi RelMouseDrag
rmd Bool
True
MouseDragState
MouseDragState_Dragging -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ BoxLabelHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxLabelHandler
tah
MouseDragState
MouseDragState_Up -> if Bool -> Bool
not Bool
_boxLabelHandler_active
then BoxLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForBoxLabelHandler BoxLabelHandler
tah PotatoHandlerInput
phi RelMouseDrag
rmd Bool
False
else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {
_boxLabelHandler_active = False
}
}
MouseDragState
MouseDragState_Cancelled -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ BoxLabelHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange BoxLabelHandler
tah
pHandleKeyboard :: BoxLabelHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard BoxLabelHandler
tah' PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} (KeyboardData KeyboardKey
k [KeyModifier]
_) = case KeyboardKey
k of
KeyboardKey
KeyboardKey_Esc -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just (_boxLabelHandler_prevHandler tah') }
KeyboardKey
_ -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
tah :: BoxLabelHandler
tah@BoxLabelHandler {Bool
SomePotatoHandler
TextInputState
_boxLabelHandler_active :: BoxLabelHandler -> Bool
_boxLabelHandler_state :: BoxLabelHandler -> TextInputState
_boxLabelHandler_prevHandler :: BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_undoFirst :: BoxLabelHandler -> Bool
_boxLabelHandler_active :: Bool
_boxLabelHandler_state :: TextInputState
_boxLabelHandler_prevHandler :: SomePotatoHandler
_boxLabelHandler_undoFirst :: Bool
..} = Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection BoxLabelHandler
tah'
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
(TextInputState
nexttais, Maybe Llama
mllama) = TextInputState
-> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)
inputBoxLabel TextInputState
_boxLabelHandler_state Bool
_boxLabelHandler_undoFirst SuperOwl
sowl KeyboardKey
k
r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {
_boxLabelHandler_state = nexttais
, _boxLabelHandler_undoFirst = case mllama of
Maybe Llama
Nothing -> Bool
_boxLabelHandler_undoFirst
Just Llama
_ -> Bool
True
}
, _potatoHandlerOutput_action = maybe HOA_Nothing (HOA_Preview . Preview (previewOperation_fromUndoFirst _boxLabelHandler_undoFirst)) mllama
}
pRefreshHandler :: BoxLabelHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler BoxLabelHandler
tah PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = if Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
then Maybe SomePotatoHandler
forall a. Maybe a
Nothing
else if Int
rid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (TextInputState -> Int
_textInputState_rid (TextInputState -> Int) -> TextInputState -> Int
forall a b. (a -> b) -> a -> b
$ BoxLabelHandler -> TextInputState
_boxLabelHandler_state BoxLabelHandler
tah)
then Maybe SomePotatoHandler
forall a. Maybe a
Nothing
else case SElt
selt of
SEltBox SBox
sbox -> if SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox)
then SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just (SomePotatoHandler -> Maybe SomePotatoHandler)
-> SomePotatoHandler -> Maybe SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ BoxLabelHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxLabelHandler -> SomePotatoHandler)
-> BoxLabelHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler
updateBoxLabelHandlerState Bool
True CanvasSelection
_potatoHandlerInput_canvasSelection BoxLabelHandler
tah
else Maybe SomePotatoHandler
forall a. Maybe a
Nothing
SElt
_ -> Maybe SomePotatoHandler
forall a. Maybe a
Nothing
where
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
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
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = 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 = SomePotatoHandler -> PotatoHandlerInput -> HandlerRenderOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (BoxLabelHandler -> SomePotatoHandler
_boxLabelHandler_prevHandler BoxLabelHandler
tah) PotatoHandlerInput
phi HandlerRenderOutput -> HandlerRenderOutput -> HandlerRenderOutput
forall a. Semigroup a => a -> a -> a
<> TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput TextInputState
btis
pIsHandlerActive :: BoxLabelHandler -> HandlerActiveState
pIsHandlerActive BoxLabelHandler
tah = if BoxLabelHandler -> Bool
_boxLabelHandler_active BoxLabelHandler
tah then HandlerActiveState
HAS_Active_Mouse else HandlerActiveState
HAS_Active_Keyboard