{-# OPTIONS_GHC -fno-warn-unused-record-wildcards #-}
{-# LANGUAGE RecordWildCards #-}
module Potato.Flow.Controller.Manipulator.Pan (
PanHandler(..)
) where
import Relude
import Potato.Flow.Controller.Handler
import Potato.Flow.Controller.Input
import Potato.Flow.Controller.Types
import Potato.Flow.Math
import Data.Default
data PanHandler = PanHandler {
PanHandler -> XY
_panHandler_panDelta :: XY
, PanHandler -> Maybe SomePotatoHandler
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
}
instance Default PanHandler where
def :: PanHandler
def = PanHandler {
_panHandler_panDelta :: XY
_panHandler_panDelta = XY
0
, _panHandler_maybePrevHandler :: Maybe SomePotatoHandler
_panHandler_maybePrevHandler = Maybe SomePotatoHandler
forall a. Maybe a
Nothing
}
instance PotatoHandler PanHandler where
pHandlerName :: PanHandler -> Text
pHandlerName PanHandler
_ = Text
handlerName_pan
pHandleMouse :: PanHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse ph :: PanHandler
ph@PanHandler {Maybe SomePotatoHandler
XY
_panHandler_panDelta :: PanHandler -> XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
..} 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
..} (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
..}) = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Cancelled -> PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_action = HOA_Pan $ - _panHandler_panDelta }
MouseDragState
MouseDragState_Down -> PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler ph }
MouseDragState
_ -> PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = case _mouseDrag_state of
MouseDragState
MouseDragState_Dragging -> SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just (SomePotatoHandler -> Maybe SomePotatoHandler)
-> SomePotatoHandler -> Maybe SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ PanHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler PanHandler
ph { _panHandler_panDelta = delta }
MouseDragState
MouseDragState_Up -> case Maybe SomePotatoHandler
_panHandler_maybePrevHandler of
Maybe SomePotatoHandler
Nothing -> SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just (SomePotatoHandler -> Maybe SomePotatoHandler)
-> SomePotatoHandler -> Maybe SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ PanHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (PanHandler
forall a. Default a => a
def :: PanHandler)
Just SomePotatoHandler
x -> SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just SomePotatoHandler
x
MouseDragState
_ -> Text -> Maybe SomePotatoHandler
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"not posible"
, _potatoHandlerOutput_action = HOA_Pan (delta - _panHandler_panDelta)
} where delta :: XY
delta = XY
_mouseDrag_to XY -> XY -> XY
forall a. Num a => a -> a -> a
- XY
_mouseDrag_from
pHandleKeyboard :: PanHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard PanHandler {Maybe SomePotatoHandler
XY
_panHandler_panDelta :: PanHandler -> XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
..} 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
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pRefreshHandler :: PanHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler ph :: PanHandler
ph@PanHandler {Maybe SomePotatoHandler
XY
_panHandler_panDelta :: PanHandler -> XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
..} PotatoHandlerInput
phi = SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just (SomePotatoHandler -> Maybe SomePotatoHandler)
-> SomePotatoHandler -> Maybe SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ PanHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler PanHandler
ph {
_panHandler_maybePrevHandler = join $ fmap (flip pRefreshHandler phi) _panHandler_maybePrevHandler
}
pRenderHandler :: PanHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler PanHandler {Maybe SomePotatoHandler
XY
_panHandler_panDelta :: PanHandler -> XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
..} PotatoHandlerInput
phi = case Maybe SomePotatoHandler
_panHandler_maybePrevHandler of
Maybe SomePotatoHandler
Nothing -> HandlerRenderOutput
forall a. Default a => a
def
Just SomePotatoHandler
x -> SomePotatoHandler -> PotatoHandlerInput -> HandlerRenderOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler SomePotatoHandler
x PotatoHandlerInput
phi
pIsHandlerActive :: PanHandler -> HandlerActiveState
pIsHandlerActive PanHandler
_ = HandlerActiveState
HAS_Active_Mouse
pHandlerTool :: PanHandler -> Maybe Tool
pHandlerTool PanHandler
_ = Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Pan