{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Flow.Controller.Goat (
  GoatFocusedArea(..)
  , goatState_hasUnsavedChanges
  , makeGoatState
  , goatState_pFState
  , goatState_selectedTool
  , GoatState(..)
  , GoatCmd(..)
  , foldGoatFn

  -- exposed for testing
  , potatoHandlerInputFromGoatState
) where

import           Relude

import           Potato.Data.Text.Unicode
import           Potato.Flow.BroadPhase
import           Potato.Flow.Configuration
import           Potato.Flow.Controller.Handler
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.Manipulator.Box
import           Potato.Flow.Controller.Manipulator.CartLine
import           Potato.Flow.Controller.Manipulator.Common
import           Potato.Flow.Controller.Manipulator.Layers
import           Potato.Flow.Controller.Manipulator.Line
import           Potato.Flow.Controller.Manipulator.Pan
import           Potato.Flow.Controller.Manipulator.Select
import           Potato.Flow.Controller.OwlLayers
import           Potato.Flow.Controller.Types
import           Potato.Flow.Llama
import           Potato.Flow.Math
import           Potato.Flow.Owl
import           Potato.Flow.OwlItem
import           Potato.Flow.OwlState
import           Potato.Flow.OwlWorkspace
import           Potato.Flow.Render
import           Potato.Flow.SEltMethods
import           Potato.Flow.Types

import           Control.Exception                           (assert)
import           Data.Default
import qualified Data.IntMap                                 as IM
import qualified Data.IntSet                                 as IS
import           Data.Maybe
import qualified Data.Sequence                               as Seq
import qualified Data.Text                                   as T


catMaybesSeq :: Seq (Maybe a) -> Seq a
catMaybesSeq :: forall a. Seq (Maybe a) -> Seq a
catMaybesSeq = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter forall a. Maybe a -> Bool
isJust

data GoatFocusedArea =
  GoatFocusedArea_Layers
  | GoatFocusedArea_Canvas
  | GoatFocusedArea_Other -- focus is some area that is not owned by tinytools (e.g. the params widgets)
  | GoatFocusedArea_None
  deriving (GoatFocusedArea -> GoatFocusedArea -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GoatFocusedArea -> GoatFocusedArea -> Bool
$c/= :: GoatFocusedArea -> GoatFocusedArea -> Bool
== :: GoatFocusedArea -> GoatFocusedArea -> Bool
$c== :: GoatFocusedArea -> GoatFocusedArea -> Bool
Eq, Int -> GoatFocusedArea -> ShowS
[GoatFocusedArea] -> ShowS
GoatFocusedArea -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoatFocusedArea] -> ShowS
$cshowList :: [GoatFocusedArea] -> ShowS
show :: GoatFocusedArea -> String
$cshow :: GoatFocusedArea -> String
showsPrec :: Int -> GoatFocusedArea -> ShowS
$cshowsPrec :: Int -> GoatFocusedArea -> ShowS
Show)

-- TODO move into its own file
data GoatState = GoatState {

    -- TODO make GoatTab
    -- unique to each document
    GoatState -> OwlPFWorkspace
_goatState_workspace                 :: OwlPFWorkspace
    , GoatState -> XY
_goatState_pan                     :: XY -- panPos is position of upper left corner of canvas relative to screen
    , GoatState -> Selection
_goatState_selection               :: Selection
    , GoatState -> CanvasSelection
_goatState_canvasSelection         :: CanvasSelection
    , GoatState -> BroadPhaseState
_goatState_broadPhaseState         :: BroadPhaseState
    , GoatState -> LayersState
_goatState_layersState             :: LayersState
    , GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas          :: RenderedCanvasRegion
    , GoatState -> RenderedCanvasRegion
_goatState_renderedSelection       :: RenderedCanvasRegion -- TODO need sparse variant
    , GoatState -> SomePotatoHandler
_goatState_handler                 :: SomePotatoHandler
    , GoatState -> SomePotatoHandler
_goatState_layersHandler           :: SomePotatoHandler
    -- TODO consider moving into _goatState_workspace
    , GoatState -> AttachmentMap
_goatState_attachmentMap           :: AttachmentMap -- map of targets to things attached to it. This is a cache that gets updated over time and can be regenerated from the current OwlTree
    , GoatState -> RenderCache
_goatState_renderCache             :: RenderCache

    -- shared across documents
    , GoatState -> PotatoConfiguration
_goatState_configuration           :: PotatoConfiguration -- maybe also move PotatoDefaultParameters into this
    , GoatState -> PotatoDefaultParameters
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
    , GoatState -> MouseDrag
_goatState_mouseDrag               :: MouseDrag -- last mouse dragging state, this is a little questionable, arguably we should only store stuff needed, not the entire mouseDrag
    , GoatState -> XY
_goatState_screenRegion            :: XY -- the screen dimensions
    , GoatState -> Maybe SEltTree
_goatState_clipboard               :: Maybe SEltTree
    , GoatState -> GoatFocusedArea
_goatState_focusedArea             :: GoatFocusedArea
    , GoatState -> Text
_goatState_unbrokenInput       :: Text -- grapheme clusters are inputed as several keyboard character events so we track these inputs here

    -- debug stuff (shared across documents)
    , GoatState -> Text
_goatState_debugLabel              :: Text
    , GoatState -> [GoatCmd]
_goatState_debugCommands           :: [GoatCmd]

  } deriving (Int -> GoatState -> ShowS
[GoatState] -> ShowS
GoatState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoatState] -> ShowS
$cshowList :: [GoatState] -> ShowS
show :: GoatState -> String
$cshow :: GoatState -> String
showsPrec :: Int -> GoatState -> ShowS
$cshowsPrec :: Int -> GoatState -> ShowS
Show)

makeGoatState :: XY -> (OwlPFState, ControllerMeta) -> GoatState
makeGoatState :: XY -> (OwlPFState, ControllerMeta) -> GoatState
makeGoatState (V2 Int
screenx Int
screeny) (OwlPFState
initialstate, ControllerMeta
controllermeta) = GoatState
goat where
    initialowlpfstate :: OwlPFState
initialowlpfstate = OwlPFState
initialstate
    -- initialize broadphase with initial state
    initialAsSuperOwlChanges :: IntMap (Maybe SuperOwl)
initialAsSuperOwlChanges = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
rid (OwlItemMeta
oem, OwlItem
oe) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
rid OwlItemMeta
oem OwlItem
oe) forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
initialstate
    (NeedsUpdateSet
_, BroadPhaseState
initialbp) = forall a.
HasOwlTree a =>
a
-> IntMap (Maybe SuperOwl)
-> BPTree
-> (NeedsUpdateSet, BroadPhaseState)
update_bPTree OwlPFState
initialowlpfstate IntMap (Maybe SuperOwl)
initialAsSuperOwlChanges BPTree
emptyBPTree
    initiallayersstate :: LayersState
initiallayersstate = OwlPFState -> LayerMetaMap -> LayersState
makeLayersStateFromOwlPFState OwlPFState
initialowlpfstate (ControllerMeta -> LayerMetaMap
_controllerMeta_layers ControllerMeta
controllermeta)

    -- TODO DELETE
    -- TODO wrap this in a helper function in Render
    -- TODO we want to render the whole screen, not just the canvas
    initialCanvasBox :: LBox
initialCanvasBox = SCanvas -> LBox
_sCanvas_box forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> SCanvas
_owlPFState_canvas forall a b. (a -> b) -> a -> b
$ OwlPFState
initialowlpfstate
    initialselts :: [OwlSubItem]
initialselts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(OwlItemMeta
_, OwlItem
oelt) -> OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
oelt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
initialowlpfstate
    initialemptyrcr :: RenderedCanvasRegion
initialemptyrcr = LBox -> RenderedCanvasRegion
emptyRenderedCanvasRegion LBox
initialCanvasBox
    initialrendercontext :: RenderContext
initialrendercontext = RenderContext {
      _renderContext_owlTree :: OwlTree
_renderContext_owlTree = forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree OwlPFState
initialowlpfstate
      , _renderContext_layerMetaMap :: LayerMetaMap
_renderContext_layerMetaMap = LayersState -> LayerMetaMap
_layersState_meta LayersState
initiallayersstate
      , _renderContext_broadPhase :: BroadPhaseState
_renderContext_broadPhase = BroadPhaseState
initialbp -- this is ignored but we may as well set in correctly
      , _renderContext_renderedCanvasRegion :: RenderedCanvasRegion
_renderContext_renderedCanvasRegion = RenderedCanvasRegion
initialemptyrcr
    }
    initialrc :: RenderedCanvasRegion
initialrc = RenderContext -> RenderedCanvasRegion
_renderContext_renderedCanvasRegion forall a b. (a -> b) -> a -> b
$ LBox -> [OwlSubItem] -> RenderContext -> RenderContext
render LBox
initialCanvasBox [OwlSubItem]
initialselts RenderContext
initialrendercontext

    goat :: GoatState
goat = GoatState {
        _goatState_workspace :: OwlPFWorkspace
_goatState_workspace      = OwlPFState -> OwlPFWorkspace -> OwlPFWorkspace
loadOwlPFStateIntoWorkspace (OwlPFState
initialstate) OwlPFWorkspace
emptyWorkspace
        , _goatState_pan :: XY
_goatState_pan             = ControllerMeta -> XY
_controllerMeta_pan ControllerMeta
controllermeta
        , _goatState_mouseDrag :: MouseDrag
_goatState_mouseDrag       = forall a. Default a => a
def
        , _goatState_handler :: SomePotatoHandler
_goatState_handler         = forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler EmptyHandler
EmptyHandler
        , _goatState_layersHandler :: SomePotatoHandler
_goatState_layersHandler   = forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (forall a. Default a => a
def :: LayersHandler)
        , _goatState_configuration :: PotatoConfiguration
_goatState_configuration = forall a. Default a => a
def
        , _goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_potatoDefaultParameters = forall a. Default a => a
def
        , _goatState_attachmentMap :: AttachmentMap
_goatState_attachmentMap = OwlTree -> AttachmentMap
owlTree_makeAttachmentMap (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
initialstate)
        , _goatState_debugLabel :: Text
_goatState_debugLabel      = Text
""
        , _goatState_selection :: Selection
_goatState_selection       = forall a. IsParliament a => a
isParliament_empty
        , _goatState_canvasSelection :: CanvasSelection
_goatState_canvasSelection = Seq SuperOwl -> CanvasSelection
CanvasSelection forall a. Seq a
Seq.empty
        , _goatState_broadPhaseState :: BroadPhaseState
_goatState_broadPhaseState = BroadPhaseState
initialbp
        , _goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_renderedCanvas = RenderedCanvasRegion
initialrc
        , _goatState_renderedSelection :: RenderedCanvasRegion
_goatState_renderedSelection = RenderedCanvasRegion
initialemptyrcr
        , _goatState_layersState :: LayersState
_goatState_layersState     = LayersState
initiallayersstate
        , _goatState_renderCache :: RenderCache
_goatState_renderCache = RenderCache
emptyRenderCache
        , _goatState_clipboard :: Maybe SEltTree
_goatState_clipboard = forall a. Maybe a
Nothing
        , _goatState_focusedArea :: GoatFocusedArea
_goatState_focusedArea = GoatFocusedArea
GoatFocusedArea_None
        , _goatState_unbrokenInput :: Text
_goatState_unbrokenInput = Text
""
        , _goatState_screenRegion :: XY
_goatState_screenRegion = forall a. a -> a -> V2 a
V2 Int
screenx Int
screeny forall a. Num a => a -> a -> a
- (ControllerMeta -> XY
_controllerMeta_pan ControllerMeta
controllermeta)
        , _goatState_debugCommands :: [GoatCmd]
_goatState_debugCommands = []
      }


