{-# 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 = 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_maybePrevHandler :: Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: PanHandler -> XY
..} 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
..} (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
..}) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case MouseDragState
_mouseDrag_state of
    MouseDragState
MouseDragState_Cancelled -> forall a. Default a => a
def { _potatoHandlerOutput_pan :: Maybe XY
_potatoHandlerOutput_pan = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ - XY
_panHandler_panDelta }
    MouseDragState
MouseDragState_Down -> 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 PanHandler
ph }
    MouseDragState
_ -> forall a. Default a => a
def {
        _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = case MouseDragState
_mouseDrag_state of
          MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler PanHandler
ph { _panHandler_panDelta :: XY
_panHandler_panDelta = XY
delta }
          MouseDragState
MouseDragState_Up -> case Maybe SomePotatoHandler
_panHandler_maybePrevHandler of
            Maybe SomePotatoHandler
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (forall a. Default a => a
def :: PanHandler)
            Just SomePotatoHandler
x  -> forall a. a -> Maybe a
Just SomePotatoHandler
x
          MouseDragState
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"not posible"
        , _potatoHandlerOutput_pan :: Maybe XY
_potatoHandlerOutput_pan = forall a. a -> Maybe a
Just (XY
delta forall a. Num a => a -> a -> a
- XY
_panHandler_panDelta)
        --, _potatoHandlerOutput_pan = trace (show x <> " delta " <> show delta <> " pan " <> show _panHandler_panDelta <> " from " <> show _mouseDrag_from <> " to " <> show _mouseDrag_to) $ Just (delta - _panHandler_panDelta)
      } where delta :: XY
delta = XY
_mouseDrag_to forall a. Num a => a -> a -> a
- XY
_mouseDrag_from

  -- TODO keyboard pan
  pHandleKeyboard :: PanHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard PanHandler {Maybe SomePotatoHandler
XY
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: PanHandler -> XY
..} 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
_ = forall a. Maybe a
Nothing

  -- refresh the underlying handler if there is one
  pRefreshHandler :: PanHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler ph :: PanHandler
ph@PanHandler {Maybe SomePotatoHandler
XY
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: PanHandler -> XY
..} PotatoHandlerInput
phi = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler PanHandler
ph {
      _panHandler_maybePrevHandler :: Maybe SomePotatoHandler
_panHandler_maybePrevHandler = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler PotatoHandlerInput
phi) Maybe SomePotatoHandler
_panHandler_maybePrevHandler
    }

  -- render the underlying handler if there is one
  pRenderHandler :: PanHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler PanHandler {Maybe SomePotatoHandler
XY
_panHandler_maybePrevHandler :: Maybe SomePotatoHandler
_panHandler_panDelta :: XY
_panHandler_maybePrevHandler :: PanHandler -> Maybe SomePotatoHandler
_panHandler_panDelta :: PanHandler -> XY
..} PotatoHandlerInput
phi = case Maybe SomePotatoHandler
_panHandler_maybePrevHandler of
    Maybe SomePotatoHandler
Nothing -> forall a. Default a => a
def
    Just SomePotatoHandler
x  -> forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler SomePotatoHandler
x PotatoHandlerInput
phi

  -- always active so we never replace pan handler with new selection from changes (which should never happen anyways)
  pIsHandlerActive :: PanHandler -> Bool
pIsHandlerActive PanHandler
_ = Bool
True

  pHandlerTool :: PanHandler -> Maybe Tool
pHandlerTool PanHandler
_ = forall a. a -> Maybe a
Just Tool
Tool_Pan