{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Flow.Controller.Handler where
import Relude
import Potato.Flow.BroadPhase
import Potato.Flow.Controller.Input
import Potato.Flow.Controller.OwlLayers
import Potato.Flow.Controller.Types
import Potato.Flow.Math
import Potato.Flow.Owl
import Potato.Flow.Render
import Potato.Flow.OwlState
import Potato.Flow.OwlWorkspace
import Potato.Flow.Serialization.Snake
import qualified Potato.Flow.Preview as Preview
import qualified Potato.Data.Text.Zipper as TZ
import Data.Default
import qualified Data.IntMap as IM
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Text.Show
data HandlerOutputAction =
HOA_Nothing
| HOA_Pan XY
| HOA_Select Bool Selection
| HOA_Layers LayersState SuperOwlChanges
| Int
| HOA_Preview Preview.Preview
deriving (Int -> HandlerOutputAction -> ShowS
[HandlerOutputAction] -> ShowS
HandlerOutputAction -> String
(Int -> HandlerOutputAction -> ShowS)
-> (HandlerOutputAction -> String)
-> ([HandlerOutputAction] -> ShowS)
-> Show HandlerOutputAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HandlerOutputAction -> ShowS
showsPrec :: Int -> HandlerOutputAction -> ShowS
$cshow :: HandlerOutputAction -> String
show :: HandlerOutputAction -> String
$cshowList :: [HandlerOutputAction] -> ShowS
showList :: [HandlerOutputAction] -> ShowS
Show)
handlerOutputAction_isNothing :: HandlerOutputAction -> Bool
handlerOutputAction_isNothing :: HandlerOutputAction -> Bool
handlerOutputAction_isNothing = \case
HandlerOutputAction
HOA_Nothing -> Bool
True
HandlerOutputAction
_ -> Bool
False
handlerOutputAction_isSelect :: HandlerOutputAction -> Bool
handlerOutputAction_isSelect :: HandlerOutputAction -> Bool
handlerOutputAction_isSelect = \case
HOA_Select Bool
_ Selection
_ -> Bool
True
HandlerOutputAction
_ -> Bool
False
data PotatoHandlerOutput = PotatoHandlerOutput {
PotatoHandlerOutput -> Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
, PotatoHandlerOutput -> HandlerOutputAction
_potatoHandlerOutput_action :: HandlerOutputAction
} deriving (Int -> PotatoHandlerOutput -> ShowS
[PotatoHandlerOutput] -> ShowS
PotatoHandlerOutput -> String
(Int -> PotatoHandlerOutput -> ShowS)
-> (PotatoHandlerOutput -> String)
-> ([PotatoHandlerOutput] -> ShowS)
-> Show PotatoHandlerOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PotatoHandlerOutput -> ShowS
showsPrec :: Int -> PotatoHandlerOutput -> ShowS
$cshow :: PotatoHandlerOutput -> String
show :: PotatoHandlerOutput -> String
$cshowList :: [PotatoHandlerOutput] -> ShowS
showList :: [PotatoHandlerOutput] -> ShowS
Show)
instance Default PotatoHandlerOutput where
def :: PotatoHandlerOutput
def = PotatoHandlerOutput {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = Maybe SomePotatoHandler
forall a. Maybe a
Nothing
, _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = HandlerOutputAction
HOA_Nothing
}
data PotatoHandlerInput = PotatoHandlerInput {
PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_pFState :: OwlPFState
, PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
, PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_broadPhase :: BroadPhaseState
, PotatoHandlerInput -> RenderCache
_potatoHandlerInput_renderCache :: RenderCache
, PotatoHandlerInput -> LayersState
_potatoHandlerInput_layersState :: LayersState
, PotatoHandlerInput -> LBox
_potatoHandlerInput_screenRegion :: LBox
, PotatoHandlerInput -> Selection
_potatoHandlerInput_selection :: Selection
, PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_canvasSelection :: CanvasSelection
}
type ColorType = ()
data SimpleBoxHandlerRenderOutput = SimpleBoxHandlerRenderOutput {
SimpleBoxHandlerRenderOutput -> LBox
_simpleBoxHandlerRenderOutput_box :: LBox
, SimpleBoxHandlerRenderOutput -> Maybe PChar
_simpleBoxHandlerRenderOutput_fillText :: Maybe PChar
, SimpleBoxHandlerRenderOutput -> ColorType
_simpleBoxHandlerRenderOutput_fillTextColor :: ColorType
, SimpleBoxHandlerRenderOutput -> ColorType
_simpleBoxHandlerRenderOutput_bgColor :: ColorType
}
data LayersHandlerRenderEntrySelectedState = LHRESS_ChildSelected | LHRESS_Selected | LHRESS_InheritSelected | LHRESS_None deriving (Int -> LayersHandlerRenderEntrySelectedState -> ShowS
[LayersHandlerRenderEntrySelectedState] -> ShowS
LayersHandlerRenderEntrySelectedState -> String
(Int -> LayersHandlerRenderEntrySelectedState -> ShowS)
-> (LayersHandlerRenderEntrySelectedState -> String)
-> ([LayersHandlerRenderEntrySelectedState] -> ShowS)
-> Show LayersHandlerRenderEntrySelectedState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayersHandlerRenderEntrySelectedState -> ShowS
showsPrec :: Int -> LayersHandlerRenderEntrySelectedState -> ShowS
$cshow :: LayersHandlerRenderEntrySelectedState -> String
show :: LayersHandlerRenderEntrySelectedState -> String
$cshowList :: [LayersHandlerRenderEntrySelectedState] -> ShowS
showList :: [LayersHandlerRenderEntrySelectedState] -> ShowS
Show, LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
(LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool)
-> (LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool)
-> Eq LayersHandlerRenderEntrySelectedState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
== :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
$c/= :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
/= :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
Eq)
type LayersHandlerRenderEntryDots = Maybe Int
type LayersHandlerRenderEntryRenaming = Maybe TZ.TextZipper
data LayersHandlerRenderEntry =
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState LayersHandlerRenderEntryDots LayersHandlerRenderEntryRenaming LayerEntry
| LayersHandlerRenderEntryDummy Int
deriving (LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
(LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool)
-> (LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool)
-> Eq LayersHandlerRenderEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
== :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
$c/= :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
/= :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
Eq, Int -> LayersHandlerRenderEntry -> ShowS
[LayersHandlerRenderEntry] -> ShowS
LayersHandlerRenderEntry -> String
(Int -> LayersHandlerRenderEntry -> ShowS)
-> (LayersHandlerRenderEntry -> String)
-> ([LayersHandlerRenderEntry] -> ShowS)
-> Show LayersHandlerRenderEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayersHandlerRenderEntry -> ShowS
showsPrec :: Int -> LayersHandlerRenderEntry -> ShowS
$cshow :: LayersHandlerRenderEntry -> String
show :: LayersHandlerRenderEntry -> String
$cshowList :: [LayersHandlerRenderEntry] -> ShowS
showList :: [LayersHandlerRenderEntry] -> ShowS
Show)
layersHandlerRenderEntry_depth :: LayersHandlerRenderEntry -> Int
layersHandlerRenderEntry_depth :: LayersHandlerRenderEntry -> Int
layersHandlerRenderEntry_depth (LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
_ LayersHandlerRenderEntryDots
_ LayersHandlerRenderEntryRenaming
_ LayerEntry
lentry) = LayerEntry -> Int
layerEntry_depth LayerEntry
lentry
layersHandlerRenderEntry_depth (LayersHandlerRenderEntryDummy Int
i) = Int
i
data LayersViewHandlerRenderOutput = LayersViewHandlerRenderOutput {
LayersViewHandlerRenderOutput -> Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries :: Seq LayersHandlerRenderEntry
} deriving (LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
(LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool)
-> (LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool)
-> Eq LayersViewHandlerRenderOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
== :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
$c/= :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
/= :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
Eq, Int -> LayersViewHandlerRenderOutput -> ShowS
[LayersViewHandlerRenderOutput] -> ShowS
LayersViewHandlerRenderOutput -> String
(Int -> LayersViewHandlerRenderOutput -> ShowS)
-> (LayersViewHandlerRenderOutput -> String)
-> ([LayersViewHandlerRenderOutput] -> ShowS)
-> Show LayersViewHandlerRenderOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayersViewHandlerRenderOutput -> ShowS
showsPrec :: Int -> LayersViewHandlerRenderOutput -> ShowS
$cshow :: LayersViewHandlerRenderOutput -> String
show :: LayersViewHandlerRenderOutput -> String
$cshowList :: [LayersViewHandlerRenderOutput] -> ShowS
showList :: [LayersViewHandlerRenderOutput] -> ShowS
Show)
instance Default LayersViewHandlerRenderOutput where
def :: LayersViewHandlerRenderOutput
def = LayersViewHandlerRenderOutput {
_layersViewHandlerRenderOutput_entries :: Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries = Seq LayersHandlerRenderEntry
forall a. Seq a
Seq.empty
}
data RenderHandleColor = RHC_Default | RHC_Attachment | RHC_AttachmentHighlight deriving (Int -> RenderHandleColor -> ShowS
[RenderHandleColor] -> ShowS
RenderHandleColor -> String
(Int -> RenderHandleColor -> ShowS)
-> (RenderHandleColor -> String)
-> ([RenderHandleColor] -> ShowS)
-> Show RenderHandleColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderHandleColor -> ShowS
showsPrec :: Int -> RenderHandleColor -> ShowS
$cshow :: RenderHandleColor -> String
show :: RenderHandleColor -> String
$cshowList :: [RenderHandleColor] -> ShowS
showList :: [RenderHandleColor] -> ShowS
Show, RenderHandleColor -> RenderHandleColor -> Bool
(RenderHandleColor -> RenderHandleColor -> Bool)
-> (RenderHandleColor -> RenderHandleColor -> Bool)
-> Eq RenderHandleColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderHandleColor -> RenderHandleColor -> Bool
== :: RenderHandleColor -> RenderHandleColor -> Bool
$c/= :: RenderHandleColor -> RenderHandleColor -> Bool
/= :: RenderHandleColor -> RenderHandleColor -> Bool
Eq)
data RenderHandle = RenderHandle {
RenderHandle -> LBox
_renderHandle_box :: LBox
, RenderHandle -> Maybe PChar
_renderHandle_char :: Maybe PChar
, RenderHandle -> RenderHandleColor
_renderHandle_color :: RenderHandleColor
} deriving (Int -> RenderHandle -> ShowS
[RenderHandle] -> ShowS
RenderHandle -> String
(Int -> RenderHandle -> ShowS)
-> (RenderHandle -> String)
-> ([RenderHandle] -> ShowS)
-> Show RenderHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderHandle -> ShowS
showsPrec :: Int -> RenderHandle -> ShowS
$cshow :: RenderHandle -> String
show :: RenderHandle -> String
$cshowList :: [RenderHandle] -> ShowS
showList :: [RenderHandle] -> ShowS
Show, RenderHandle -> RenderHandle -> Bool
(RenderHandle -> RenderHandle -> Bool)
-> (RenderHandle -> RenderHandle -> Bool) -> Eq RenderHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderHandle -> RenderHandle -> Bool
== :: RenderHandle -> RenderHandle -> Bool
$c/= :: RenderHandle -> RenderHandle -> Bool
/= :: RenderHandle -> RenderHandle -> Bool
Eq)
defaultRenderHandle :: LBox -> RenderHandle
defaultRenderHandle :: LBox -> RenderHandle
defaultRenderHandle LBox
lbox = LBox -> Maybe PChar -> RenderHandleColor -> RenderHandle
RenderHandle LBox
lbox (PChar -> Maybe PChar
forall a. a -> Maybe a
Just PChar
'X') RenderHandleColor
RHC_Default
data HandlerRenderOutput = HandlerRenderOutput {
HandlerRenderOutput -> [RenderHandle]
_handlerRenderOutput_temp :: [RenderHandle]
} deriving (HandlerRenderOutput -> HandlerRenderOutput -> Bool
(HandlerRenderOutput -> HandlerRenderOutput -> Bool)
-> (HandlerRenderOutput -> HandlerRenderOutput -> Bool)
-> Eq HandlerRenderOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
== :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
$c/= :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
/= :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
Eq)
instance Semigroup HandlerRenderOutput where
HandlerRenderOutput
a <> :: HandlerRenderOutput -> HandlerRenderOutput -> HandlerRenderOutput
<> HandlerRenderOutput
b = HandlerRenderOutput {
_handlerRenderOutput_temp :: [RenderHandle]
_handlerRenderOutput_temp = HandlerRenderOutput -> [RenderHandle]
_handlerRenderOutput_temp HandlerRenderOutput
a [RenderHandle] -> [RenderHandle] -> [RenderHandle]
forall a. Semigroup a => a -> a -> a
<> HandlerRenderOutput -> [RenderHandle]
_handlerRenderOutput_temp HandlerRenderOutput
b
}
instance Default HandlerRenderOutput where
def :: HandlerRenderOutput
def = HandlerRenderOutput
emptyHandlerRenderOutput
emptyHandlerRenderOutput :: HandlerRenderOutput
emptyHandlerRenderOutput :: HandlerRenderOutput
emptyHandlerRenderOutput = HandlerRenderOutput { _handlerRenderOutput_temp :: [RenderHandle]
_handlerRenderOutput_temp = [] }
data HandlerActiveState = HAS_Active_Mouse | HAS_Active_Keyboard | HAS_Active_Waiting | HAS_Inactive deriving (Int -> HandlerActiveState -> ShowS
[HandlerActiveState] -> ShowS
HandlerActiveState -> String
(Int -> HandlerActiveState -> ShowS)
-> (HandlerActiveState -> String)
-> ([HandlerActiveState] -> ShowS)
-> Show HandlerActiveState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HandlerActiveState -> ShowS
showsPrec :: Int -> HandlerActiveState -> ShowS
$cshow :: HandlerActiveState -> String
show :: HandlerActiveState -> String
$cshowList :: [HandlerActiveState] -> ShowS
showList :: [HandlerActiveState] -> ShowS
Show, HandlerActiveState -> HandlerActiveState -> Bool
(HandlerActiveState -> HandlerActiveState -> Bool)
-> (HandlerActiveState -> HandlerActiveState -> Bool)
-> Eq HandlerActiveState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HandlerActiveState -> HandlerActiveState -> Bool
== :: HandlerActiveState -> HandlerActiveState -> Bool
$c/= :: HandlerActiveState -> HandlerActiveState -> Bool
/= :: HandlerActiveState -> HandlerActiveState -> Bool
Eq)
handlerActiveState_isActive :: HandlerActiveState -> Bool
handlerActiveState_isActive :: HandlerActiveState -> Bool
handlerActiveState_isActive = \case
HandlerActiveState
HAS_Inactive -> Bool
False
HandlerActiveState
_ -> Bool
True
handlerName_box :: Text
handlerName_box :: Text
handlerName_box = Text
"BoxHandler"
handlerName_simpleLine :: Text
handlerName_simpleLine :: Text
handlerName_simpleLine = Text
"AutoLineHandler"
handlerName_simpleLine_endPoint :: Text
handlerName_simpleLine_endPoint :: Text
handlerName_simpleLine_endPoint = Text
"AutoLineEndPointHandler"
handlerName_simpleLine_midPoint :: Text
handlerName_simpleLine_midPoint :: Text
handlerName_simpleLine_midPoint = Text
"AutoLineMidPointHandler"
handlerName_simpleLine_textLabel :: Text
handlerName_simpleLine_textLabel :: Text
handlerName_simpleLine_textLabel = Text
"AutoLineLabelHandler"
handlerName_simpleLine_textLabelMover :: Text
handlerName_simpleLine_textLabelMover :: Text
handlerName_simpleLine_textLabelMover = Text
"AutoLineLabelMoverHandler"
handlerName_layers :: Text
handlerName_layers :: Text
handlerName_layers = Text
"LayersHandler"
handlerName_layersRename :: Text
handlerName_layersRename :: Text
handlerName_layersRename = Text
"LayersRenameHandler"
handlerName_cartesianLine :: Text
handlerName_cartesianLine :: Text
handlerName_cartesianLine = Text
"CartesianLineHandler"
handlerName_boxText :: Text
handlerName_boxText :: Text
handlerName_boxText = Text
"BoxTextHandler"
handlerName_boxLabel :: Text
handlerName_boxLabel :: Text
handlerName_boxLabel = Text
"BoxLabelHandler"
handlerName_textArea :: Text
handlerName_textArea :: Text
handlerName_textArea = Text
"TextAreaHandler"
handlerName_pan :: Text
handlerName_pan :: Text
handlerName_pan = Text
"PanHandler"
handlerName_select :: Text
handlerName_select :: Text
handlerName_select = Text
"SelectHandler"
handlerName_empty :: Text
handlerName_empty :: Text
handlerName_empty = Text
"EmptyHandler"
class PotatoHandler h where
pHandlerName :: h -> Text
pHandlerDebugShow :: h -> Text
pHandlerDebugShow h
h = h -> Text
forall h. PotatoHandler h => h -> Text
pHandlerName h
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" <no debug info>"
pHandleMouse :: h -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
_ PotatoHandlerInput
_ RelMouseDrag
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pHandleKeyboard :: h -> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard h
_ PotatoHandlerInput
_ KeyboardData
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pRefreshHandler :: h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler h
_ PotatoHandlerInput
_ = Maybe SomePotatoHandler
forall a. Maybe a
Nothing
pIsHandlerActive :: h -> HandlerActiveState
pIsHandlerActive h
_ = HandlerActiveState
HAS_Inactive
pRenderHandler :: h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler h
_ PotatoHandlerInput
_ = HandlerRenderOutput
forall a. Default a => a
def
pRenderLayersHandler :: h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler h
_ PotatoHandlerInput
_ = LayersViewHandlerRenderOutput
forall a. Default a => a
def
pValidateMouse :: h -> RelMouseDrag -> Bool
pValidateMouse h
h (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
..}) = case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Cancelled -> Bool
False
MouseDragState
MouseDragState_Down -> Bool -> Bool
not (Bool -> Bool)
-> (HandlerActiveState -> Bool) -> HandlerActiveState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerActiveState -> Bool
handlerActiveState_isActive (HandlerActiveState -> Bool) -> HandlerActiveState -> Bool
forall a b. (a -> b) -> a -> b
$ h -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive h
h
MouseDragState
_ -> Bool
True
pHandlerTool :: h -> Maybe Tool
pHandlerTool h
_ = Maybe Tool
forall a. Maybe a
Nothing
data SomePotatoHandler = forall h . PotatoHandler h => SomePotatoHandler h
instance PotatoHandler SomePotatoHandler where
pHandlerName :: SomePotatoHandler -> Text
pHandlerName (SomePotatoHandler h
h) = h -> Text
forall h. PotatoHandler h => h -> Text
pHandlerName h
h
pHandlerDebugShow :: SomePotatoHandler -> Text
pHandlerDebugShow (SomePotatoHandler h
h) = h -> Text
forall h. PotatoHandler h => h -> Text
pHandlerDebugShow h
h
pHandleMouse :: SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler h
h) = h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
h
pHandleKeyboard :: SomePotatoHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard (SomePotatoHandler h
h) = h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard h
h
pIsHandlerActive :: SomePotatoHandler -> HandlerActiveState
pIsHandlerActive (SomePotatoHandler h
h) = h -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive h
h
pRefreshHandler :: SomePotatoHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler (SomePotatoHandler h
h) = h -> PotatoHandlerInput -> Maybe SomePotatoHandler
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler h
h
pRenderHandler :: SomePotatoHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (SomePotatoHandler h
h) = h -> PotatoHandlerInput -> HandlerRenderOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler h
h
pRenderLayersHandler :: SomePotatoHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler (SomePotatoHandler h
h) = h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler h
h
pValidateMouse :: SomePotatoHandler -> RelMouseDrag -> Bool
pValidateMouse (SomePotatoHandler h
h) = h -> RelMouseDrag -> Bool
forall h. PotatoHandler h => h -> RelMouseDrag -> Bool
pValidateMouse h
h
pHandlerTool :: SomePotatoHandler -> Maybe Tool
pHandlerTool (SomePotatoHandler h
h) = h -> Maybe Tool
forall h. PotatoHandler h => h -> Maybe Tool
pHandlerTool h
h
captureWithNoChange :: (PotatoHandler h) => h -> PotatoHandlerOutput
captureWithNoChange :: forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange h
h = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler h
}
setHandlerOnly :: (PotatoHandler h) => h -> PotatoHandlerOutput
setHandlerOnly :: forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly = h -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange
instance Show SomePotatoHandler where
show :: SomePotatoHandler -> String
show (SomePotatoHandler h
h) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"SomePotatoHandler " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> h -> Text
forall h. PotatoHandler h => h -> Text
pHandlerName h
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" active: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HandlerActiveState -> Text
forall b a. (Show a, IsString b) => a -> b
show (h -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive h
h)
testHandleMouse :: SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
testHandleMouse :: SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
testHandleMouse (SomePotatoHandler h
h) PotatoHandlerInput
phi RelMouseDrag
rmd = h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
h PotatoHandlerInput
phi RelMouseDrag
rmd
data EmptyHandler = EmptyHandler
instance PotatoHandler EmptyHandler where
pHandlerName :: EmptyHandler -> Text
pHandlerName EmptyHandler
_ = Text
"EmptyHandler"
pHandleMouse :: EmptyHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse EmptyHandler
_ PotatoHandlerInput
_ RelMouseDrag
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pHandleKeyboard :: EmptyHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard EmptyHandler
_ PotatoHandlerInput
_ KeyboardData
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pRenderHandler :: EmptyHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler EmptyHandler
_ PotatoHandlerInput
_ = HandlerRenderOutput
forall a. Default a => a
def
pValidateMouse :: EmptyHandler -> RelMouseDrag -> Bool
pValidateMouse EmptyHandler
_ RelMouseDrag
_ = Bool
True