goatState_pFState :: GoatState -> OwlPFState
goatState_pFState :: GoatState -> OwlPFState
goatState_pFState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFWorkspace
_goatState_workspace

-- TODO instance GoatState HasOwlTree
goatState_owlTree :: GoatState -> OwlTree
goatState_owlTree :: GoatState -> OwlTree
goatState_owlTree = OwlPFState -> OwlTree
_owlPFState_owlTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFState
goatState_pFState

goatState_hasUnsavedChanges :: GoatState -> Bool
goatState_hasUnsavedChanges :: GoatState -> Bool
goatState_hasUnsavedChanges = LlamaStack -> Bool
llamaStack_hasUnsavedChanges forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFWorkspace
_goatState_workspace

goatState_selectedTool :: GoatState -> Tool
goatState_selectedTool :: GoatState -> Tool
goatState_selectedTool = forall a. a -> Maybe a -> a
fromMaybe Tool
Tool_Select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h. PotatoHandler h => h -> Maybe Tool
pHandlerTool forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> SomePotatoHandler
_goatState_handler

-- TODO deprecate this in favor of Endo style
data GoatCmd =
  GoatCmdTool Tool
  | GoatCmdSetFocusedArea GoatFocusedArea
  | GoatCmdLoad EverythingLoadState

  -- command based input for widgets not owned by tiny tools
  | GoatCmdWSEvent WSEvent
  | GoatCmdSetCanvasRegionDim XY
  | GoatCmdNewFolder Text

  -- direct input for widgets owned by tiny tools
  | GoatCmdMouse LMouseData
  | GoatCmdKeyboard KeyboardData

  -- debug nonsense
  | GoatCmdSetDebugLabel Text
  deriving (Int -> GoatCmd -> ShowS
[GoatCmd] -> ShowS
GoatCmd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoatCmd] -> ShowS
$cshowList :: [GoatCmd] -> ShowS
show :: GoatCmd -> String
$cshow :: GoatCmd -> String
showsPrec :: Int -> GoatCmd -> ShowS
$cshowsPrec :: Int -> GoatCmd -> ShowS
Show)



-- Ok, don't think this needs to be a part of GoatCmdTempOutput but does need to be a part of GoatState
-- TODO do this later
{-
data DynGoatFlags = DynGoatFlags {
  _dynGoatFlags_tool           = r_tool
  , _dynGoatFlags_selection    = r_selection
  , _dynGoatFlags_layers       = r_layers
  , _dynGoatFlags_pan          = r_pan
  , _dynGoatFlags_broadPhase   = r_broadphase
  , _dynGoatFlags_canvas = r_canvas
  , _dynGoatFlags_renderedCanvas = r_renderedCanvas
  , _dynGoatFlags_handlerRenderOutput =  r_handlerRenderOutput
} deriving (Show)

data GoatStateFlag = GoatStateFlag_Tool | GoatStateFlag_Selection | GoatStateFlag_Layers | GoatStateFlag_Pan | GoatStateFlag_BroadPhase | GoatStateFlag_Canvas | GoatStateFlag_RenderedCanvasRegion | GoatStateFlag_HandlerRenderOutput deriving (Show, Eq)
-}


data GoatCmdTempOutput = GoatCmdTempOutput {
  GoatCmdTempOutput -> GoatState
_goatCmdTempOutput_goatState               :: GoatState
  --, _goatCmdTempOutput_wasCanvasInput :: Bool
  --, _goatCmdTempOutput_wasLayerInput :: Bool

  , GoatCmdTempOutput -> Maybe SomePotatoHandler
_goatCmdTempOutput_nextHandler           :: Maybe SomePotatoHandler

  , GoatCmdTempOutput -> Maybe (Bool, Selection)
_goatCmdTempOutput_select                :: Maybe (Bool, Selection)
  , GoatCmdTempOutput -> Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent               :: Maybe (Bool, WSEvent) -- bool is true if it was a canvas handler event
  , GoatCmdTempOutput -> Maybe XY
_goatCmdTempOutput_pan                   :: Maybe XY
  , GoatCmdTempOutput -> Maybe LayersState
_goatCmdTempOutput_layersState           :: Maybe LayersState
  , GoatCmdTempOutput -> IntMap (Maybe SuperOwl)
_goatCmdTempOutput_changesFromToggleHide :: SuperOwlChanges
} deriving (Int -> GoatCmdTempOutput -> ShowS
[GoatCmdTempOutput] -> ShowS
GoatCmdTempOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoatCmdTempOutput] -> ShowS
$cshowList :: [GoatCmdTempOutput] -> ShowS
show :: GoatCmdTempOutput -> String
$cshow :: GoatCmdTempOutput -> String
showsPrec :: Int -> GoatCmdTempOutput -> ShowS
$cshowsPrec :: Int -> GoatCmdTempOutput -> ShowS
Show)

-- helpers to extract stuff out of goatState because we use record wildcards and can't access otherwise
goatCmdTempOutput_screenRegion :: GoatCmdTempOutput -> XY
goatCmdTempOutput_screenRegion :: GoatCmdTempOutput -> XY
goatCmdTempOutput_screenRegion = GoatState -> XY
_goatState_screenRegion forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatCmdTempOutput -> GoatState
_goatCmdTempOutput_goatState

goatCmdTempOutput_layersHandler :: GoatCmdTempOutput -> SomePotatoHandler
goatCmdTempOutput_layersHandler :: GoatCmdTempOutput -> SomePotatoHandler
goatCmdTempOutput_layersHandler = GoatState -> SomePotatoHandler
_goatState_layersHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatCmdTempOutput -> GoatState
_goatCmdTempOutput_goatState


instance Default GoatCmdTempOutput where
  def :: GoatCmdTempOutput
def = GoatCmdTempOutput {

      -- TODO just don't use Default if you're gonna do this...
      _goatCmdTempOutput_goatState :: GoatState
_goatCmdTempOutput_goatState = forall a. HasCallStack => a
undefined --error "this is expected to be overwritten during initialization"

      , _goatCmdTempOutput_nextHandler :: Maybe SomePotatoHandler
_goatCmdTempOutput_nextHandler  = forall a. Maybe a
Nothing
      , _goatCmdTempOutput_select :: Maybe (Bool, Selection)
_goatCmdTempOutput_select      = forall a. Maybe a
Nothing
      , _goatCmdTempOutput_pFEvent :: Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent     = forall a. Maybe a
Nothing
      , _goatCmdTempOutput_pan :: Maybe XY
_goatCmdTempOutput_pan         = forall a. Maybe a
Nothing
      , _goatCmdTempOutput_layersState :: Maybe LayersState
_goatCmdTempOutput_layersState = forall a. Maybe a
Nothing
      , _goatCmdTempOutput_changesFromToggleHide :: IntMap (Maybe SuperOwl)
_goatCmdTempOutput_changesFromToggleHide = forall a. IntMap a
IM.empty
    }

makeGoatCmdTempOutputFromNothing :: GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing :: GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState = forall a. Default a => a
def {
    _goatCmdTempOutput_goatState :: GoatState
_goatCmdTempOutput_goatState = GoatState
goatState

    -- NOTE the value of _potatoHandlerOutput_nextHandler is not directly translated here
    -- PotatoHandlerOutput interpretation: isNothing _potatoHandlerOutput_nextHandler => handler does not capture input
    -- GoatCmdTempOutput interpretation (when non-canvas input):
    --    -isNothing _potatoHandlerOutput_nextHandler => the particular event we just processed is not related to the canvas handler
    --    -so in this case we default _goatCmdTempOutput_nextHandler = Just _goatState_handler
    , _goatCmdTempOutput_nextHandler :: Maybe SomePotatoHandler
_goatCmdTempOutput_nextHandler = forall a. a -> Maybe a
Just (GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState)
  }

makeGoatCmdTempOutputFromNothingClearHandler :: GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothingClearHandler :: GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothingClearHandler GoatState
goatState = forall a. Default a => a
def {
    _goatCmdTempOutput_goatState :: GoatState
_goatCmdTempOutput_goatState = GoatState
goatState
  }

makeGoatCmdTempOutputFromEvent :: GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent :: GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent GoatState
goatState WSEvent
wsev = (GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState) {
    _goatCmdTempOutput_pFEvent :: Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent = forall a. a -> Maybe a
Just (Bool
False, WSEvent
wsev)
  }

makeGoatCmdTempOutputFromMaybeEvent :: GoatState -> Maybe WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromMaybeEvent :: GoatState -> Maybe WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromMaybeEvent GoatState
goatState Maybe WSEvent
mwsev = (GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState) {
    _goatCmdTempOutput_pFEvent :: Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WSEvent
x -> (Bool
False,WSEvent
x)) Maybe WSEvent
mwsev
  }

makeGoatCmdTempOutputFromPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromPotatoHandlerOutput GoatState
goatState PotatoHandlerOutput {Maybe (Bool, Selection)
Maybe XY
Maybe WSEvent
Maybe LayersState
Maybe SomePotatoHandler
IntMap (Maybe SuperOwl)
_potatoHandlerOutput_changesFromToggleHide :: PotatoHandlerOutput -> IntMap (Maybe SuperOwl)
_potatoHandlerOutput_layersState :: PotatoHandlerOutput -> Maybe LayersState
_potatoHandlerOutput_pan :: PotatoHandlerOutput -> Maybe XY
_potatoHandlerOutput_pFEvent :: PotatoHandlerOutput -> Maybe WSEvent
_potatoHandlerOutput_select :: PotatoHandlerOutput -> Maybe (Bool, Selection)
_potatoHandlerOutput_nextHandler :: PotatoHandlerOutput -> Maybe SomePotatoHandler
_potatoHandlerOutput_changesFromToggleHide :: IntMap (Maybe SuperOwl)
_potatoHandlerOutput_layersState :: Maybe LayersState
_potatoHandlerOutput_pan :: Maybe XY
_potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_select :: Maybe (Bool, Selection)
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
..} =  forall a. Default a => a
def {
    _goatCmdTempOutput_goatState :: GoatState
_goatCmdTempOutput_goatState = GoatState
goatState
    , _goatCmdTempOutput_nextHandler :: Maybe SomePotatoHandler
_goatCmdTempOutput_nextHandler = Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler
    , _goatCmdTempOutput_select :: Maybe (Bool, Selection)
_goatCmdTempOutput_select      = Maybe (Bool, Selection)
_potatoHandlerOutput_select
    , _goatCmdTempOutput_pFEvent :: Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WSEvent
x -> (Bool
True,WSEvent
x)) Maybe WSEvent
_potatoHandlerOutput_pFEvent
    , _goatCmdTempOutput_pan :: Maybe XY
_goatCmdTempOutput_pan         = Maybe XY
_potatoHandlerOutput_pan
    , _goatCmdTempOutput_layersState :: Maybe LayersState
_goatCmdTempOutput_layersState = Maybe LayersState
_potatoHandlerOutput_layersState
    , _goatCmdTempOutput_changesFromToggleHide :: IntMap (Maybe SuperOwl)
_goatCmdTempOutput_changesFromToggleHide = IntMap (Maybe SuperOwl)
_potatoHandlerOutput_changesFromToggleHide -- actually not needed, only used by layers
  }


makeGoatCmdTempOutputFromLayersPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromLayersPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromLayersPotatoHandlerOutput GoatState
goatState PotatoHandlerOutput {Maybe (Bool, Selection)
Maybe XY
Maybe WSEvent
Maybe LayersState
Maybe SomePotatoHandler
IntMap (Maybe SuperOwl)
_potatoHandlerOutput_changesFromToggleHide :: IntMap (Maybe SuperOwl)
_potatoHandlerOutput_layersState :: Maybe LayersState
_potatoHandlerOutput_pan :: Maybe XY
_potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_select :: Maybe (Bool, Selection)
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_changesFromToggleHide :: PotatoHandlerOutput -> IntMap (Maybe SuperOwl)
_potatoHandlerOutput_layersState :: PotatoHandlerOutput -> Maybe LayersState
_potatoHandlerOutput_pan :: PotatoHandlerOutput -> Maybe XY
_potatoHandlerOutput_pFEvent :: PotatoHandlerOutput -> Maybe WSEvent
_potatoHandlerOutput_select :: PotatoHandlerOutput -> Maybe (Bool, Selection)
_potatoHandlerOutput_nextHandler :: PotatoHandlerOutput -> Maybe SomePotatoHandler
..} =  forall a. Default a => a
def {
    _goatCmdTempOutput_goatState :: GoatState
_goatCmdTempOutput_goatState = GoatState
goatState {
        _goatState_layersHandler :: SomePotatoHandler
_goatState_layersHandler = case Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler of
          Just SomePotatoHandler
h  -> SomePotatoHandler
h
          Maybe SomePotatoHandler
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected LayersHandler to return a new handler"
      }
    -- TODO flag that this was not canvas input
    , _goatCmdTempOutput_nextHandler :: Maybe SomePotatoHandler
_goatCmdTempOutput_nextHandler = forall a. Maybe a
Nothing
    , _goatCmdTempOutput_select :: Maybe (Bool, Selection)
_goatCmdTempOutput_select      = Maybe (Bool, Selection)
_potatoHandlerOutput_select
    , _goatCmdTempOutput_pFEvent :: Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WSEvent
x -> (Bool
False,WSEvent
x)) Maybe WSEvent
_potatoHandlerOutput_pFEvent
    , _goatCmdTempOutput_pan :: Maybe XY
_goatCmdTempOutput_pan         = Maybe XY
_potatoHandlerOutput_pan
    , _goatCmdTempOutput_layersState :: Maybe LayersState
_goatCmdTempOutput_layersState = Maybe LayersState
_potatoHandlerOutput_layersState
    , _goatCmdTempOutput_changesFromToggleHide :: IntMap (Maybe SuperOwl)
_goatCmdTempOutput_changesFromToggleHide = IntMap (Maybe SuperOwl)
_potatoHandlerOutput_changesFromToggleHide
  }

makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea :: GoatState -> GoatFocusedArea -> GoatCmdTempOutput
makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea :: GoatState -> GoatFocusedArea -> GoatCmdTempOutput
makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea GoatState
goatState GoatFocusedArea
gfa = GoatCmdTempOutput
r where
  didchange :: Bool
didchange = GoatFocusedArea
gfa forall a. Eq a => a -> a -> Bool
/= GoatState -> GoatFocusedArea
_goatState_focusedArea GoatState
goatState
  goatstatewithnewfocus :: GoatState
goatstatewithnewfocus = GoatState
goatState { _goatState_focusedArea :: GoatFocusedArea
_goatState_focusedArea = GoatFocusedArea
gfa }
  noactionneeded :: GoatCmdTempOutput
noactionneeded = GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatstatewithnewfocus
  potatoHandlerInput :: PotatoHandlerInput
potatoHandlerInput = GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
goatState
  -- if we were renaming, finalize the rename operation by sending a fake return key event, I can't think of a less ad-hoc way to do this
  r :: GoatCmdTempOutput
r = if Bool
didchange Bool -> Bool -> Bool
&& forall h. PotatoHandler h => h -> Text
pHandlerName (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState) forall a. Eq a => a -> a -> Bool
== Text
handlerName_layersRename
    then forall a. HasCallStack => Bool -> a -> a
assert (GoatState -> GoatFocusedArea
_goatState_focusedArea GoatState
goatState forall a. Eq a => a -> a -> Bool
== GoatFocusedArea
GoatFocusedArea_Layers) forall a b. (a -> b) -> a -> b
$ case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState) PotatoHandlerInput
potatoHandlerInput (KeyboardKey -> [KeyModifier] -> KeyboardData
KeyboardData KeyboardKey
KeyboardKey_Return []) of
      Maybe PotatoHandlerOutput
Nothing -> GoatCmdTempOutput
noactionneeded
      Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromLayersPotatoHandlerOutput GoatState
goatstatewithnewfocus PotatoHandlerOutput
pho
    else GoatCmdTempOutput
noactionneeded

-- | hack function for resetting both handlers
-- It would be nice if we actually cancel/reset the handlers (such that in progress operations are undone), but I don't think it really matters
forceResetBothHandlersAndMakeGoatCmdTempOutput :: GoatState -> GoatCmdTempOutput
forceResetBothHandlersAndMakeGoatCmdTempOutput :: GoatState -> GoatCmdTempOutput
forceResetBothHandlersAndMakeGoatCmdTempOutput GoatState
goatState = GoatCmdTempOutput
r where

  -- I think this is Ok
  msph_h :: Maybe a
msph_h = forall a. Maybe a
Nothing
  msph_lh :: Maybe SomePotatoHandler
msph_lh = forall a. a -> Maybe a
Just (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (forall a. Default a => a
def :: LayersHandler))

  r :: GoatCmdTempOutput
r = forall a. Default a => a
def {
      _goatCmdTempOutput_goatState :: GoatState
_goatCmdTempOutput_goatState = GoatState
goatState {
          _goatState_layersHandler :: SomePotatoHandler
_goatState_layersHandler = case Maybe SomePotatoHandler
msph_lh of
            Just SomePotatoHandler
x  -> SomePotatoHandler
x
            Maybe SomePotatoHandler
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected LayersHandler to return a new handler"
        }
      , _goatCmdTempOutput_nextHandler :: Maybe SomePotatoHandler
_goatCmdTempOutput_nextHandler = forall a. Maybe a
msph_h
    }

makeHandlerFromNewTool :: GoatState -> Tool -> SomePotatoHandler
makeHandlerFromNewTool :: GoatState -> Tool -> SomePotatoHandler
makeHandlerFromNewTool GoatState{[GoatCmd]
Maybe SEltTree
Text
AttachmentMap
XY
PotatoConfiguration
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFWorkspace
MouseDrag
LayersState
BroadPhaseState
RenderedCanvasRegion
SomePotatoHandler
GoatFocusedArea
_goatState_debugCommands :: [GoatCmd]
_goatState_debugLabel :: Text
_goatState_unbrokenInput :: Text
_goatState_focusedArea :: GoatFocusedArea
_goatState_clipboard :: Maybe SEltTree
_goatState_screenRegion :: XY
_goatState_mouseDrag :: MouseDrag
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_configuration :: PotatoConfiguration
_goatState_renderCache :: RenderCache
_goatState_attachmentMap :: AttachmentMap
_goatState_layersHandler :: SomePotatoHandler
_goatState_handler :: SomePotatoHandler
_goatState_renderedSelection :: RenderedCanvasRegion
_goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_layersState :: LayersState
_goatState_broadPhaseState :: BroadPhaseState
_goatState_canvasSelection :: CanvasSelection
_goatState_selection :: Selection
_goatState_pan :: XY
_goatState_workspace :: OwlPFWorkspace
_goatState_debugCommands :: GoatState -> [GoatCmd]
_goatState_debugLabel :: GoatState -> Text
_goatState_unbrokenInput :: GoatState -> Text
_goatState_focusedArea :: GoatState -> GoatFocusedArea
_goatState_clipboard :: GoatState -> Maybe SEltTree
_goatState_screenRegion :: GoatState -> XY
_goatState_mouseDrag :: GoatState -> MouseDrag
_goatState_potatoDefaultParameters :: GoatState -> PotatoDefaultParameters
_goatState_configuration :: GoatState -> PotatoConfiguration
_goatState_renderCache :: GoatState -> RenderCache
_goatState_attachmentMap :: GoatState -> AttachmentMap
_goatState_layersHandler :: GoatState -> SomePotatoHandler
_goatState_handler :: GoatState -> SomePotatoHandler
_goatState_renderedSelection :: GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas :: GoatState -> RenderedCanvasRegion
_goatState_layersState :: GoatState -> LayersState
_goatState_broadPhaseState :: GoatState -> BroadPhaseState
_goatState_canvasSelection :: GoatState -> CanvasSelection
_goatState_selection :: GoatState -> Selection
_goatState_pan :: GoatState -> XY
_goatState_workspace :: GoatState -> OwlPFWorkspace
..} = \case
  Tool
Tool_Box    -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _boxHandler_creation :: BoxCreationType
_boxHandler_creation = BoxCreationType
BoxCreationType_Box }
  Tool
Tool_Line   -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _autoLineHandler_isCreation :: Bool
_autoLineHandler_isCreation = Bool
True }
  Tool
Tool_CartLine -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _cartLineHandler_isCreation :: Bool
_cartLineHandler_isCreation = Bool
True }
  Tool
Tool_Select -> CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
_goatState_canvasSelection
  Tool
Tool_Text   -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _boxHandler_creation :: BoxCreationType
_boxHandler_creation = BoxCreationType
BoxCreationType_Text }
  Tool
Tool_TextArea -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _boxHandler_creation :: BoxCreationType
_boxHandler_creation = BoxCreationType
BoxCreationType_TextArea }
  Tool
Tool_Pan           -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ (forall a. Default a => a
def :: PanHandler)


-- TODO rename to makeHandlerFromCanvasSelection
makeHandlerFromSelection :: CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection :: CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
selection = case CanvasSelection -> SelectionManipulatorType
computeSelectionType CanvasSelection
selection of
  SelectionManipulatorType
