Handler.hs

{-# 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.SElts
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
  | HOA_LayersScroll Int
  | HOA_Preview Preview.Preview 
  deriving (Show)

handlerOutputAction_isNothing :: HandlerOutputAction -> Bool  
handlerOutputAction_isNothing = \case
  HOA_Nothing -> True
  _ -> False

handlerOutputAction_isSelect :: HandlerOutputAction -> Bool
handlerOutputAction_isSelect = \case
  HOA_Select _ _ -> True
  _ -> False

-- TODO split out into mutually exclusive actions
data PotatoHandlerOutput = PotatoHandlerOutput {
    _potatoHandlerOutput_nextHandler             :: Maybe SomePotatoHandler

    , _potatoHandlerOutput_action                  :: HandlerOutputAction
  } deriving (Show)



instance Default PotatoHandlerOutput where
  def = PotatoHandlerOutput {
      _potatoHandlerOutput_nextHandler = Nothing
      , _potatoHandlerOutput_action = HOA_Nothing
    }

-- TODO replace this with just GoatState
data PotatoHandlerInput = PotatoHandlerInput {
    -- from PFOutput
    _potatoHandlerInput_pFState                   :: OwlPFState
    , _potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
    , _potatoHandlerInput_broadPhase              :: BroadPhaseState
    , _potatoHandlerInput_renderCache :: RenderCache

    -- from Frontend
    , _potatoHandlerInput_layersState             :: LayersState
    , _potatoHandlerInput_screenRegion            :: LBox


    -- from Backend
    -- basically, handlers are created based on contents of selection, and handlers themselves are expected to use partial methods on selection to get relevant information in order to modify the selection
    -- note that selection is dynamically updated each type a change is made so it always has up to date information during a multi-step manipulate
    -- this is sort of just how it is right now, I wish it weren't so :_(
    , _potatoHandlerInput_selection               :: Selection
    , _potatoHandlerInput_canvasSelection         :: CanvasSelection

    -- TODO
    --, _potatoHandlerInput_canvasSelection :: CanvasSelection
    -- superOwlParliament_convertToCanvasSelection
  }

type ColorType = ()
data SimpleBoxHandlerRenderOutput = SimpleBoxHandlerRenderOutput {
    _simpleBoxHandlerRenderOutput_box             :: LBox
    , _simpleBoxHandlerRenderOutput_fillText      :: Maybe PChar -- fills the entire box with the same char
    , _simpleBoxHandlerRenderOutput_fillTextColor :: ColorType
    , _simpleBoxHandlerRenderOutput_bgColor       :: ColorType
  }

-- TODO remove renaming and move it into LayersHandlerRenderEntry
data LayersHandlerRenderEntrySelectedState = LHRESS_ChildSelected | LHRESS_Selected | LHRESS_InheritSelected | LHRESS_None deriving (Show, Eq)

{--instance Eq LayersHandlerRenderEntrySelectedState where
  (==) (LHRESS_Renaming x) (LHRESS_Renaming y) = x == y
  (==) LHRESS_Selected LHRESS_Selected = True
  (==) LHRESS_InheritSelected LHRESS_InheritSelected = True
  (==) LHRESS_None LHRESS_None = True
  (==) LHRESS_ChildSelected LHRESS_ChildSelected = True
  (==) _ _ = False--}

-- depth at which dots are added if any
type LayersHandlerRenderEntryDots = Maybe Int
-- are we renaming this one
type LayersHandlerRenderEntryRenaming = Maybe TZ.TextZipper

data LayersHandlerRenderEntry =
  LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState LayersHandlerRenderEntryDots LayersHandlerRenderEntryRenaming LayerEntry
  | LayersHandlerRenderEntryDummy Int
  deriving (Eq, Show)

layersHandlerRenderEntry_depth :: LayersHandlerRenderEntry -> Int
layersHandlerRenderEntry_depth (LayersHandlerRenderEntryNormal _ _ _ lentry) = layerEntry_depth lentry
layersHandlerRenderEntry_depth (LayersHandlerRenderEntryDummy i) = i

-- hack to render layers view via HandlerRenderOutput (we could have just as well put this in LayerState I guesss)
data LayersViewHandlerRenderOutput = LayersViewHandlerRenderOutput {
    _layersViewHandlerRenderOutput_entries :: Seq LayersHandlerRenderEntry
  } deriving (Eq, Show)

instance Default LayersViewHandlerRenderOutput where
  def = LayersViewHandlerRenderOutput {
      _layersViewHandlerRenderOutput_entries = Seq.empty
    }

data RenderHandleColor = RHC_Default | RHC_Attachment | RHC_AttachmentHighlight deriving (Show, Eq)

-- TODO come up with better name
data RenderHandle = RenderHandle {
    _renderHandle_box     :: LBox
    , _renderHandle_char  :: Maybe PChar
    , _renderHandle_color :: RenderHandleColor
  } deriving (Show, Eq)

defaultRenderHandle :: LBox -> RenderHandle
defaultRenderHandle lbox = RenderHandle lbox (Just 'X') RHC_Default

-- TODO come up with better name
data HandlerRenderOutput = HandlerRenderOutput {
    _handlerRenderOutput_temp :: [RenderHandle] -- list of coordinates where there are handles
  } deriving (Eq)

instance Semigroup HandlerRenderOutput where
  a <> b = HandlerRenderOutput {
      _handlerRenderOutput_temp = _handlerRenderOutput_temp a <> _handlerRenderOutput_temp b
    }

instance Default HandlerRenderOutput where
  def = emptyHandlerRenderOutput

emptyHandlerRenderOutput :: HandlerRenderOutput
emptyHandlerRenderOutput = HandlerRenderOutput { _handlerRenderOutput_temp = [] }

data HandlerActiveState = HAS_Active_Mouse | HAS_Active_Keyboard | HAS_Active_Waiting | HAS_Inactive deriving (Show, Eq)

handlerActiveState_isActive :: HandlerActiveState -> Bool
handlerActiveState_isActive = \case
  HAS_Inactive -> False
  _ -> True
  

-- we check handler name for debug reasons so it's useful to have constants
-- there should be no non-test code that depends on comparing pHandlerName
handlerName_box :: Text
handlerName_box = "BoxHandler"
handlerName_simpleLine :: Text
handlerName_simpleLine = "AutoLineHandler"
handlerName_simpleLine_endPoint :: Text
handlerName_simpleLine_endPoint = "AutoLineEndPointHandler"
handlerName_simpleLine_midPoint :: Text
handlerName_simpleLine_midPoint = "AutoLineMidPointHandler"
handlerName_simpleLine_textLabel :: Text
handlerName_simpleLine_textLabel = "AutoLineLabelHandler"
handlerName_simpleLine_textLabelMover :: Text
handlerName_simpleLine_textLabelMover = "AutoLineLabelMoverHandler"
handlerName_layers :: Text
handlerName_layers = "LayersHandler"
handlerName_layersRename :: Text
handlerName_layersRename = "LayersRenameHandler"
handlerName_cartesianLine :: Text
handlerName_cartesianLine = "CartesianLineHandler"
handlerName_boxText :: Text
handlerName_boxText = "BoxTextHandler"
handlerName_boxLabel :: Text
handlerName_boxLabel = "BoxLabelHandler"
handlerName_textArea :: Text
handlerName_textArea = "TextAreaHandler"
handlerName_pan :: Text
handlerName_pan = "PanHandler"
handlerName_select :: Text
handlerName_select = "SelectHandler"
handlerName_empty :: Text
handlerName_empty = "EmptyHandler"


-- TODO prob replace this with 'data PotatoHandler' rather than typeclass
-- TODO rename methods in here..
-- TODO rename to Manipulator XD
class PotatoHandler h where
  pHandlerName :: h -> Text

  -- TODO do the generic thing where (Show h) whatever (I guess this only works when you use deriving or something though?)
  pHandlerDebugShow :: h -> Text
  pHandlerDebugShow h = pHandlerName h <> " <no debug info>"

  -- TODO consider removing Selection from input args since it should be static through lifetime of handler and therefore passed in during construction
  -- i.e. invariant is selection changed -> new handler

  -- TODO need to add broadphase to args as it's used for finding new selections..
  -- TODO maybe split into handleLayerMouse (MouseDrag) and handleCanvasMouse (RelMosueDrag)?
  -- NOTE, MouseDragState_Cancelled will never be passed into this
  -- return type of Nothing means input is not captured
  pHandleMouse :: h -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
  pHandleMouse _ _ _ = Nothing

  -- return type of Nothing means input is not captured
  pHandleKeyboard :: h -> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
  pHandleKeyboard _ _ _ = Nothing

  -- reset handler if an event came in in between (e.g. due to undo, redo)
  -- returns Nothing if the handler no longer exists after refreshing
  --
  -- FOR NOW we expect this to only be called if handler is not active
  -- FOR NOW this is only allowed to return the existing handler
  -- when we have multi-user, this may return actions (to undo some inprogress state I guess?), and may happen when a handler is active
  --
  pRefreshHandler :: h -> PotatoHandlerInput -> Maybe SomePotatoHandler
  pRefreshHandler _ _ = Nothing

  
  -- TODO change this to an enum so you can capture different notion of activeness
  -- active manipulators will not be overwritten by new handlers via selection from changes
  pIsHandlerActive :: h -> HandlerActiveState
  pIsHandlerActive _ = HAS_Inactive

  pRenderHandler :: h -> PotatoHandlerInput -> HandlerRenderOutput
  pRenderHandler _ _ = def

  -- ad-hoc render function just for layers
  -- note that this renders layers even when there is no drop location to be rendered (which is owned by the LayersHandler)
  -- a bit of a hack but it's easier this way, the other way to do it would have been to put drop location inside of LayersState
  -- layers are different because when rendering drop location, it's not a strict overlay so normal render/handler render (drop location) are combined
  pRenderLayersHandler :: h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
  pRenderLayersHandler _ _ = def

  -- helper method used to check that we aren't feeding invalid mouse states
  pValidateMouse :: h -> RelMouseDrag -> Bool
  -- default version that ensures mouse state is valid when handler is active
  pValidateMouse h (RelMouseDrag MouseDrag {..}) = case _mouseDrag_state of
    MouseDragState_Cancelled -> False
    MouseDragState_Down      -> not . handlerActiveState_isActive $ pIsHandlerActive h
    _                        -> True

  -- determine which selected tool to show
  pHandlerTool :: h -> Maybe Tool
  pHandlerTool _ = Nothing


  -- whether to commit or cancel the Preview operation when replacing the handler or not
  -- True is commit, False is cancel
  --pCommitOrCancelOnReplace :: h -> Bool
  --pCommitOrCancelOnReplace _ = True

data SomePotatoHandler = forall h . PotatoHandler h  => SomePotatoHandler h

instance PotatoHandler SomePotatoHandler where
  pHandlerName (SomePotatoHandler h) = pHandlerName h
  pHandlerDebugShow (SomePotatoHandler h) = pHandlerDebugShow h
  pHandleMouse (SomePotatoHandler h) = pHandleMouse h
  pHandleKeyboard (SomePotatoHandler h) = pHandleKeyboard h
  pIsHandlerActive (SomePotatoHandler h) = pIsHandlerActive h
  pRefreshHandler (SomePotatoHandler h) = pRefreshHandler h
  pRenderHandler (SomePotatoHandler h) = pRenderHandler h
  pRenderLayersHandler (SomePotatoHandler h) = pRenderLayersHandler h
  pValidateMouse (SomePotatoHandler h) = pValidateMouse h
  pHandlerTool (SomePotatoHandler h) = pHandlerTool h

captureWithNoChange :: (PotatoHandler h) => h -> PotatoHandlerOutput
captureWithNoChange h = def {
    _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler h
  }

setHandlerOnly :: (PotatoHandler h) => h -> PotatoHandlerOutput
setHandlerOnly = captureWithNoChange

instance Show SomePotatoHandler where
  show (SomePotatoHandler h) = T.unpack $ "SomePotatoHandler " <> pHandlerName h <> " active: " <> show (pIsHandlerActive h)

testHandleMouse :: SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
testHandleMouse (SomePotatoHandler h) phi rmd = pHandleMouse h phi rmd


data EmptyHandler = EmptyHandler

instance PotatoHandler EmptyHandler where
  pHandlerName _ = "EmptyHandler"
  pHandleMouse _ _ _ = Nothing
  pHandleKeyboard _ _ _ = Nothing
  pRenderHandler _ _ = def
  pValidateMouse _ _ = True


{--
-- you can do something like the below to have handlers share some functionality
-- unfortuantely, the design below is not very composable, although maybe this isn't really something that can be composed
data ActiveHandlerState s = ActiveHandlerState {
    _activeHandlerState_isActive :: Bool
    _activeHandlerState_userState :: s
  }

data ActiveHandler s = ActiveHandler {
  _activeHandler_pHandleMouse :: s -> PotatoHandlerInput -> RelMouseDrag -> (Bool, Maybe PotatoHandlerOutput)
  -- ...
}
--}