SMTBox         -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ (forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTBoxText     -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ (forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTLine        -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ (forall a. Default a => a
def :: AutoLineHandler)
  SelectionManipulatorType
SMTTextArea    -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ (forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTBoundingBox -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ (forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTNone        -> forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler EmptyHandler
EmptyHandler

maybeUpdateHandlerFromSelection :: SomePotatoHandler -> CanvasSelection -> SomePotatoHandler
maybeUpdateHandlerFromSelection :: SomePotatoHandler -> CanvasSelection -> SomePotatoHandler
maybeUpdateHandlerFromSelection SomePotatoHandler
sph CanvasSelection
selection = case SomePotatoHandler
sph of
  SomePotatoHandler h
h -> if forall h. PotatoHandler h => h -> Bool
pIsHandlerActive h
h
    then SomePotatoHandler
sph
    else CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
selection

makeClipboard :: GoatState -> Maybe SEltTree
makeClipboard :: GoatState -> Maybe SEltTree
makeClipboard goatState :: GoatState
goatState@GoatState {[GoatCmd]
Maybe SEltTree
Text
AttachmentMap
XY
PotatoConfiguration
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFWorkspace
MouseDrag
LayersState
BroadPhaseState
RenderedCanvasRegion
SomePotatoHandler
GoatFocusedArea
_goatState_debugCommands :: [GoatCmd]
_goatState_debugLabel :: Text
_goatState_unbrokenInput :: Text
_goatState_focusedArea :: GoatFocusedArea
_goatState_clipboard :: Maybe SEltTree
_goatState_screenRegion :: XY
_goatState_mouseDrag :: MouseDrag
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_configuration :: PotatoConfiguration
_goatState_renderCache :: RenderCache
_goatState_attachmentMap :: AttachmentMap
_goatState_layersHandler :: SomePotatoHandler
_goatState_handler :: SomePotatoHandler
_goatState_renderedSelection :: RenderedCanvasRegion
_goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_layersState :: LayersState
_goatState_broadPhaseState :: BroadPhaseState
_goatState_canvasSelection :: CanvasSelection
_goatState_selection :: Selection
_goatState_pan :: XY
_goatState_workspace :: OwlPFWorkspace
_goatState_debugCommands :: GoatState -> [GoatCmd]
_goatState_debugLabel :: GoatState -> Text
_goatState_unbrokenInput :: GoatState -> Text
_goatState_focusedArea :: GoatState -> GoatFocusedArea
_goatState_clipboard :: GoatState -> Maybe SEltTree
_goatState_screenRegion :: GoatState -> XY
_goatState_mouseDrag :: GoatState -> MouseDrag
_goatState_potatoDefaultParameters :: GoatState -> PotatoDefaultParameters
_goatState_configuration :: GoatState -> PotatoConfiguration
_goatState_renderCache :: GoatState -> RenderCache
_goatState_attachmentMap :: GoatState -> AttachmentMap
_goatState_layersHandler :: GoatState -> SomePotatoHandler
_goatState_handler :: GoatState -> SomePotatoHandler
_goatState_renderedSelection :: GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas :: GoatState -> RenderedCanvasRegion
_goatState_layersState :: GoatState -> LayersState
_goatState_broadPhaseState :: GoatState -> BroadPhaseState
_goatState_canvasSelection :: GoatState -> CanvasSelection
_goatState_selection :: GoatState -> Selection
_goatState_pan :: GoatState -> XY
_goatState_workspace :: GoatState -> OwlPFWorkspace
..} = Maybe SEltTree
r where
  r :: Maybe SEltTree
r = if forall a. IsParliament a => a -> Bool
isParliament_null Selection
_goatState_selection
    then Maybe SEltTree
_goatState_clipboard
    else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OwlTree -> Selection -> SEltTree
superOwlParliament_toSEltTree (GoatState -> OwlTree
goatState_owlTree GoatState
goatState) Selection
_goatState_selection

deleteSelectionEvent :: GoatState -> Maybe WSEvent
deleteSelectionEvent :: GoatState -> Maybe WSEvent
deleteSelectionEvent GoatState {[GoatCmd]
Maybe SEltTree
Text
AttachmentMap
XY
PotatoConfiguration
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFWorkspace
MouseDrag
LayersState
BroadPhaseState
RenderedCanvasRegion
SomePotatoHandler
GoatFocusedArea
_goatState_debugCommands :: [GoatCmd]
_goatState_debugLabel :: Text
_goatState_unbrokenInput :: Text
_goatState_focusedArea :: GoatFocusedArea
_goatState_clipboard :: Maybe SEltTree
_goatState_screenRegion :: XY
_goatState_mouseDrag :: MouseDrag
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_configuration :: PotatoConfiguration
_goatState_renderCache :: RenderCache
_goatState_attachmentMap :: AttachmentMap
_goatState_layersHandler :: SomePotatoHandler
_goatState_handler :: SomePotatoHandler
_goatState_renderedSelection :: RenderedCanvasRegion
_goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_layersState :: LayersState
_goatState_broadPhaseState :: BroadPhaseState
_goatState_canvasSelection :: CanvasSelection
_goatState_selection :: Selection
_goatState_pan :: XY
_goatState_workspace :: OwlPFWorkspace
_goatState_debugCommands :: GoatState -> [GoatCmd]
_goatState_debugLabel :: GoatState -> Text
_goatState_unbrokenInput :: GoatState -> Text
_goatState_focusedArea :: GoatState -> GoatFocusedArea
_goatState_clipboard :: GoatState -> Maybe SEltTree
_goatState_screenRegion :: GoatState -> XY
_goatState_mouseDrag :: GoatState -> MouseDrag
_goatState_potatoDefaultParameters :: GoatState -> PotatoDefaultParameters
_goatState_configuration :: GoatState -> PotatoConfiguration
_goatState_renderCache :: GoatState -> RenderCache
_goatState_attachmentMap :: GoatState -> AttachmentMap
_goatState_layersHandler :: GoatState -> SomePotatoHandler
_goatState_handler :: GoatState -> SomePotatoHandler
_goatState_renderedSelection :: GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas :: GoatState -> RenderedCanvasRegion
_goatState_layersState :: GoatState -> LayersState
_goatState_broadPhaseState :: GoatState -> BroadPhaseState
_goatState_canvasSelection :: GoatState -> CanvasSelection
_goatState_selection :: GoatState -> Selection
_goatState_pan :: GoatState -> XY
_goatState_workspace :: GoatState -> OwlPFWorkspace
..} = if forall a. IsParliament a => a -> Bool
isParliament_null Selection
_goatState_selection
  then forall a. Maybe a
Nothing
  else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OwlParliament -> AttachmentMap -> WSEvent
WSERemoveEltAndUpdateAttachments (Selection -> OwlParliament
superOwlParliament_toOwlParliament Selection
_goatState_selection) (AttachmentMap
_goatState_attachmentMap)

potatoHandlerInputFromGoatState :: GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState :: GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState {[GoatCmd]
Maybe SEltTree
Text
AttachmentMap
XY
PotatoConfiguration
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFWorkspace
MouseDrag
LayersState
BroadPhaseState
RenderedCanvasRegion
SomePotatoHandler
GoatFocusedArea
_goatState_debugCommands :: [GoatCmd]
_goatState_debugLabel :: Text
_goatState_unbrokenInput :: Text
_goatState_focusedArea :: GoatFocusedArea
_goatState_clipboard :: Maybe SEltTree
_goatState_screenRegion :: XY
_goatState_mouseDrag :: MouseDrag
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_configuration :: PotatoConfiguration
_goatState_renderCache :: RenderCache
_goatState_attachmentMap :: AttachmentMap
_goatState_layersHandler :: SomePotatoHandler
_goatState_handler :: SomePotatoHandler
_goatState_renderedSelection :: RenderedCanvasRegion
_goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_layersState :: LayersState
_goatState_broadPhaseState :: BroadPhaseState
_goatState_canvasSelection :: CanvasSelection
_goatState_selection :: Selection
_goatState_pan :: XY
_goatState_workspace :: OwlPFWorkspace
_goatState_debugCommands :: GoatState -> [GoatCmd]
_goatState_debugLabel :: GoatState -> Text
_goatState_unbrokenInput :: GoatState -> Text
_goatState_focusedArea :: GoatState -> GoatFocusedArea
_goatState_clipboard :: GoatState -> Maybe SEltTree
_goatState_screenRegion :: GoatState -> XY
_goatState_mouseDrag :: GoatState -> MouseDrag
_goatState_potatoDefaultParameters :: GoatState -> PotatoDefaultParameters
_goatState_configuration :: GoatState -> PotatoConfiguration
_goatState_renderCache :: GoatState -> RenderCache
_goatState_attachmentMap :: GoatState -> AttachmentMap
_goatState_layersHandler :: GoatState -> SomePotatoHandler
_goatState_handler :: GoatState -> SomePotatoHandler
_goatState_renderedSelection :: GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas :: GoatState -> RenderedCanvasRegion
_goatState_layersState :: GoatState -> LayersState
_goatState_broadPhaseState :: GoatState -> BroadPhaseState
_goatState_canvasSelection :: GoatState -> CanvasSelection
_goatState_selection :: GoatState -> Selection
_goatState_pan :: GoatState -> XY
_goatState_workspace :: GoatState -> OwlPFWorkspace
..} = PotatoHandlerInput
r where
  last_workspace :: OwlPFWorkspace
last_workspace = OwlPFWorkspace
_goatState_workspace
  last_pFState :: OwlPFState
last_pFState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
last_workspace
  r :: PotatoHandlerInput
r = PotatoHandlerInput {
    _potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_pFState       = OwlPFState
last_pFState
    , _potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters = PotatoDefaultParameters
_goatState_potatoDefaultParameters
    , _potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_broadPhase  = BroadPhaseState
_goatState_broadPhaseState
    , _potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_renderCache = RenderCache
_goatState_renderCache

    -- the screen region in canvas space
    , _potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_screenRegion = XY -> XY -> LBox
LBox (-XY
_goatState_pan) XY
_goatState_screenRegion

    , _potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_layersState     = LayersState
_goatState_layersState
    , _potatoHandlerInput_selection :: Selection
_potatoHandlerInput_selection   = Selection
_goatState_selection
    , _potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_canvasSelection = CanvasSelection
_goatState_canvasSelection
  }




-- | filters out keyboard input based on the configuration
-- must provide last character-unbroken sequence of text input in order to detect grapheme cluster
-- relies on assumption 🙈
-- let ...(n-1)(n) be a sequence of codepoints that is a grapheme cluster
-- then ...(n-1) is also a grapheme cluster
potatoModifyKeyboardKey :: PotatoConfiguration -> Text -> KeyboardData -> Maybe KeyboardData
potatoModifyKeyboardKey :: PotatoConfiguration -> Text -> KeyboardData -> Maybe KeyboardData
potatoModifyKeyboardKey PotatoConfiguration {Bool
Maybe (Maybe Char)
Char -> Int8
_potatoConfiguration_unicodeWideCharFn :: PotatoConfiguration -> Char -> Int8
_potatoConfiguration_allowOrReplaceUnicodeWideChars :: PotatoConfiguration -> Maybe (Maybe Char)
_potatoConfiguration_allowGraphemeClusters :: PotatoConfiguration -> Bool
_potatoConfiguration_unicodeWideCharFn :: Char -> Int8
_potatoConfiguration_allowOrReplaceUnicodeWideChars :: Maybe (Maybe Char)
_potatoConfiguration_allowGraphemeClusters :: Bool
..} Text
lastUnbrokenCharacters KeyboardData
k = case KeyboardData
k of
  KeyboardData (KeyboardKey_Char Char
c) [KeyModifier]
mods -> Maybe KeyboardData
r where
    fulltext :: Text
fulltext = Text -> Char -> Text
T.snoc Text
lastUnbrokenCharacters Char
c
    r :: Maybe KeyboardData
r = if Bool -> Bool
not Bool
_potatoConfiguration_allowGraphemeClusters Bool -> Bool -> Bool
&& Text -> Bool
endsInGraphemeCluster Text
fulltext
      then forall a. Maybe a
Nothing
      else case Maybe (Maybe Char)
_potatoConfiguration_allowOrReplaceUnicodeWideChars of
        Maybe (Maybe Char)
Nothing -> forall a. a -> Maybe a
Just KeyboardData
k
        Just Maybe Char
x -> if Char -> Int8
getCharWidth Char
c forall a. Ord a => a -> a -> Bool
> Int8
1
          then forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (\Char
nc -> forall a. a -> Maybe a
Just (KeyboardKey -> [KeyModifier] -> KeyboardData
KeyboardData (Char -> KeyboardKey
KeyboardKey_Char Char
nc) [KeyModifier]
mods))  Maybe Char
x
          else forall a. a -> Maybe a
Just KeyboardData
k
  KeyboardData
_ -> forall a. a -> Maybe a
Just KeyboardData
k

-- TODO probably should have done "Endo GoatState" instead of "GoatCmd"
-- TODO extract this method into another file
-- TODO make State monad for this
foldGoatFn :: GoatCmd -> GoatState -> GoatState
--foldGoatFn cmd goatStateIgnore = trace ("FOLDING " <> show cmd) $ finalGoatState where
foldGoatFn :: GoatCmd -> GoatState -> GoatState
foldGoatFn GoatCmd
cmd GoatState
goatStateIgnore = GoatState
finalGoatState where

  -- TODO do some sort of rolling buffer here prob
  -- NOTE even with a rolling buffer, I think this will leak if no one forces the thunk!
  --goatState = goatStateIgnore { _goatState_debugCommands = cmd:_goatState_debugCommands }
  goatState' :: GoatState
goatState' = GoatState
goatStateIgnore

  -- it's convenient/lazy to reset unbrokenInput here, this will get overriden in cases where it needs to be
  goatState :: GoatState
goatState = GoatState
goatState' { _goatState_unbrokenInput :: Text
_goatState_unbrokenInput = Text
"" }
  last_unbrokenInput :: Text
last_unbrokenInput = GoatState -> Text
_goatState_unbrokenInput GoatState
goatState'
  last_workspace :: OwlPFWorkspace
last_workspace = GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState
  last_pFState :: OwlPFState
last_pFState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
last_workspace

  potatoHandlerInput :: PotatoHandlerInput
potatoHandlerInput = GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
goatState

  -- TODO this step can update OwlState built-in cache (via select operation)
  -- | Process commands |
  goatCmdTempOutput :: GoatCmdTempOutput
goatCmdTempOutput = case (GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState) of
    SomePotatoHandler h
handler -> case GoatCmd
cmd of
      GoatCmdSetDebugLabel Text
x -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing forall a b. (a -> b) -> a -> b
$ GoatState
goatState { _goatState_debugLabel :: Text
_goatState_debugLabel = Text
x }
      GoatCmdSetCanvasRegionDim XY
x -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing forall a b. (a -> b) -> a -> b
$ GoatState
goatState { _goatState_screenRegion :: XY
_goatState_screenRegion = XY
x }
      GoatCmdWSEvent WSEvent
x ->  GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent GoatState
goatState WSEvent
x
      GoatCmdNewFolder Text
x -> GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent GoatState
goatState WSEvent
newFolderEv where
        folderPos :: OwlSpot
folderPos = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (OwlPFState -> OwlTree
_owlPFState_owlTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState forall a b. (a -> b) -> a -> b
$  (GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState)) (GoatState -> Selection
_goatState_selection GoatState
goatState)
        newFolderEv :: WSEvent
newFolderEv = (OwlSpot, Text) -> WSEvent
WSEAddFolder (OwlSpot
folderPos, Text
x)
      GoatCmdLoad (SPotatoFlow
spf, ControllerMeta
cm) -> GoatCmdTempOutput
r where
        -- HACK this won't get generated until later but we need this to generate layersState...
        -- someday we'll split up foldGoatFn by `GoatCmd` (or switch to Endo `GoatState`) and clean this up
        tempOwlPFStateHack :: OwlPFState
tempOwlPFStateHack = SPotatoFlow -> OwlPFState
sPotatoFlow_to_owlPFState SPotatoFlow
spf
        r :: GoatCmdTempOutput
r = (GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent GoatState
goatState (SPotatoFlow -> WSEvent
WSELoad SPotatoFlow
spf)) {
            _goatCmdTempOutput_pan :: Maybe XY
_goatCmdTempOutput_pan = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ControllerMeta -> XY
_controllerMeta_pan ControllerMeta
cm
            , _goatCmdTempOutput_layersState :: Maybe LayersState
_goatCmdTempOutput_layersState = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OwlPFState -> LayerMetaMap -> LayersState
makeLayersStateFromOwlPFState OwlPFState
tempOwlPFStateHack (ControllerMeta -> LayerMetaMap
_controllerMeta_layers ControllerMeta
cm)
           }


      GoatCmdTool Tool
x -> GoatCmdTempOutput
r where
        -- TODO do we need to cancel the old handler?
        r :: GoatCmdTempOutput
r = GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing (GoatState
goatState { _goatState_handler :: SomePotatoHandler
_goatState_handler = GoatState -> Tool -> SomePotatoHandler
makeHandlerFromNewTool GoatState
goatState Tool
x })

      GoatCmdSetFocusedArea GoatFocusedArea
gfa -> GoatState -> GoatFocusedArea -> GoatCmdTempOutput
makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea GoatState
goatState GoatFocusedArea
gfa

      GoatCmdMouse LMouseData
mouseData ->
        let
          sameSource :: Bool
sameSource = MouseDrag -> Bool
_mouseDrag_isLayerMouse (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState) forall a. Eq a => a -> a -> Bool
== LMouseData -> Bool
_lMouseData_isLayerMouse LMouseData
mouseData
          mouseSourceFailure :: Bool
mouseSourceFailure = MouseDrag -> MouseDragState
_mouseDrag_state (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState) forall a. Eq a => a -> a -> Bool
/= MouseDragState
MouseDragState_Up Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sameSource
          mouseDrag :: MouseDrag
mouseDrag = case MouseDrag -> MouseDragState
_mouseDrag_state (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState) of
            MouseDragState
MouseDragState_Up        -> LMouseData -> MouseDrag
newDrag LMouseData
mouseData
            MouseDragState
MouseDragState_Cancelled -> (LMouseData -> MouseDrag -> MouseDrag
continueDrag LMouseData
mouseData (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState)) { _mouseDrag_state :: MouseDragState
_mouseDrag_state = MouseDragState
MouseDragState_Cancelled }

            MouseDragState
_                        ->  LMouseData -> MouseDrag -> MouseDrag
continueDrag LMouseData
mouseData (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState)

          canvasDrag :: RelMouseDrag
canvasDrag = OwlPFState -> XY -> MouseDrag -> RelMouseDrag
toRelMouseDrag OwlPFState
last_pFState (GoatState -> XY
_goatState_pan GoatState
goatState) MouseDrag
mouseDrag

          goatState_withNewMouse :: GoatState
goatState_withNewMouse = GoatState
goatState {
              _goatState_mouseDrag :: MouseDrag
_goatState_mouseDrag = MouseDrag
mouseDrag
              , _goatState_focusedArea :: GoatFocusedArea
_goatState_focusedArea = if Bool
isLayerMouse then GoatFocusedArea
GoatFocusedArea_Layers else GoatFocusedArea
GoatFocusedArea_Canvas
            }
          -- TODO call makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea and merge outputs instead UG, or is there a trick for us to be renentrant into foldGoatFn?

          noChangeOutput :: GoatCmdTempOutput
noChangeOutput = GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState_withNewMouse

          isLayerMouse :: Bool
isLayerMouse = MouseDrag -> Bool
_mouseDrag_isLayerMouse MouseDrag
mouseDrag

        in case MouseDrag -> MouseDragState
_mouseDrag_state MouseDrag
mouseDrag of

          -- hack to recover after sameSource issue
          -- TODO TEST
          MouseDragState
_ | Bool
mouseSourceFailure -> forall a. HasCallStack => Bool -> a -> a
assert Bool
False forall a b. (a -> b) -> a -> b
$
            GoatState -> GoatCmdTempOutput
forceResetBothHandlersAndMakeGoatCmdTempOutput GoatState
goatState_withNewMouse

          -- if mouse was cancelled, update _goatState_mouseDrag accordingly
          MouseDragState
MouseDragState_Cancelled -> if LMouseData -> Bool
_lMouseData_isRelease LMouseData
mouseData
            then GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing forall a b. (a -> b) -> a -> b
$ GoatState
goatState_withNewMouse { _goatState_mouseDrag :: MouseDrag
_goatState_mouseDrag = forall a. Default a => a
def }
            else GoatCmdTempOutput
noChangeOutput -- still cancelled

          -- if mouse is intended for layers
          MouseDragState
_ | Bool
isLayerMouse -> case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState) PotatoHandlerInput
potatoHandlerInput (MouseDrag -> RelMouseDrag
RelMouseDrag MouseDrag
mouseDrag) of
            Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromLayersPotatoHandlerOutput GoatState
goatState_withNewMouse PotatoHandlerOutput
pho
            Maybe PotatoHandlerOutput
Nothing  -> GoatCmdTempOutput
noChangeOutput

          -- if middle mouse button, create a temporary PanHandler
          MouseDragState
MouseDragState_Down | LMouseData -> MouseButton
_lMouseData_button LMouseData
mouseData forall a. Eq a => a -> a -> Bool
== MouseButton
MouseButton_Middle -> GoatCmdTempOutput
r where
            panhandler :: PanHandler
panhandler = forall a. Default a => a
def { _panHandler_maybePrevHandler :: Maybe SomePotatoHandler
_panHandler_maybePrevHandler = forall a. a -> Maybe a
Just (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler h
handler) }
            r :: GoatCmdTempOutput
r = case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse PanHandler
panhandler PotatoHandlerInput
potatoHandlerInput RelMouseDrag
canvasDrag of
              Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromPotatoHandlerOutput GoatState
goatState_withNewMouse PotatoHandlerOutput
pho
              Maybe PotatoHandlerOutput
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"PanHandler expected to capture mouse input"

          -- pass onto canvas handler
          MouseDragState
_ -> case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
handler PotatoHandlerInput
potatoHandlerInput RelMouseDrag
canvasDrag of
            Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromPotatoHandlerOutput GoatState
goatState_withNewMouse PotatoHandlerOutput
pho

            -- input not captured by handler, pass onto select or select+drag
            Maybe PotatoHandlerOutput
Nothing | MouseDrag -> MouseDragState
_mouseDrag_state MouseDrag
mouseDrag forall a. Eq a => a -> a -> Bool
== MouseDragState
MouseDragState_Down -> forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> Bool
pIsHandlerActive h
handler) GoatCmdTempOutput
r where
              r :: GoatCmdTempOutput
r = case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (forall a. Default a => a
def :: SelectHandler) PotatoHandlerInput
potatoHandlerInput RelMouseDrag
canvasDrag of
                Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromPotatoHandlerOutput GoatState
goatState_withNewMouse PotatoHandlerOutput
pho
                Maybe PotatoHandlerOutput
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"handler was expected to capture this mouse state"

            Maybe PotatoHandlerOutput
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"handler " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (forall h. PotatoHandler h => h -> Text
pHandlerName h
handler) forall a. Semigroup a => a -> a -> a
<> Text
"was expected to capture mouse state " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (MouseDrag -> MouseDragState
_mouseDrag_state MouseDrag
mouseDrag)

      GoatCmdKeyboard KeyboardData
kbd' -> let
          next_unbrokenInput :: Text
next_unbrokenInput = case KeyboardData
kbd' of
            KeyboardData (KeyboardKey_Char Char
c) [KeyModifier]
_ -> Text -> Char -> Text
T.snoc Text
last_unbrokenInput Char
c
            KeyboardData
_ -> Text
""
          mkbd :: Maybe KeyboardData
mkbd =   PotatoConfiguration -> Text -> KeyboardData -> Maybe KeyboardData
potatoModifyKeyboardKey (GoatState -> PotatoConfiguration
_goatState_configuration GoatState
goatState) Text
last_unbrokenInput KeyboardData
kbd'
          goatState_withKeyboard :: GoatState
goatState_withKeyboard =  GoatState
goatState { _goatState_unbrokenInput :: Text
_goatState_unbrokenInput = Text
next_unbrokenInput}
        in case Maybe KeyboardData
mkbd of
          Maybe KeyboardData
Nothing -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState_withKeyboard
          -- special case, treat escape cancel mouse drag as a mouse input
          Just (KeyboardData KeyboardKey
KeyboardKey_Esc [KeyModifier]
_) | MouseDrag -> Bool
mouseDrag_isActive (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard) -> GoatCmdTempOutput
r where
            canceledMouse :: MouseDrag
canceledMouse = MouseDrag -> MouseDrag
cancelDrag (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard)
            goatState_withNewMouse :: GoatState
goatState_withNewMouse = GoatState
goatState_withKeyboard {
                _goatState_mouseDrag :: MouseDrag
_goatState_mouseDrag = MouseDrag
canceledMouse

                -- escape will cancel mouse focus
                -- TODO this isn't correct, you have some handlers that cancel into each other, you should only reset to GoatFocusedArea_None if they canceled to Nothing
                , _goatState_focusedArea :: GoatFocusedArea
_goatState_focusedArea = GoatFocusedArea
GoatFocusedArea_None

              }

            -- TODO use _goatState_focusedArea instead
            r :: GoatCmdTempOutput
r = if MouseDrag -> Bool
_mouseDrag_isLayerMouse (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard)
              then case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState_withKeyboard) PotatoHandlerInput
potatoHandlerInput (MouseDrag -> RelMouseDrag
RelMouseDrag MouseDrag
canceledMouse) of
                Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromLayersPotatoHandlerOutput GoatState
goatState_withNewMouse PotatoHandlerOutput
pho
                Maybe PotatoHandlerOutput
Nothing  -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothingClearHandler GoatState
goatState_withNewMouse
              else case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
handler PotatoHandlerInput
potatoHandlerInput (OwlPFState -> XY -> MouseDrag -> RelMouseDrag
toRelMouseDrag OwlPFState
last_pFState (GoatState -> XY
_goatState_pan GoatState
goatState_withKeyboard) MouseDrag
canceledMouse) of
                Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromPotatoHandlerOutput GoatState
goatState_withNewMouse PotatoHandlerOutput
pho
                Maybe PotatoHandlerOutput
Nothing  -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothingClearHandler GoatState
goatState_withNewMouse

          -- we are in the middle of mouse drag, ignore all keyboard inputs
          -- perhaps a better way to do this is to have handlers capture all inputs when active
          Just KeyboardData
_ | MouseDrag -> Bool
mouseDrag_isActive (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard) -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState_withKeyboard

          Just KeyboardData
kbd ->
            let
              maybeHandleLayers :: Maybe GoatCmdTempOutput
maybeHandleLayers = do
                forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ MouseDrag -> Bool
_mouseDrag_isLayerMouse (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard)
                PotatoHandlerOutput
pho <- forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState_withKeyboard) PotatoHandlerInput
potatoHandlerInput KeyboardData
kbd
                return $ GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromLayersPotatoHandlerOutput GoatState
goatState_withKeyboard PotatoHandlerOutput
pho
            in case Maybe GoatCmdTempOutput
maybeHandleLayers of
              Just GoatCmdTempOutput
x -> GoatCmdTempOutput
x
              Maybe GoatCmdTempOutput
Nothing -> case forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard h
handler PotatoHandlerInput
potatoHandlerInput KeyboardData
kbd of
                Just PotatoHandlerOutput
pho -> GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput
makeGoatCmdTempOutputFromPotatoHandlerOutput GoatState
goatState_withKeyboard PotatoHandlerOutput
pho
                -- input not captured by handler
                -- TODO consider wrapping this all up in KeyboardHandler or something? Unfortunately, copy needs to modify goatState_withKeyboard which PotatoHandlerOutput can't atm
                Maybe PotatoHandlerOutput
Nothing -> case KeyboardData
kbd of
                  KeyboardData KeyboardKey
KeyboardKey_Esc [KeyModifier]
_ ->
                    (GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState_withKeyboard) {
                        -- TODO change tool back to select?
                        -- cancel selection if we are in a neutral mouse state and there is no handler
                        _goatCmdTempOutput_select :: Maybe (Bool, Selection)
_goatCmdTempOutput_select = case MouseDrag -> MouseDragState
_mouseDrag_state (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard) of
                          MouseDragState
MouseDragState_Up        -> forall a. a -> Maybe a
Just (Bool
False, forall a. IsParliament a => a
isParliament_empty)
                          MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just (Bool
False, forall a. IsParliament a => a
isParliament_empty)
                          MouseDragState
_                        -> forall a. Maybe a
Nothing
                      }

                  KeyboardData (KeyboardKey
KeyboardKey_Delete) [] -> GoatCmdTempOutput
r where
                    r :: GoatCmdTempOutput
r = GoatState -> Maybe WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromMaybeEvent GoatState
goatState_withKeyboard (GoatState -> Maybe WSEvent
deleteSelectionEvent GoatState
goatState_withKeyboard)
                  KeyboardData (KeyboardKey
KeyboardKey_Backspace) [] -> GoatCmdTempOutput
r where
                    r :: GoatCmdTempOutput
r = GoatState -> Maybe WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromMaybeEvent GoatState
goatState_withKeyboard (GoatState -> Maybe WSEvent
deleteSelectionEvent GoatState
goatState_withKeyboard)

                  KeyboardData (KeyboardKey_Char Char
'c') [KeyModifier
KeyModifier_Ctrl] -> GoatCmdTempOutput
r where
                    copied :: Maybe SEltTree
copied = GoatState -> Maybe SEltTree
makeClipboard GoatState
goatState_withKeyboard
                    r :: GoatCmdTempOutput
r = GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing forall a b. (a -> b) -> a -> b
$ GoatState
goatState_withKeyboard { _goatState_clipboard :: Maybe SEltTree
_goatState_clipboard = Maybe SEltTree
copied }
                  KeyboardData (KeyboardKey_Char Char
'x') [KeyModifier
KeyModifier_Ctrl] -> GoatCmdTempOutput
r where
                    copied :: Maybe SEltTree
copied = GoatState -> Maybe SEltTree
makeClipboard GoatState
goatState_withKeyboard
                    r :: GoatCmdTempOutput
r = GoatState -> Maybe WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromMaybeEvent (GoatState
goatState_withKeyboard { _goatState_clipboard :: Maybe SEltTree
_goatState_clipboard = Maybe SEltTree
copied }) (GoatState -> Maybe WSEvent
deleteSelectionEvent GoatState
goatState_withKeyboard)
                  KeyboardData (KeyboardKey_Char Char
'v') [KeyModifier
KeyModifier_Ctrl] -> case GoatState -> Maybe SEltTree
_goatState_clipboard GoatState
goatState_withKeyboard of
                    Maybe SEltTree
Nothing    -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState_withKeyboard
                    Just SEltTree
stree -> GoatCmdTempOutput
r where

                      -- TODO this is totally wrong, it won't handle parent/children stuff correctly
                      -- TODO convert to MiniOwlTree :D
                      offsetstree :: SEltTree
offsetstree = XY -> SEltTree -> SEltTree
offsetSEltTree (forall a. a -> a -> V2 a
V2 Int
1 Int
1) SEltTree
stree
                      minitree' :: OwlTree
minitree' = SEltTree -> OwlTree
owlTree_fromSEltTree SEltTree
offsetstree
                      maxid1 :: Int
maxid1 = OwlTree -> Int
owlTree_maxId OwlTree
minitree' forall a. Num a => a -> a -> a
+ Int
1
                      maxid2 :: Int
maxid2 = OwlPFState -> Int
owlPFState_nextId (OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState (GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState_withKeyboard))
                      minitree :: OwlTree
minitree = Int -> OwlTree -> OwlTree
owlTree_reindex (forall a. Ord a => a -> a -> a
max Int
maxid1 Int
maxid2) OwlTree
minitree'
                      spot :: OwlSpot
spot = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (GoatState -> OwlTree
goatState_owlTree GoatState
goatState_withKeyboard) (GoatState -> Selection
_goatState_selection GoatState
goatState_withKeyboard)
                      treePastaEv :: WSEvent
treePastaEv = (OwlSpot, OwlTree) -> WSEvent
WSEAddTree (OwlSpot
spot, OwlTree
minitree)



                      r :: GoatCmdTempOutput
r = GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent (GoatState
goatState_withKeyboard { _goatState_clipboard :: Maybe SEltTree
_goatState_clipboard = forall a. a -> Maybe a
Just SEltTree
offsetstree }) WSEvent
treePastaEv
                  KeyboardData (KeyboardKey_Char Char
'z') [KeyModifier
KeyModifier_Ctrl] -> GoatCmdTempOutput
r where
                    r :: GoatCmdTempOutput
r = GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent GoatState
goatState_withKeyboard WSEvent
WSEUndo
                  KeyboardData (KeyboardKey_Char Char
'y') [KeyModifier
KeyModifier_Ctrl] -> GoatCmdTempOutput
r where
                    r :: GoatCmdTempOutput
r = GoatState -> WSEvent -> GoatCmdTempOutput
makeGoatCmdTempOutputFromEvent GoatState
goatState_withKeyboard WSEvent
WSERedo
                  -- tool hotkeys
                  KeyboardData (KeyboardKey_Char Char
key) [KeyModifier]
_ -> GoatCmdTempOutput
r where
                    mtool :: Maybe Tool
mtool = case Char
key of
                      Char
'v' -> forall a. a -> Maybe a
Just Tool
Tool_Select
                      Char
'p' -> forall a. a -> Maybe a
Just Tool
Tool_Pan
                      Char
'b' -> forall a. a -> Maybe a
Just Tool
Tool_Box
                      Char
'l' -> forall a. a -> Maybe a
Just Tool
Tool_Line
                      Char
't' -> forall a. a -> Maybe a
Just Tool
Tool_Text
                      Char
'n' -> forall a. a -> Maybe a
Just Tool
Tool_TextArea
                      Char
_   -> forall a. Maybe a
Nothing

                    newHandler :: SomePotatoHandler
newHandler = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState_withKeyboard) (GoatState -> Tool -> SomePotatoHandler
makeHandlerFromNewTool GoatState
goatState_withKeyboard) Maybe Tool
mtool
                    r :: GoatCmdTempOutput
r = GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing forall a b. (a -> b) -> a -> b
$ GoatState
goatState_withKeyboard { _goatState_handler :: SomePotatoHandler
_goatState_handler = SomePotatoHandler
newHandler }

                  -- unhandled input
                  KeyboardData
_ -> GoatState -> GoatCmdTempOutput
makeGoatCmdTempOutputFromNothing GoatState
goatState_withKeyboard

  -- | update OwlPFWorkspace from GoatCmdTempOutput |
  (OwlPFWorkspace
workspace_afterEvent, IntMap (Maybe SuperOwl)
cslmap_afterEvent) = case GoatCmdTempOutput -> Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent GoatCmdTempOutput
goatCmdTempOutput of
    -- if there was no update, then changes are not valid
    Maybe (Bool, WSEvent)
Nothing   -> (GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState, forall a. IntMap a
IM.empty)
    Just (Bool
_, WSEvent
wsev) -> (OwlPFWorkspace
r1,IntMap (Maybe SuperOwl)
r2) where
      r1 :: OwlPFWorkspace
r1 = WSEvent -> OwlPFWorkspace -> OwlPFWorkspace
updateOwlPFWorkspace WSEvent
wsev (GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState)
      r2 :: IntMap (Maybe SuperOwl)
r2 = OwlPFWorkspace -> IntMap (Maybe SuperOwl)
_owlPFWorkspace_lastChanges OwlPFWorkspace
r1
  pFState_afterEvent :: OwlPFState
pFState_afterEvent = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
workspace_afterEvent

  -- | update pan from GoatCmdTempOutput |
  next_pan :: XY
next_pan = case GoatCmdTempOutput -> Maybe XY
_goatCmdTempOutput_pan GoatCmdTempOutput
goatCmdTempOutput of
    Maybe XY
Nothing -> GoatState -> XY
_goatState_pan GoatState
goatState
    Just (V2 Int
dx Int
dy) -> forall a. a -> a -> V2 a
V2 (Int
cx0forall a. Num a => a -> a -> a
+Int
dx) (Int
cy0 forall a. Num a => a -> a -> a
+ Int
dy) where
      V2 Int
cx0 Int
cy0 = GoatState -> XY
_goatState_pan GoatState
goatState

  -- | get layersState from GoatCmdTempOutput |
  next_layersState'' :: LayersState
next_layersState'' = case GoatCmdTempOutput -> Maybe LayersState
_goatCmdTempOutput_layersState GoatCmdTempOutput
goatCmdTempOutput of
    Maybe LayersState
Nothing -> GoatState -> LayersState
_goatState_layersState GoatState
goatState
    Just LayersState
ls -> LayersState
ls

  -- | get selection from GoatCmdTempOutput |
  mSelectionFromPho :: Maybe Selection
mSelectionFromPho = case GoatCmdTempOutput -> Maybe (Bool, Selection)
_goatCmdTempOutput_select GoatCmdTempOutput
goatCmdTempOutput of
    Maybe (Bool, Selection)
Nothing -> forall a. Maybe a
Nothing
    --Just (add, sel) -> assert (superOwlParliament_isValid nextot r) $ Just r where
    Just (Bool
add, Selection
sel) -> forall a. HasCallStack => Bool -> a -> a
assert (OwlTree -> Selection -> Bool
superOwlParliament_isValid OwlTree
nextot Selection
r) (forall a. a -> Maybe a
Just Selection
r)where
      nextot :: OwlTree
nextot = OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pFState_afterEvent
      r' :: Selection
r' = if Bool
add
        then OwlTree -> Selection -> Selection -> Selection
superOwlParliament_disjointUnionAndCorrect OwlTree
nextot (GoatState -> Selection
_goatState_selection GoatState
goatState) Selection
sel
        else Selection
sel
      r :: Selection
r = Seq SuperOwl -> Selection
SuperOwlParliament forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
nextot) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Seq SuperOwl
unSuperOwlParliament forall a b. (a -> b) -> a -> b
$ Selection
r'

  -- | compute selection based on changes from updating OwlPFState (i.e. auto select newly created stuff if appropriate) |
  (Bool
isNewSelection', Selection
selectionAfterChanges) = if forall a. IntMap a -> Bool
IM.null IntMap (Maybe SuperOwl)
cslmap_afterEvent
    then (Bool
False, GoatState -> Selection
_goatState_selection GoatState
goatState)
    else (Bool, Selection)
r where

      -- extract elements that got created
      newEltFoldMapFn :: Int -> Maybe SuperOwl -> [SuperOwl]
newEltFoldMapFn Int
rid Maybe SuperOwl
v = case Maybe SuperOwl
v of
        Maybe SuperOwl
Nothing     -> []
        Just SuperOwl
sowl -> if forall a. Int -> IntMap a -> Bool
IM.member Int
rid (OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
last_pFState) then [] else [SuperOwl
sowl]

      -- NOTE, undoing a deleted element counts as a newly created element (and will be auto-selected)
      newlyCreatedSEltls :: [SuperOwl]
newlyCreatedSEltls = forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
IM.foldMapWithKey Int -> Maybe SuperOwl -> [SuperOwl]
newEltFoldMapFn IntMap (Maybe SuperOwl)
cslmap_afterEvent

      sortedNewlyCreatedSEltls :: Selection
sortedNewlyCreatedSEltls = Seq SuperOwl -> Selection
SuperOwlParliament forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition forall a b. (a -> b) -> a -> b
$ OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pFState_afterEvent) (forall a. [a] -> Seq a
Seq.fromList [SuperOwl]
newlyCreatedSEltls)
      -- pretty sure this does the same thing..
      --sortedNewlyCreatedSEltls = makeSortedSuperOwlParliament (_owlPFState_owlTree $ pFState_afterEvent) (Seq.fromList newlyCreatedSEltls)

      wasLoad :: Bool
wasLoad = case GoatCmd
cmd of
        GoatCmdLoad EverythingLoadState
_ -> Bool
True
        GoatCmd
_             -> Bool
False

      r :: (Bool, Selection)
r = if Bool
wasLoad Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SuperOwl]
newlyCreatedSEltls
        -- if there are no newly created elts, we still need to update the selection
        then (\Seq SuperOwl
x -> (Bool
False, Seq SuperOwl -> Selection
SuperOwlParliament Seq SuperOwl
x)) forall a b. (a -> b) -> a -> b
$ forall a. Seq (Maybe a) -> Seq a
catMaybesSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Selection -> Seq SuperOwl
unSuperOwlParliament (GoatState -> Selection
_goatState_selection GoatState
goatState)) forall a b. (a -> b) -> a -> b
$ \SuperOwl
sowl ->
          case forall a. Int -> IntMap a -> Maybe a
IM.lookup (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) IntMap (Maybe SuperOwl)
cslmap_afterEvent of
            -- no changes means not deleted
            Maybe (Maybe SuperOwl)
Nothing       -> forall a. a -> Maybe a
Just SuperOwl
sowl
            -- if deleted, remove it
            Just Maybe SuperOwl
Nothing  -> forall a. Maybe a
Nothing
            -- it was changed, update selection to newest version
            Just (Just SuperOwl
x) -> forall a. a -> Maybe a
Just SuperOwl
x
        else (Bool
True, Selection
sortedNewlyCreatedSEltls)

  -- for now, newly created stuff is the same as anything that got auto selected
  --newlyCreatedRids = IS.fromList . toList . fmap _superOwl_id . unSuperOwlParliament $ selectionAfterChanges

  -- | update the new selection based on previous computations|
  (Bool
isNewSelection, Selection
next_selection) = case Maybe Selection
mSelectionFromPho of
    Just Selection
x  -> forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not Bool
isNewSelection') (Bool
True, Selection
x)
    -- better/more expensive check to ensure mSelectionFromPho stuff is mutually exclusive to selectionAfterChanges
    --Just x -> assert (selectionAfterChanges == _goatState_selection) (True, x)
    Maybe Selection
Nothing -> (Bool
isNewSelection', Selection
selectionAfterChanges)

  -- | update LayersState based from SuperOwlChanges after applying events |
  next_layersState' :: LayersState
next_layersState' = OwlPFState -> IntMap (Maybe SuperOwl) -> LayersState -> LayersState
updateLayers OwlPFState
pFState_afterEvent IntMap (Maybe SuperOwl)
cslmap_afterEvent LayersState
next_layersState''

  -- | auto-expand folders and compute LayersState |
  -- auto expand folders for selected elements + (this will also auto expand when you drag or paste stuff into a folder)
  -- NOTE this will prevent you from ever collapsing a folder that has a selected child in it
  -- so maybe auto expand should only happen on newly created elements or add a way to detect for newly selected elements (e.g. diff between old selection)
  next_layersState :: LayersState
next_layersState = Selection -> OwlPFState -> LayersState -> LayersState
expandAllCollapsedParents Selection
next_selection OwlPFState
pFState_afterEvent LayersState
next_layersState'
  --next_layersState = next_layersState'


  -- | update the next handler |
  mHandlerFromPho :: Maybe SomePotatoHandler
mHandlerFromPho = GoatCmdTempOutput -> Maybe SomePotatoHandler
_goatCmdTempOutput_nextHandler GoatCmdTempOutput
goatCmdTempOutput
  filterHiddenOrLocked :: SuperOwl -> Bool
filterHiddenOrLocked SuperOwl
sowl = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ OwlTree -> Int -> LayerMetaMap -> Bool
layerMetaMap_isInheritHiddenOrLocked (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pFState_afterEvent) (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) (LayersState -> LayerMetaMap
_layersState_meta LayersState
next_layersState)
  next_canvasSelection :: CanvasSelection
next_canvasSelection = OwlTree -> (SuperOwl -> Bool) -> Selection -> CanvasSelection
superOwlParliament_convertToCanvasSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pFState_afterEvent) SuperOwl -> Bool
filterHiddenOrLocked Selection
next_selection
  nextHandlerFromSelection :: SomePotatoHandler
nextHandlerFromSelection = CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
next_canvasSelection
  next_handler' :: SomePotatoHandler
next_handler' = if Bool
isNewSelection
    -- if there is a new selection, update the handler with new selection if handler wasn't active
    then SomePotatoHandler -> CanvasSelection -> SomePotatoHandler
maybeUpdateHandlerFromSelection (forall a. a -> Maybe a -> a
fromMaybe (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler EmptyHandler
EmptyHandler) Maybe SomePotatoHandler
mHandlerFromPho) CanvasSelection
next_canvasSelection
    -- otherwise, use the returned handler or make a new one from selection
    else forall a. a -> Maybe a -> a
fromMaybe SomePotatoHandler
nextHandlerFromSelection Maybe SomePotatoHandler
mHandlerFromPho
  next_layersHandler' :: SomePotatoHandler
next_layersHandler' = GoatCmdTempOutput -> SomePotatoHandler
goatCmdTempOutput_layersHandler GoatCmdTempOutput
goatCmdTempOutput
  (SomePotatoHandler
next_handler, SomePotatoHandler
next_layersHandler) = case GoatCmdTempOutput -> Maybe (Bool, WSEvent)
_goatCmdTempOutput_pFEvent GoatCmdTempOutput
goatCmdTempOutput of


    -- TODO you only need to do this if handler is one that came from mHandlerFromPho
    -- if there was a non-canvas event, reset the handler D:
    -- since we don't have multi-user events, the handler should never be active when this happens
    Just (Bool
False, WSEvent
_) -> forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (forall h. PotatoHandler h => h -> Bool
pIsHandlerActive SomePotatoHandler
next_handler')) forall a b. (a -> b) -> a -> b
$ (SomePotatoHandler
refreshedHandler,SomePotatoHandler
refreshedLayersHandler) where
      -- CAREFUL INFINITE LOOP DANGER WITH USE OF `finalGoatState`
      -- safe for now, since `potatoHandlerInputFromGoatState` does not use `_goatState_handler/_goatState_layersHandler finalGoatState` which is set to `next_handler/next_layersHandler`
      next_potatoHandlerInput :: PotatoHandlerInput
next_potatoHandlerInput = GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
finalGoatState
      refreshedHandler :: SomePotatoHandler
refreshedHandler = forall a. a -> Maybe a -> a
fromMaybe SomePotatoHandler
nextHandlerFromSelection ( forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler SomePotatoHandler
next_handler' PotatoHandlerInput
next_potatoHandlerInput)
      refreshedLayersHandler :: SomePotatoHandler
refreshedLayersHandler = forall a. a -> Maybe a -> a
fromMaybe (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (forall a. Default a => a
def :: LayersHandler)) (forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler SomePotatoHandler
next_layersHandler' PotatoHandlerInput
next_potatoHandlerInput)



    Maybe (Bool, WSEvent)
_ -> (SomePotatoHandler
next_handler', SomePotatoHandler
next_layersHandler')

  -- | TODO enter rename mode for newly created folders |
  -- TODO if cslmap_afterEvent has a newly created folder (i.e. we just createda folder) then we want to enter rename mode for that folder
    -- this is not correct, we want a condition for when we hit the "new folder" button. Perhaps there needs to be a separate command for enter rename and FE triggers 2 events in succession?
  --_goatState_layersHandler

  -- | update AttachmentMap based on new state and clear the cache on these changes |
  next_attachmentMap :: AttachmentMap
next_attachmentMap = IntMap (Maybe SuperOwl) -> AttachmentMap -> AttachmentMap
updateAttachmentMapFromSuperOwlChanges IntMap (Maybe SuperOwl)
cslmap_afterEvent (GoatState -> AttachmentMap
_goatState_attachmentMap GoatState
goatState)
  -- we need to union with `_goatState_attachmentMap` as next_attachmentMap does not contain deleted targets and stuff we detached from
  attachmentMapForComputingChanges :: AttachmentMap
attachmentMapForComputingChanges = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith IntSet -> IntSet -> IntSet
IS.union AttachmentMap
next_attachmentMap (GoatState -> AttachmentMap
_goatState_attachmentMap GoatState
goatState)
  --attachmentChanges = trace "ATTACHMENTS" $ traceShow (IM.size cslmap_afterEvent) $ traceShowId $ getChangesFromAttachmentMap (_owlPFState_owlTree pFState_afterEvent) attachmentMapForComputingChanges cslmap_afterEvent
  attachmentChanges :: IntMap (Maybe SuperOwl)
attachmentChanges = OwlTree
-> AttachmentMap
-> IntMap (Maybe SuperOwl)
-> IntMap (Maybe SuperOwl)
getChangesFromAttachmentMap (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pFState_afterEvent) AttachmentMap
attachmentMapForComputingChanges IntMap (Maybe SuperOwl)
cslmap_afterEvent

  -- | compute SuperOwlChanges for rendering |
  cslmap_withAttachments :: IntMap (Maybe SuperOwl)
cslmap_withAttachments = forall a. IntMap a -> IntMap a -> IntMap a
IM.union IntMap (Maybe SuperOwl)
cslmap_afterEvent IntMap (Maybe SuperOwl)
attachmentChanges
  cslmap_fromLayersHide :: IntMap (Maybe SuperOwl)
cslmap_fromLayersHide = GoatCmdTempOutput -> IntMap (Maybe SuperOwl)
_goatCmdTempOutput_changesFromToggleHide GoatCmdTempOutput
goatCmdTempOutput
  cslmap_forRendering :: IntMap (Maybe SuperOwl)
cslmap_forRendering = IntMap (Maybe SuperOwl)
cslmap_fromLayersHide forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` IntMap (Maybe SuperOwl)
cslmap_withAttachments

  -- | clear the cache at places that have changed
  renderCache_resetOnChangesAndAttachments :: RenderCache
renderCache_resetOnChangesAndAttachments = RenderCache -> [Int] -> RenderCache
renderCache_clearAtKeys (GoatState -> RenderCache
_goatState_renderCache GoatState
goatState) (forall a. IntMap a -> [Int]
IM.keys IntMap (Maybe SuperOwl)
cslmap_withAttachments)

  -- | update the BroadPhase
  (NeedsUpdateSet
needsupdateaabbs, BroadPhaseState
next_broadPhaseState) = forall a.
HasOwlTree a =>
a
-> IntMap (Maybe SuperOwl)
-> BPTree
-> (NeedsUpdateSet, BroadPhaseState)
update_bPTree (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pFState_afterEvent) IntMap (Maybe SuperOwl)
cslmap_forRendering (BroadPhaseState -> BPTree
_broadPhaseState_bPTree (GoatState -> BroadPhaseState
_goatState_broadPhaseState GoatState
goatState))

  -- | update the rendered region if we moved the screen |
  canvasRegionBox :: LBox
canvasRegionBox = XY -> XY -> LBox
LBox (-XY
next_pan) (GoatCmdTempOutput -> XY
goatCmdTempOutput_screenRegion GoatCmdTempOutput
goatCmdTempOutput)
  newBox :: LBox
newBox = LBox
canvasRegionBox
  didScreenRegionMove :: Bool
didScreenRegionMove = RenderedCanvasRegion -> LBox
_renderedCanvasRegion_box (GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas GoatState
goatState) forall a. Eq a => a -> a -> Bool
/= LBox
newBox
  rendercontext_forMove :: RenderContext
rendercontext_forMove = RenderContext {
      _renderContext_cache :: RenderCache
_renderContext_cache = RenderCache
renderCache_resetOnChangesAndAttachments
      , _renderContext_owlTree :: OwlTree
_renderContext_owlTree = OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pFState_afterEvent
      , _renderContext_layerMetaMap :: LayerMetaMap
_renderContext_layerMetaMap = LayersState -> LayerMetaMap
_layersState_meta LayersState
next_layersState
      , _renderContext_broadPhase :: BroadPhaseState
_renderContext_broadPhase = BroadPhaseState
next_broadPhaseState
      , _renderContext_renderedCanvasRegion :: RenderedCanvasRegion
_renderContext_renderedCanvasRegion = GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas GoatState
goatState
    }
  rendercontext_forUpdate :: RenderContext
rendercontext_forUpdate = if Bool
didScreenRegionMove
    then LBox -> RenderContext -> RenderContext
moveRenderedCanvasRegion LBox
newBox RenderContext
rendercontext_forMove
    else RenderContext
rendercontext_forMove

  -- | render the scene if there were changes, note that updates from actual changes are mutually exclusive from updates due to panning (although I think it would still work even if it weren't) |
  rendercontext_afterUpdate :: RenderContext
rendercontext_afterUpdate = if forall a. IntMap a -> Bool
IM.null IntMap (Maybe SuperOwl)
cslmap_forRendering
    then RenderContext
rendercontext_forUpdate
    else IntMap (Maybe SuperOwl)
-> NeedsUpdateSet -> RenderContext -> RenderContext
updateCanvas IntMap (Maybe SuperOwl)
cslmap_forRendering NeedsUpdateSet
needsupdateaabbs RenderContext
rendercontext_forUpdate

  next_renderedCanvas :: RenderedCanvasRegion
next_renderedCanvas = RenderContext -> RenderedCanvasRegion
_renderContext_renderedCanvasRegion RenderContext
rendercontext_afterUpdate

  -- | render the selection |
  rendercontext_forSelection :: RenderContext
rendercontext_forSelection = RenderContext
rendercontext_afterUpdate {
      -- NOTE this will render hidden stuff that's selected via layers!!
      _renderContext_layerMetaMap :: LayerMetaMap
_renderContext_layerMetaMap = forall a. IntMap a
IM.empty

      -- TODO DELETE THIS YOU SHOULDN'T HAVE TO DO THIS, this is breaking caching (you can fix by commenting it out)
      -- IDK WHY BUT IF YOU SELECT AUTOLINE WITH BOX AND MOVE BOTH THE CACHE STAYS WITH ORIGINAL PLACE AND SELECTED LINE DOESN'T MOVE
      -- so temp fix it by reseting the cache on attached lines whos target moved
      , _renderContext_cache :: RenderCache
_renderContext_cache = RenderCache
renderCache_resetOnChangesAndAttachments

      -- empty canvas to render our selection in
      -- we just re-render everything for now (in the future you can try and do partial rendering though)
      , _renderContext_renderedCanvasRegion :: RenderedCanvasRegion
_renderContext_renderedCanvasRegion = LBox -> RenderedCanvasRegion
emptyRenderedCanvasRegion LBox
newBox
    }
  selectionselts :: [Int]
selectionselts = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Int
_superOwl_id forall a b. (a -> b) -> a -> b
$ Selection -> Seq SuperOwl
unSuperOwlParliament Selection
next_selection

  (RenderedCanvasRegion
next_renderedSelection, RenderCache
next_renderCache) = if GoatState -> Selection
_goatState_selection GoatState
goatState forall a. Eq a => a -> a -> Bool
== Selection
next_selection Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
didScreenRegionMove Bool -> Bool -> Bool
&& forall a. IntMap a -> Bool
IM.null IntMap (Maybe SuperOwl)
cslmap_forRendering
    -- nothing changed, we can keep our selection rendering
    then (GoatState -> RenderedCanvasRegion
_goatState_renderedSelection GoatState
goatState, RenderContext -> RenderCache
_renderContext_cache RenderContext
rendercontext_afterUpdate)
    else (RenderContext -> RenderedCanvasRegion
_renderContext_renderedCanvasRegion RenderContext
rctx, RenderContext -> RenderCache
_renderContext_cache RenderContext
rctx) where
      rctx :: RenderContext
rctx = LBox -> [Int] -> RenderContext -> RenderContext
render_new LBox
newBox [Int]
selectionselts RenderContext
rendercontext_forSelection

  -- TODO just DELETE this...
  {- TODO render only parts of selection that have changed TODO broken
  next_renderedSelection' = if didScreenRegionMove
    then moveRenderedCanvasRegion next_broadPhaseState (owlTree_withCacheResetOnAttachments) newBox _goatState_renderedSelection
    else _goatState_renderedSelection
  prevSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Nothing)) $ unSuperOwlParliament _goatState_selection
  curSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Just sowl)) $ unSuperOwlParliament next_selection
  -- TODO you can be even smarter about this by combining cslmap_forRendering I think
  cslmapForSelectionRendering = curSelChangeMap `IM.union` prevSelChangeMap
  -- you need to do something like this but this is wrong....
  --(needsupdateaabbsforrenderselection, _) = update_bPTree cslmapForSelectionRendering (_broadPhaseState_bPTree next_broadPhaseState)
  needsupdateaabbsforrenderselection = needsupdateaabbs
  next_renderedSelection = if IM.null cslmapForSelectionRendering
    then next_renderedSelection'
    else updateCanvas cslmapForSelectionRendering needsupdateaabbsforrenderselection next_broadPhaseState pFState_withCacheResetOnAttachments next_renderedSelection'
  -}

  next_pFState :: OwlPFState
next_pFState = OwlPFState
pFState_afterEvent { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = RenderContext -> OwlTree
_renderContext_owlTree RenderContext
rendercontext_forSelection }
  next_workspace :: OwlPFWorkspace
next_workspace = OwlPFWorkspace
workspace_afterEvent { _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState = OwlPFState
next_pFState}

  checkAttachmentMap :: Bool
checkAttachmentMap = OwlTree -> AttachmentMap
owlTree_makeAttachmentMap (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
next_pFState) forall a. Eq a => a -> a -> Bool
== AttachmentMap
next_attachmentMap

  -- TODO remove assert in production builds
  finalGoatState :: GoatState
finalGoatState = if Bool -> Bool
not Bool
checkAttachmentMap
    then forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ (forall b a. (Show a, IsString b) => a -> b
show (OwlTree -> AttachmentMap
owlTree_makeAttachmentMap (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
next_pFState))) forall a. Semigroup a => a -> a -> a
<> Text
"\n\n\n" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show AttachmentMap
next_attachmentMap
    else
      (GoatCmdTempOutput -> GoatState
_goatCmdTempOutput_goatState GoatCmdTempOutput
goatCmdTempOutput) {
        _goatState_workspace :: OwlPFWorkspace
_goatState_workspace      = OwlPFWorkspace
next_workspace
        , _goatState_pan :: XY
_goatState_pan             = XY
next_pan
        , _goatState_layersHandler :: SomePotatoHandler
_goatState_layersHandler  = SomePotatoHandler
next_layersHandler
        , _goatState_handler :: SomePotatoHandler
_goatState_handler         = SomePotatoHandler
next_handler
        , _goatState_selection :: Selection
_goatState_selection       = Selection
next_selection
        , _goatState_canvasSelection :: CanvasSelection
_goatState_canvasSelection = CanvasSelection
next_canvasSelection
        , _goatState_broadPhaseState :: BroadPhaseState
_goatState_broadPhaseState = BroadPhaseState
next_broadPhaseState
        , _goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_renderedCanvas = RenderedCanvasRegion
next_renderedCanvas
        , _goatState_renderedSelection :: RenderedCanvasRegion
_goatState_renderedSelection = RenderedCanvasRegion
next_renderedSelection
        , _goatState_layersState :: LayersState
_goatState_layersState     = LayersState
next_layersState
        , _goatState_attachmentMap :: AttachmentMap
_goatState_attachmentMap = AttachmentMap
next_attachmentMap
        , _goatState_renderCache :: RenderCache
_goatState_renderCache = RenderCache
next_renderCache
      }