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

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

  -- endo style
  , endoGoatCmdSetDefaultParams
  , endoGoatCmdMarkSaved
  , endoGoatCmdSetTool 
  , endoGoatCmdSetDebugLabel
  , endoGoatCmdSetCanvasRegionDim
  , endoGoatCmdWSEvent
  , endoGoatCmdNewFolder 
  , endoGoatCmdLoad
  , endoGoatCmdSetFocusedArea
  , endoGoatCmdMouse
  , endoGoatCmdKeyboard

  -- 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.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.Methods.SEltMethods
import           Potato.Flow.Serialization.Snake
import           Potato.Flow.Types
import  Potato.Flow.Preview 
import Potato.Flow.Methods.LlamaWorks

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 = (Maybe a -> a) -> Seq (Maybe a) -> Seq a
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Seq (Maybe a) -> Seq a)
-> (Seq (Maybe a) -> Seq (Maybe a)) -> Seq (Maybe a) -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> Seq (Maybe a) -> Seq (Maybe a)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter Maybe a -> Bool
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
(GoatFocusedArea -> GoatFocusedArea -> Bool)
-> (GoatFocusedArea -> GoatFocusedArea -> Bool)
-> Eq GoatFocusedArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GoatFocusedArea -> GoatFocusedArea -> Bool
== :: GoatFocusedArea -> GoatFocusedArea -> Bool
$c/= :: GoatFocusedArea -> GoatFocusedArea -> Bool
/= :: GoatFocusedArea -> GoatFocusedArea -> Bool
Eq, Int -> GoatFocusedArea -> ShowS
[GoatFocusedArea] -> ShowS
GoatFocusedArea -> String
(Int -> GoatFocusedArea -> ShowS)
-> (GoatFocusedArea -> String)
-> ([GoatFocusedArea] -> ShowS)
-> Show GoatFocusedArea
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GoatFocusedArea -> ShowS
showsPrec :: Int -> GoatFocusedArea -> ShowS
$cshow :: GoatFocusedArea -> String
show :: GoatFocusedArea -> String
$cshowList :: [GoatFocusedArea] -> ShowS
showList :: [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

    -- TODO you broke this with endo refactor
    -- TODO this isn't even used right now... DELETE ME
    , 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

  } deriving (Int -> GoatState -> ShowS
[GoatState] -> ShowS
GoatState -> String
(Int -> GoatState -> ShowS)
-> (GoatState -> String)
-> ([GoatState] -> ShowS)
-> Show GoatState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GoatState -> ShowS
showsPrec :: Int -> GoatState -> ShowS
$cshow :: GoatState -> String
show :: GoatState -> String
$cshowList :: [GoatState] -> ShowS
showList :: [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 = (Int -> (OwlItemMeta, OwlItem) -> Maybe SuperOwl)
-> IntMap (OwlItemMeta, OwlItem) -> IntMap (Maybe SuperOwl)
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
rid (OwlItemMeta
oem, OwlItem
oe) -> SuperOwl -> Maybe SuperOwl
forall a. a -> Maybe a
Just (SuperOwl -> Maybe SuperOwl) -> SuperOwl -> Maybe SuperOwl
forall a b. (a -> b) -> a -> b
$ Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
rid OwlItemMeta
oem OwlItem
oe) (IntMap (OwlItemMeta, OwlItem) -> IntMap (Maybe SuperOwl))
-> (OwlPFState -> IntMap (OwlItemMeta, OwlItem))
-> OwlPFState
-> IntMap (Maybe SuperOwl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping (OwlTree -> IntMap (OwlItemMeta, OwlItem))
-> (OwlPFState -> OwlTree)
-> OwlPFState
-> IntMap (OwlItemMeta, OwlItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> IntMap (Maybe SuperOwl))
-> OwlPFState -> IntMap (Maybe SuperOwl)
forall a b. (a -> b) -> a -> b
$ OwlPFState
initialstate
    (NeedsUpdateSet
_, BroadPhaseState
initialbp) = OwlPFState
-> IntMap (Maybe SuperOwl)
-> BPTree
-> (NeedsUpdateSet, BroadPhaseState)
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 (SCanvas -> LBox) -> (OwlPFState -> SCanvas) -> OwlPFState -> LBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> SCanvas
_owlPFState_canvas (OwlPFState -> LBox) -> OwlPFState -> LBox
forall a b. (a -> b) -> a -> b
$ OwlPFState
initialowlpfstate
    initialselts :: [OwlSubItem]
initialselts = ((OwlItemMeta, OwlItem) -> OwlSubItem)
-> [(OwlItemMeta, OwlItem)] -> [OwlSubItem]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(OwlItemMeta
_, OwlItem
oelt) -> OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
oelt) ([(OwlItemMeta, OwlItem)] -> [OwlSubItem])
-> (OwlPFState -> [(OwlItemMeta, OwlItem)])
-> OwlPFState
-> [OwlSubItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (OwlItemMeta, OwlItem) -> [(OwlItemMeta, OwlItem)]
forall a. IntMap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (IntMap (OwlItemMeta, OwlItem) -> [(OwlItemMeta, OwlItem)])
-> (OwlPFState -> IntMap (OwlItemMeta, OwlItem))
-> OwlPFState
-> [(OwlItemMeta, OwlItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping (OwlTree -> IntMap (OwlItemMeta, OwlItem))
-> (OwlPFState -> OwlTree)
-> OwlPFState
-> IntMap (OwlItemMeta, OwlItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> [OwlSubItem]) -> OwlPFState -> [OwlSubItem]
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 = OwlPFState -> 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
      , _renderContext_cache :: RenderCache
_renderContext_cache = RenderCache
emptyRenderCache
    }
    initialrc :: RenderedCanvasRegion
initialrc = RenderContext -> RenderedCanvasRegion
_renderContext_renderedCanvasRegion (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      = (OwlPFWorkspace, IntMap (Maybe SuperOwl)) -> OwlPFWorkspace
forall a b. (a, b) -> a
fst ((OwlPFWorkspace, IntMap (Maybe SuperOwl)) -> OwlPFWorkspace)
-> (OwlPFWorkspace, IntMap (Maybe SuperOwl)) -> OwlPFWorkspace
forall a b. (a -> b) -> a -> b
$ OwlPFState
-> OwlPFWorkspace -> (OwlPFWorkspace, IntMap (Maybe SuperOwl))
loadOwlPFStateIntoWorkspace (OwlPFState
initialstate) OwlPFWorkspace
emptyWorkspace
        , _goatState_pan :: XY
_goatState_pan             = ControllerMeta -> XY
_controllerMeta_pan ControllerMeta
controllermeta
        , _goatState_mouseDrag :: MouseDrag
_goatState_mouseDrag       = MouseDrag
forall a. Default a => a
def
        , _goatState_handler :: SomePotatoHandler
_goatState_handler         = EmptyHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler EmptyHandler
EmptyHandler
        , _goatState_layersHandler :: SomePotatoHandler
_goatState_layersHandler   = LayersHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (LayersHandler
forall a. Default a => a
def :: LayersHandler)
        , _goatState_configuration :: PotatoConfiguration
_goatState_configuration = PotatoConfiguration
forall a. Default a => a
def
        , _goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_potatoDefaultParameters = 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       = Selection
forall a. IsParliament a => a
isParliament_empty
        , _goatState_canvasSelection :: CanvasSelection
_goatState_canvasSelection = Seq SuperOwl -> CanvasSelection
CanvasSelection Seq SuperOwl
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 = Maybe SEltTree
forall a. Maybe a
Nothing
        , _goatState_focusedArea :: GoatFocusedArea
_goatState_focusedArea = GoatFocusedArea
GoatFocusedArea_None
        , _goatState_unbrokenInput :: Text
_goatState_unbrokenInput = Text
""
        , _goatState_screenRegion :: XY
_goatState_screenRegion = Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
screenx Int
screeny XY -> XY -> XY
forall a. Num a => a -> a -> a
- (ControllerMeta -> XY
_controllerMeta_pan ControllerMeta
controllermeta)
      }


goatState_pFState :: GoatState -> OwlPFState
goatState_pFState :: GoatState -> OwlPFState
goatState_pFState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState (OwlPFWorkspace -> OwlPFState)
-> (GoatState -> OwlPFWorkspace) -> GoatState -> 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 (OwlPFState -> OwlTree)
-> (GoatState -> OwlPFState) -> GoatState -> 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 (LlamaStack -> Bool)
-> (GoatState -> LlamaStack) -> GoatState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack (OwlPFWorkspace -> LlamaStack)
-> (GoatState -> OwlPFWorkspace) -> GoatState -> 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 = Tool -> Maybe Tool -> Tool
forall a. a -> Maybe a -> a
fromMaybe Tool
Tool_Select (Maybe Tool -> Tool)
-> (GoatState -> Maybe Tool) -> GoatState -> Tool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomePotatoHandler -> Maybe Tool
forall h. PotatoHandler h => h -> Maybe Tool
pHandlerTool (SomePotatoHandler -> Maybe Tool)
-> (GoatState -> SomePotatoHandler) -> GoatState -> Maybe Tool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> SomePotatoHandler
_goatState_handler

goatState_hasLocalPreview :: GoatState -> Bool
goatState_hasLocalPreview :: GoatState -> Bool
goatState_hasLocalPreview = OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview (OwlPFWorkspace -> Bool)
-> (GoatState -> OwlPFWorkspace) -> GoatState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFWorkspace
_goatState_workspace


makeHandlerFromNewTool :: GoatState -> Tool -> SomePotatoHandler
makeHandlerFromNewTool :: GoatState -> Tool -> SomePotatoHandler
makeHandlerFromNewTool GoatState{Maybe SEltTree
AttachmentMap
Text
PotatoConfiguration
XY
CanvasSelection
Selection
RenderCache
MouseDrag
OwlPFWorkspace
PotatoDefaultParameters
LayersState
BroadPhaseState
RenderedCanvasRegion
SomePotatoHandler
GoatFocusedArea
_goatState_workspace :: GoatState -> OwlPFWorkspace
_goatState_pan :: GoatState -> XY
_goatState_selection :: GoatState -> Selection
_goatState_canvasSelection :: GoatState -> CanvasSelection
_goatState_broadPhaseState :: GoatState -> BroadPhaseState
_goatState_layersState :: GoatState -> LayersState
_goatState_renderedCanvas :: GoatState -> RenderedCanvasRegion
_goatState_renderedSelection :: GoatState -> RenderedCanvasRegion
_goatState_handler :: GoatState -> SomePotatoHandler
_goatState_layersHandler :: GoatState -> SomePotatoHandler
_goatState_attachmentMap :: GoatState -> AttachmentMap
_goatState_renderCache :: GoatState -> RenderCache
_goatState_configuration :: GoatState -> PotatoConfiguration
_goatState_potatoDefaultParameters :: GoatState -> PotatoDefaultParameters
_goatState_mouseDrag :: GoatState -> MouseDrag
_goatState_screenRegion :: GoatState -> XY
_goatState_clipboard :: GoatState -> Maybe SEltTree
_goatState_focusedArea :: GoatState -> GoatFocusedArea
_goatState_unbrokenInput :: GoatState -> Text
_goatState_debugLabel :: GoatState -> Text
_goatState_workspace :: OwlPFWorkspace
_goatState_pan :: XY
_goatState_selection :: Selection
_goatState_canvasSelection :: CanvasSelection
_goatState_broadPhaseState :: BroadPhaseState
_goatState_layersState :: LayersState
_goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_renderedSelection :: RenderedCanvasRegion
_goatState_handler :: SomePotatoHandler
_goatState_layersHandler :: SomePotatoHandler
_goatState_attachmentMap :: AttachmentMap
_goatState_renderCache :: RenderCache
_goatState_configuration :: PotatoConfiguration
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_mouseDrag :: MouseDrag
_goatState_screenRegion :: XY
_goatState_clipboard :: Maybe SEltTree
_goatState_focusedArea :: GoatFocusedArea
_goatState_unbrokenInput :: Text
_goatState_debugLabel :: Text
..} = \case
  Tool
Tool_Box    -> BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler -> SomePotatoHandler)
-> BoxHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ BoxHandler
forall a. Default a => a
def { _boxHandler_creation = BoxCreationType_Box }
  Tool
Tool_Line   -> AutoLineHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (AutoLineHandler -> SomePotatoHandler)
-> AutoLineHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ AutoLineHandler
forall a. Default a => a
def { _autoLineHandler_isCreation = True }
  Tool
Tool_Select -> CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
_goatState_canvasSelection
  Tool
Tool_Text   -> BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler -> SomePotatoHandler)
-> BoxHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ BoxHandler
forall a. Default a => a
def { _boxHandler_creation = BoxCreationType_Text }
  Tool
Tool_TextArea -> BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler -> SomePotatoHandler)
-> BoxHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ BoxHandler
forall a. Default a => a
def { _boxHandler_creation = BoxCreationType_TextArea }
  Tool
Tool_Pan           -> PanHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (PanHandler -> SomePotatoHandler)
-> PanHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ (PanHandler
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         -> BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler -> SomePotatoHandler)
-> BoxHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ (BoxHandler
forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTBoxText     -> BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler -> SomePotatoHandler)
-> BoxHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ (BoxHandler
forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTLine        -> AutoLineHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (AutoLineHandler -> SomePotatoHandler)
-> AutoLineHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ (AutoLineHandler
forall a. Default a => a
def :: AutoLineHandler)
  SelectionManipulatorType
SMTTextArea    -> BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler -> SomePotatoHandler)
-> BoxHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ (BoxHandler
forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTBoundingBox -> BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler -> SomePotatoHandler)
-> BoxHandler -> SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ (BoxHandler
forall a. Default a => a
def :: BoxHandler)
  SelectionManipulatorType
SMTNone        -> EmptyHandler -> SomePotatoHandler
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
  -- TODO instead, just check if there is a preview operation or not
  SomePotatoHandler h
h -> if HandlerActiveState -> Bool
handlerActiveState_isActive (HandlerActiveState -> Bool) -> HandlerActiveState -> Bool
forall a b. (a -> b) -> a -> b
$ h -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive h
h
    then SomePotatoHandler
sph
    else CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
selection

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

-- TODO move to Potato.Flow.Methods.LlamaWorks
deleteSelectionEvent :: GoatState -> Maybe WSEvent
deleteSelectionEvent :: GoatState -> Maybe WSEvent
deleteSelectionEvent gs :: GoatState
gs@GoatState {Maybe SEltTree
AttachmentMap
Text
PotatoConfiguration
XY
CanvasSelection
Selection
RenderCache
MouseDrag
OwlPFWorkspace
PotatoDefaultParameters
LayersState
BroadPhaseState
RenderedCanvasRegion
SomePotatoHandler
GoatFocusedArea
_goatState_workspace :: GoatState -> OwlPFWorkspace
_goatState_pan :: GoatState -> XY
_goatState_selection :: GoatState -> Selection
_goatState_canvasSelection :: GoatState -> CanvasSelection
_goatState_broadPhaseState :: GoatState -> BroadPhaseState
_goatState_layersState :: GoatState -> LayersState
_goatState_renderedCanvas :: GoatState -> RenderedCanvasRegion
_goatState_renderedSelection :: GoatState -> RenderedCanvasRegion
_goatState_handler :: GoatState -> SomePotatoHandler
_goatState_layersHandler :: GoatState -> SomePotatoHandler
_goatState_attachmentMap :: GoatState -> AttachmentMap
_goatState_renderCache :: GoatState -> RenderCache
_goatState_configuration :: GoatState -> PotatoConfiguration
_goatState_potatoDefaultParameters :: GoatState -> PotatoDefaultParameters
_goatState_mouseDrag :: GoatState -> MouseDrag
_goatState_screenRegion :: GoatState -> XY
_goatState_clipboard :: GoatState -> Maybe SEltTree
_goatState_focusedArea :: GoatState -> GoatFocusedArea
_goatState_unbrokenInput :: GoatState -> Text
_goatState_debugLabel :: GoatState -> Text
_goatState_workspace :: OwlPFWorkspace
_goatState_pan :: XY
_goatState_selection :: Selection
_goatState_canvasSelection :: CanvasSelection
_goatState_broadPhaseState :: BroadPhaseState
_goatState_layersState :: LayersState
_goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_renderedSelection :: RenderedCanvasRegion
_goatState_handler :: SomePotatoHandler
_goatState_layersHandler :: SomePotatoHandler
_goatState_attachmentMap :: AttachmentMap
_goatState_renderCache :: RenderCache
_goatState_configuration :: PotatoConfiguration
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_mouseDrag :: MouseDrag
_goatState_screenRegion :: XY
_goatState_clipboard :: Maybe SEltTree
_goatState_focusedArea :: GoatFocusedArea
_goatState_unbrokenInput :: Text
_goatState_debugLabel :: Text
..} = if Selection -> Bool
forall a. IsParliament a => a -> Bool
isParliament_null Selection
_goatState_selection
  then Maybe WSEvent
forall a. Maybe a
Nothing
  else WSEvent -> Maybe WSEvent
forall a. a -> Maybe a
Just (WSEvent -> Maybe WSEvent) -> WSEvent -> Maybe WSEvent
forall a b. (a -> b) -> a -> b
$ Shepard -> Shift -> Preview -> WSEvent
WSEApplyPreview Shepard
dummyShepard Shift
dummyShift (Preview -> WSEvent) -> Preview -> WSEvent
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview PreviewOperation
PO_StartAndCommit (Llama -> Preview) -> Llama -> Preview
forall a b. (a -> b) -> a -> b
$ OwlPFState -> AttachmentMap -> OwlParliament -> Llama
removeEltAndUpdateAttachments_to_llama (GoatState -> OwlPFState
goatState_pFState GoatState
gs) AttachmentMap
_goatState_attachmentMap (Selection -> OwlParliament
superOwlParliament_toOwlParliament Selection
_goatState_selection)

potatoHandlerInputFromGoatState :: GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState :: GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState {Maybe SEltTree
AttachmentMap
Text
PotatoConfiguration
XY
CanvasSelection
Selection
RenderCache
MouseDrag
OwlPFWorkspace
PotatoDefaultParameters
LayersState
BroadPhaseState
RenderedCanvasRegion
SomePotatoHandler
GoatFocusedArea
_goatState_workspace :: GoatState -> OwlPFWorkspace
_goatState_pan :: GoatState -> XY
_goatState_selection :: GoatState -> Selection
_goatState_canvasSelection :: GoatState -> CanvasSelection
_goatState_broadPhaseState :: GoatState -> BroadPhaseState
_goatState_layersState :: GoatState -> LayersState
_goatState_renderedCanvas :: GoatState -> RenderedCanvasRegion
_goatState_renderedSelection :: GoatState -> RenderedCanvasRegion
_goatState_handler :: GoatState -> SomePotatoHandler
_goatState_layersHandler :: GoatState -> SomePotatoHandler
_goatState_attachmentMap :: GoatState -> AttachmentMap
_goatState_renderCache :: GoatState -> RenderCache
_goatState_configuration :: GoatState -> PotatoConfiguration
_goatState_potatoDefaultParameters :: GoatState -> PotatoDefaultParameters
_goatState_mouseDrag :: GoatState -> MouseDrag
_goatState_screenRegion :: GoatState -> XY
_goatState_clipboard :: GoatState -> Maybe SEltTree
_goatState_focusedArea :: GoatState -> GoatFocusedArea
_goatState_unbrokenInput :: GoatState -> Text
_goatState_debugLabel :: GoatState -> Text
_goatState_workspace :: OwlPFWorkspace
_goatState_pan :: XY
_goatState_selection :: Selection
_goatState_canvasSelection :: CanvasSelection
_goatState_broadPhaseState :: BroadPhaseState
_goatState_layersState :: LayersState
_goatState_renderedCanvas :: RenderedCanvasRegion
_goatState_renderedSelection :: RenderedCanvasRegion
_goatState_handler :: SomePotatoHandler
_goatState_layersHandler :: SomePotatoHandler
_goatState_attachmentMap :: AttachmentMap
_goatState_renderCache :: RenderCache
_goatState_configuration :: PotatoConfiguration
_goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_mouseDrag :: MouseDrag
_goatState_screenRegion :: XY
_goatState_clipboard :: Maybe SEltTree
_goatState_focusedArea :: GoatFocusedArea
_goatState_unbrokenInput :: Text
_goatState_debugLabel :: Text
..} = 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_allowGraphemeClusters :: Bool
_potatoConfiguration_allowOrReplaceUnicodeWideChars :: Maybe (Maybe Char)
_potatoConfiguration_unicodeWideCharFn :: Char -> Int8
_potatoConfiguration_allowGraphemeClusters :: PotatoConfiguration -> Bool
_potatoConfiguration_allowOrReplaceUnicodeWideChars :: PotatoConfiguration -> Maybe (Maybe Char)
_potatoConfiguration_unicodeWideCharFn :: PotatoConfiguration -> Char -> Int8
..} 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 Maybe KeyboardData
forall a. Maybe a
Nothing
      else case Maybe (Maybe Char)
_potatoConfiguration_allowOrReplaceUnicodeWideChars of
        Maybe (Maybe Char)
Nothing -> KeyboardData -> Maybe KeyboardData
forall a. a -> Maybe a
Just KeyboardData
k
        Just Maybe Char
x -> if Char -> Int8
getCharWidth Char
c Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
> Int8
1
          then Maybe KeyboardData
-> (Char -> Maybe KeyboardData) -> Maybe Char -> Maybe KeyboardData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe KeyboardData
forall a. Maybe a
Nothing (\Char
nc -> KeyboardData -> Maybe KeyboardData
forall a. a -> Maybe a
Just (KeyboardKey -> [KeyModifier] -> KeyboardData
KeyboardData (Char -> KeyboardKey
KeyboardKey_Char Char
nc) [KeyModifier]
mods))  Maybe Char
x
          else KeyboardData -> Maybe KeyboardData
forall a. a -> Maybe a
Just KeyboardData
k
  KeyboardData
_ -> KeyboardData -> Maybe KeyboardData
forall a. a -> Maybe a
Just KeyboardData
k






endoGoatCmdSetDefaultParams :: SetPotatoDefaultParameters -> GoatState -> GoatState
endoGoatCmdSetDefaultParams :: SetPotatoDefaultParameters -> GoatState -> GoatState
endoGoatCmdSetDefaultParams SetPotatoDefaultParameters
spdp GoatState
gs = GoatState
gs {
    _goatState_potatoDefaultParameters = potatoDefaultParameters_set (_goatState_potatoDefaultParameters gs) spdp
  }

endoGoatCmdMarkSaved :: () -> GoatState -> GoatState
endoGoatCmdMarkSaved :: () -> GoatState -> GoatState
endoGoatCmdMarkSaved ()
_ GoatState
gs = GoatState
gs {
    _goatState_workspace = markWorkspaceSaved (_goatState_workspace gs)
  }

-- TODO do I need to do anything else after setting handler??
endoGoatCmdSetTool :: Tool -> GoatState -> GoatState
endoGoatCmdSetTool :: Tool -> GoatState -> GoatState
endoGoatCmdSetTool Tool
tool GoatState
gs = GoatState
gs {
    _goatState_handler = makeHandlerFromNewTool gs tool
  }

endoGoatCmdSetDebugLabel :: Text -> GoatState -> GoatState
endoGoatCmdSetDebugLabel :: Text -> GoatState -> GoatState
endoGoatCmdSetDebugLabel Text
x GoatState
gs = GoatState
gs {
    _goatState_debugLabel = x
  }

endoGoatCmdSetCanvasRegionDim :: V2 Int -> GoatState -> GoatState
endoGoatCmdSetCanvasRegionDim :: XY -> GoatState -> GoatState
endoGoatCmdSetCanvasRegionDim XY
x GoatState
gs = GoatState
r where
  -- set the screen region
  -- rerender
  gs_1 :: GoatState
gs_1 = GoatState
gs {
      _goatState_screenRegion = x
    }
  r :: GoatState
r = GoatState -> GoatState
goat_rerenderAfterMove GoatState
gs_1
  



endoGoatCmdWSEvent :: WSEvent -> GoatState -> GoatState
endoGoatCmdWSEvent :: WSEvent -> GoatState -> GoatState
endoGoatCmdWSEvent WSEvent
wsev GoatState
gs = WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh WSEvent
wsev GoatState
gs

endoGoatCmdNewFolder :: Text -> GoatState -> GoatState
endoGoatCmdNewFolder :: Text -> GoatState -> GoatState
endoGoatCmdNewFolder Text
x GoatState
gs = WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh WSEvent
newFolderEv GoatState
gs where
  pfs :: OwlPFState
pfs = GoatState -> OwlPFState
goatState_pFState GoatState
gs
  folderPos :: OwlSpot
folderPos = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) (GoatState -> Selection
_goatState_selection GoatState
gs)
  newFolderEv :: WSEvent
newFolderEv = Shepard -> Shift -> Preview -> WSEvent
WSEApplyPreview Shepard
dummyShepard Shift
dummyShift (Preview -> WSEvent) -> Preview -> WSEvent
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview PreviewOperation
PO_StartAndCommit (Llama -> Preview) -> Llama -> Preview
forall a b. (a -> b) -> a -> b
$ OwlPFState -> (OwlSpot, Text) -> Llama
makeAddFolderLlama OwlPFState
pfs (OwlSpot
folderPos, Text
x)

endoGoatCmdLoad :: (SPotatoFlow, ControllerMeta) -> GoatState -> GoatState
endoGoatCmdLoad :: (SPotatoFlow, ControllerMeta) -> GoatState -> GoatState
endoGoatCmdLoad (SPotatoFlow
spf, ControllerMeta
cm) GoatState
gs = GoatState
r where
  gs' :: GoatState
gs' = WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh (SPotatoFlow -> WSEvent
WSELoad SPotatoFlow
spf) GoatState
gs
  r :: GoatState
r = GoatState
gs' {
      _goatState_pan = _controllerMeta_pan cm
      , _goatState_layersState = makeLayersStateFromOwlPFState (goatState_pFState gs') (_controllerMeta_layers cm)
      -- NOTE _goatState_layersHandler gets set by goat_applyWSEvent during refresh
    }

goat_setFocusedArea :: GoatFocusedArea -> GoatState -> GoatState
goat_setFocusedArea :: GoatFocusedArea -> GoatState -> GoatState
goat_setFocusedArea GoatFocusedArea
gfa GoatState
goatState = GoatState
r where
  didchange :: Bool
didchange = GoatFocusedArea
gfa GoatFocusedArea -> GoatFocusedArea -> Bool
forall a. Eq a => a -> a -> Bool
/= GoatState -> GoatFocusedArea
_goatState_focusedArea GoatState
goatState
  goatstatewithnewfocus :: GoatState
goatstatewithnewfocus = GoatState
goatState { _goatState_focusedArea = gfa }
  noactionneeded :: GoatState
noactionneeded = GoatState
goatstatewithnewfocus
  potatoHandlerInput :: PotatoHandlerInput
potatoHandlerInput = GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
goatState
  r :: GoatState
r = if Bool
didchange Bool -> Bool -> Bool
&& SomePotatoHandler -> Text
forall h. PotatoHandler h => h -> Text
pHandlerName (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
handlerName_layersRename
    -- special case to force confirmation on layersRename handler which is special because it does not generate a Preview
    then let
        goatState_afterAction :: GoatState
goatState_afterAction = case SomePotatoHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
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 -> GoatState
noactionneeded
          Just PotatoHandlerOutput
pho -> String -> GoatState -> GoatState
forall a b. Show a => a -> b -> b
traceShow String
"press enter" (GoatState -> GoatState) -> GoatState -> GoatState
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput -> GoatState -> GoatState
goat_processLayersHandlerOutput PotatoHandlerOutput
pho GoatState
goatstatewithnewfocus
      in Bool -> GoatState -> GoatState
forall a. HasCallStack => Bool -> a -> a
assert (GoatState -> GoatFocusedArea
_goatState_focusedArea GoatState
goatState GoatFocusedArea -> GoatFocusedArea -> Bool
forall a. Eq a => a -> a -> Bool
== GoatFocusedArea
GoatFocusedArea_Layers) (GoatState -> GoatState) -> GoatState -> GoatState
forall a b. (a -> b) -> a -> b
$ GoatState
goatState_afterAction
    else GoatState
noactionneeded


endoGoatCmdSetFocusedArea :: GoatFocusedArea -> GoatState -> GoatState
endoGoatCmdSetFocusedArea :: GoatFocusedArea -> GoatState -> GoatState
endoGoatCmdSetFocusedArea = GoatFocusedArea -> GoatState -> GoatState
goat_setFocusedArea


endoGoatCmdMouse :: LMouseData -> GoatState -> GoatState
endoGoatCmdMouse :: LMouseData -> GoatState -> GoatState
endoGoatCmdMouse LMouseData
mouseData GoatState
goatState = GoatState
r where
  sameSource :: Bool
sameSource = MouseDrag -> Bool
_mouseDrag_isLayerMouse (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState) Bool -> Bool -> Bool
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) MouseDragState -> MouseDragState -> Bool
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_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_withFocusedArea :: GoatState
goatState_withFocusedArea = GoatFocusedArea -> GoatState -> GoatState
goat_setFocusedArea (if Bool
isLayerMouse then GoatFocusedArea
GoatFocusedArea_Layers else GoatFocusedArea
GoatFocusedArea_Canvas) GoatState
goatState
  goatState_withNewMouse :: GoatState
goatState_withNewMouse = GoatState
goatState_withFocusedArea {
      _goatState_mouseDrag = mouseDrag
    }
  noChangeOutput :: GoatState
noChangeOutput = GoatState
goatState_withNewMouse
  -- TODO maybe split this case out to endoGoatCmdLayerMouse
  isLayerMouse :: Bool
isLayerMouse = MouseDrag -> Bool
_mouseDrag_isLayerMouse MouseDrag
mouseDrag

  potatoHandlerInput :: PotatoHandlerInput
potatoHandlerInput = GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
goatState_withNewMouse
  last_pFState :: OwlPFState
last_pFState = GoatState -> OwlPFState
goatState_pFState GoatState
goatState_withNewMouse
  handler :: SomePotatoHandler
handler = GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState_withNewMouse


  r :: GoatState
r = case MouseDrag -> MouseDragState
_mouseDrag_state MouseDrag
mouseDrag of

    -- TODO soft failure
    MouseDragState
_ | Bool
mouseSourceFailure -> Text -> GoatState
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"invalid mouse sequence due to source"

    -- TODO assert false here? I'm pretty sure this should never happen
    -- if mouse was cancelled, update _goatState_mouseDrag accordingly
    MouseDragState
MouseDragState_Cancelled -> if LMouseData -> Bool
_lMouseData_isRelease LMouseData
mouseData
      then GoatState
goatState_withNewMouse { _goatState_mouseDrag = def }
      else GoatState
noChangeOutput -- still cancelled

    -- if mouse is intended for layers
    MouseDragState
_ | Bool
isLayerMouse -> case SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
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 -> PotatoHandlerOutput -> GoatState -> GoatState
goat_processLayersHandlerOutput PotatoHandlerOutput
pho GoatState
goatState_withNewMouse
      Maybe PotatoHandlerOutput
Nothing  -> GoatState
noChangeOutput

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

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

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

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




endoGoatCmdKeyboard :: KeyboardData -> GoatState -> GoatState
endoGoatCmdKeyboard :: KeyboardData -> GoatState -> GoatState
endoGoatCmdKeyboard KeyboardData
kbd' GoatState
goatState = GoatState
r where
  -- TODO you need to do reset logic for this (basically, reset it anytime there was a non-keyboard event)
  last_unbrokenInput :: Text
last_unbrokenInput = GoatState -> Text
_goatState_unbrokenInput GoatState
goatState
  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 = next_unbrokenInput}
  potatoHandlerInput :: PotatoHandlerInput
potatoHandlerInput = GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
goatState_withKeyboard
  last_pFState :: OwlPFState
last_pFState = GoatState -> OwlPFState
goatState_pFState GoatState
goatState_withKeyboard
  -- TODO rename to canvasHandler
  handler :: SomePotatoHandler
handler = GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState_withKeyboard

  r :: GoatState
r = case Maybe KeyboardData
mkbd of
    Maybe KeyboardData
Nothing -> 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) -> GoatState
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 = 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_None

        }

      -- TODO use _goatState_focusedArea instead
      r :: GoatState
r = if MouseDrag -> Bool
_mouseDrag_isLayerMouse (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard)
        then case SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
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 -> PotatoHandlerOutput -> GoatState -> GoatState
goat_processLayersHandlerOutput PotatoHandlerOutput
pho GoatState
goatState_withNewMouse
          -- TODO I think this is fine, but maybe you should you clear the handler instead?
          Maybe PotatoHandlerOutput
Nothing  -> GoatState
goatState_withNewMouse
        else case SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse SomePotatoHandler
handler PotatoHandlerInput
potatoHandlerInput (OwlPFState -> XY -> MouseDrag -> RelMouseDrag
toRelMouseDrag OwlPFState
last_pFState (GoatState -> XY
_goatState_pan GoatState
goatState_withKeyboard) MouseDrag
canceledMouse) of
          Just PotatoHandlerOutput
pho -> PotatoHandlerOutput -> GoatState -> GoatState
goat_processCanvasHandlerOutput PotatoHandlerOutput
pho GoatState
goatState_withNewMouse
          -- TODO I think this is fine, but maybe you should you clear the handler instead?
          Maybe PotatoHandlerOutput
Nothing  -> 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
goatState_withKeyboard

    Just KeyboardData
kbd ->
      let
        maybeHandleLayers :: Maybe GoatState
maybeHandleLayers = do
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ MouseDrag -> Bool
_mouseDrag_isLayerMouse (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard)
          PotatoHandlerOutput
pho <- SomePotatoHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState_withKeyboard) PotatoHandlerInput
potatoHandlerInput KeyboardData
kbd
          return $ PotatoHandlerOutput -> GoatState -> GoatState
goat_processLayersHandlerOutput PotatoHandlerOutput
pho GoatState
goatState_withKeyboard
      in case Maybe GoatState
maybeHandleLayers of
        Just GoatState
x -> GoatState
x
        Maybe GoatState
Nothing -> case SomePotatoHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard SomePotatoHandler
handler PotatoHandlerInput
potatoHandlerInput KeyboardData
kbd of
          Just PotatoHandlerOutput
pho -> PotatoHandlerOutput -> GoatState -> GoatState
goat_processCanvasHandlerOutput PotatoHandlerOutput
pho GoatState
goatState_withKeyboard
          -- 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]
_ -> case MouseDrag -> MouseDragState
_mouseDrag_state (GoatState -> MouseDrag
_goatState_mouseDrag GoatState
goatState_withKeyboard) of
                    MouseDragState
x | MouseDragState
x MouseDragState -> MouseDragState -> Bool
forall a. Eq a => a -> a -> Bool
== MouseDragState
MouseDragState_Up Bool -> Bool -> Bool
|| MouseDragState
x MouseDragState -> MouseDragState -> Bool
forall a. Eq a => a -> a -> Bool
== MouseDragState
MouseDragState_Cancelled -> Bool -> Selection -> GoatState -> GoatState
goat_setSelection Bool
False Selection
forall a. IsParliament a => a
isParliament_empty GoatState
goatState_withKeyboard
                    MouseDragState
_                        -> GoatState
goatState_withKeyboard

            KeyboardData KeyboardKey
k [] | KeyboardKey
k KeyboardKey -> KeyboardKey -> Bool
forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Delete Bool -> Bool -> Bool
|| KeyboardKey
k KeyboardKey -> KeyboardKey -> Bool
forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Backspace -> case GoatState -> Maybe WSEvent
deleteSelectionEvent GoatState
goatState_withKeyboard of
              Maybe WSEvent
Nothing -> GoatState
goatState_withKeyboard
              Just WSEvent
wsev -> WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh WSEvent
wsev GoatState
goatState_withKeyboard
            KeyboardData (KeyboardKey_Char Char
'c') [KeyModifier
KeyModifier_Ctrl] -> GoatState
r where
              copied :: Maybe SEltTree
copied = GoatState -> Maybe SEltTree
makeClipboard GoatState
goatState_withKeyboard
              r :: GoatState
r = GoatState
goatState_withKeyboard { _goatState_clipboard = copied }
            KeyboardData (KeyboardKey_Char Char
'x') [KeyModifier
KeyModifier_Ctrl] -> GoatState
r where
              copied :: Maybe SEltTree
copied = GoatState -> Maybe SEltTree
makeClipboard GoatState
goatState_withKeyboard
              goatState_withClipboard :: GoatState
goatState_withClipboard = GoatState
goatState_withKeyboard { _goatState_clipboard = copied }
              r :: GoatState
r = case GoatState -> Maybe WSEvent
deleteSelectionEvent GoatState
goatState_withKeyboard of
                Maybe WSEvent
Nothing -> GoatState
goatState_withClipboard
                Just WSEvent
wsev -> WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh WSEvent
wsev GoatState
goatState_withClipboard
            KeyboardData (KeyboardKey_Char Char
'v') [KeyModifier
KeyModifier_Ctrl] -> case GoatState -> Maybe SEltTree
_goatState_clipboard GoatState
goatState_withKeyboard of
              Maybe SEltTree
Nothing    -> GoatState
goatState_withKeyboard
              Just SEltTree
stree -> GoatState
r where
                offsetstree :: SEltTree
offsetstree = XY -> SEltTree -> SEltTree
offsetSEltTree (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1) SEltTree
stree
                minitree' :: OwlTree
minitree' = SEltTree -> OwlTree
owlTree_fromSEltTree SEltTree
offsetstree
                -- reindex the tree so there are no collisions with the current state
                maxid1 :: Int
maxid1 = OwlTree -> Int
owlTree_maxId OwlTree
minitree' Int -> Int -> Int
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 (Int -> Int -> Int
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 = Shepard -> Shift -> Preview -> WSEvent
WSEApplyPreview Shepard
dummyShepard Shift
dummyShift (Preview -> WSEvent) -> Preview -> WSEvent
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview PreviewOperation
PO_StartAndCommit (Llama -> Preview) -> Llama -> Preview
forall a b. (a -> b) -> a -> b
$ OwlPFCmd -> Llama
makePFCLlama (OwlPFCmd -> Llama) -> OwlPFCmd -> Llama
forall a b. (a -> b) -> a -> b
$ (OwlTree, OwlSpot) -> OwlPFCmd
OwlPFCNewTree (OwlTree
minitree, OwlSpot
spot)
                r :: GoatState
r = WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh WSEvent
treePastaEv (GoatState
goatState_withKeyboard { _goatState_clipboard = Just offsetstree })
            KeyboardData (KeyboardKey_Char Char
'z') [KeyModifier
KeyModifier_Ctrl] -> GoatState
r where
              r :: GoatState
r = WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh WSEvent
WSEUndo GoatState
goatState_withKeyboard
            KeyboardData (KeyboardKey_Char Char
'y') [KeyModifier
KeyModifier_Ctrl] -> GoatState
r where
              r :: GoatState
r = WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_Refresh WSEvent
WSERedo GoatState
goatState_withKeyboard
            -- tool hotkeys
            KeyboardData (KeyboardKey_Char Char
key) [KeyModifier]
_ -> GoatState
r where
              mtool :: Maybe Tool
mtool = case Char
key of
                Char
'v' -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Select
                Char
'p' -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Pan
                Char
'b' -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Box
                Char
'l' -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Line
                Char
'n' -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_TextArea
                Char
_   -> Maybe Tool
forall a. Maybe a
Nothing
              newHandler :: SomePotatoHandler
newHandler = SomePotatoHandler
-> (Tool -> SomePotatoHandler) -> Maybe Tool -> SomePotatoHandler
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
              -- TODO should I call a goat_setHandler function instead?
              r :: GoatState
r = GoatState
goatState_withKeyboard { _goatState_handler = newHandler }
            KeyboardData
_ -> GoatState
goatState_withKeyboard


goat_renderCanvas_move :: RenderContext -> XY -> XY -> (RenderContext, Bool)
goat_renderCanvas_move :: RenderContext -> XY -> XY -> (RenderContext, Bool)
goat_renderCanvas_move rc :: RenderContext
rc@RenderContext {LayerMetaMap
OwlTree
RenderCache
BroadPhaseState
RenderedCanvasRegion
_renderContext_owlTree :: RenderContext -> OwlTree
_renderContext_layerMetaMap :: RenderContext -> LayerMetaMap
_renderContext_broadPhase :: RenderContext -> BroadPhaseState
_renderContext_renderedCanvasRegion :: RenderContext -> RenderedCanvasRegion
_renderContext_cache :: RenderContext -> RenderCache
_renderContext_cache :: RenderCache
_renderContext_owlTree :: OwlTree
_renderContext_layerMetaMap :: LayerMetaMap
_renderContext_broadPhase :: BroadPhaseState
_renderContext_renderedCanvasRegion :: RenderedCanvasRegion
..} XY
pan XY
sr = (RenderContext, Bool)
r where
  newBox :: LBox
newBox = XY -> XY -> LBox
LBox (-XY
pan) XY
sr
  didScreenRegionMove :: Bool
didScreenRegionMove = RenderedCanvasRegion -> LBox
_renderedCanvasRegion_box RenderedCanvasRegion
_renderContext_renderedCanvasRegion LBox -> LBox -> Bool
forall a. Eq a => a -> a -> Bool
/= LBox
newBox
  r :: (RenderContext, Bool)
r = if Bool
didScreenRegionMove
    then (LBox -> RenderContext -> RenderContext
moveRenderedCanvasRegion LBox
newBox RenderContext
rc, Bool
True)
    else (RenderContext
rc, Bool
False)


goat_renderCanvas_update :: (HasCallStack) => RenderContext -> NeedsUpdateSet -> SuperOwlChanges -> RenderContext
goat_renderCanvas_update :: HasCallStack =>
RenderContext
-> NeedsUpdateSet -> IntMap (Maybe SuperOwl) -> RenderContext
goat_renderCanvas_update RenderContext
rc NeedsUpdateSet
needsupdateaabbs IntMap (Maybe SuperOwl)
cslmap = RenderContext
r where
  r :: RenderContext
r = if IntMap (Maybe SuperOwl) -> Bool
forall a. IntMap a -> Bool
IM.null IntMap (Maybe SuperOwl)
cslmap
    then RenderContext
rc
    else IntMap (Maybe SuperOwl)
-> NeedsUpdateSet -> RenderContext -> RenderContext
updateCanvas IntMap (Maybe SuperOwl)
cslmap NeedsUpdateSet
needsupdateaabbs RenderContext
rc


-- USAGE this function is a little sneaky, we pass in the canvas RenderContext and alter it to use it for selection rendering
-- So you want to pull out the _renderContext_renderedCanvasRegion but throw away the rest of the render context from the output
-- I guess you also want to pull out _renderContext_cache?
-- In the future, selection rendering will have its own context and you won't want to do this I guess?
goat_renderCanvas_selection :: RenderContext -> SuperOwlParliament -> RenderContext
goat_renderCanvas_selection :: RenderContext -> Selection -> RenderContext
goat_renderCanvas_selection RenderContext
rc_from_canvas Selection
next_selection = RenderContext
r where
  newBox :: LBox
newBox = RenderedCanvasRegion -> LBox
_renderedCanvasRegion_box (RenderedCanvasRegion -> LBox) -> RenderedCanvasRegion -> LBox
forall a b. (a -> b) -> a -> b
$ RenderContext -> RenderedCanvasRegion
_renderContext_renderedCanvasRegion RenderContext
rc_from_canvas
  rendercontext_forSelection :: RenderContext
rendercontext_forSelection = RenderContext
rc_from_canvas {
      -- NOTE this will render hidden stuff that's selected via layers!!
      _renderContext_layerMetaMap = IM.empty
      -- 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 = emptyRenderedCanvasRegion newBox
    }
  selectionselts :: [Int]
selectionselts = Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Int -> [Int])
-> (Seq SuperOwl -> Seq Int) -> Seq SuperOwl -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Int) -> Seq SuperOwl -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Int
_superOwl_id (Seq SuperOwl -> [Int]) -> Seq SuperOwl -> [Int]
forall a b. (a -> b) -> a -> b
$ Selection -> Seq SuperOwl
unSuperOwlParliament Selection
next_selection
  r :: RenderContext
r = 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'
  -}

renderContextFromGoatState :: GoatState -> RenderContext
renderContextFromGoatState :: GoatState -> RenderContext
renderContextFromGoatState GoatState
goatState = RenderContext {
    _renderContext_cache :: RenderCache
_renderContext_cache = GoatState -> RenderCache
_goatState_renderCache GoatState
goatState
    , _renderContext_owlTree :: OwlTree
_renderContext_owlTree = OwlPFState -> OwlTree
_owlPFState_owlTree (GoatState -> OwlPFState
goatState_pFState GoatState
goatState)
    , _renderContext_layerMetaMap :: LayerMetaMap
_renderContext_layerMetaMap = LayersState -> LayerMetaMap
_layersState_meta (GoatState -> LayersState
_goatState_layersState GoatState
goatState)
    , _renderContext_broadPhase :: BroadPhaseState
_renderContext_broadPhase = GoatState -> BroadPhaseState
_goatState_broadPhaseState GoatState
goatState
    , _renderContext_renderedCanvasRegion :: RenderedCanvasRegion
_renderContext_renderedCanvasRegion = GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas GoatState
goatState
  }

goat_addPan :: XY -> GoatState -> GoatState
goat_addPan :: XY -> GoatState -> GoatState
goat_addPan (V2 Int
dx Int
dy) GoatState
goatState = GoatState
r where
  -- set the pan
  -- render move
  -- render selection
  V2 Int
cx0 Int
cy0 = GoatState -> XY
_goatState_pan GoatState
goatState
  next_pan :: XY
next_pan = Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
cx0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dx) (Int
cy0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) 

  gs_1 :: GoatState
gs_1 = GoatState
goatState {
      _goatState_pan = next_pan
    }
  
  r :: GoatState
r = GoatState -> GoatState
goat_rerenderAfterMove GoatState
gs_1

goat_rerenderAfterMove :: GoatState -> GoatState
goat_rerenderAfterMove :: GoatState -> GoatState
goat_rerenderAfterMove GoatState
goatState = GoatState
r where
  -- render move
  -- render selection
  rc :: RenderContext
rc = GoatState -> RenderContext
renderContextFromGoatState GoatState
goatState
  (RenderContext
rc_aftermove, Bool
_) = RenderContext -> XY -> XY -> (RenderContext, Bool)
goat_renderCanvas_move RenderContext
rc (GoatState -> XY
_goatState_pan GoatState
goatState) (GoatState -> XY
_goatState_screenRegion GoatState
goatState)
  rc_afterselection :: RenderContext
rc_afterselection = RenderContext -> Selection -> RenderContext
goat_renderCanvas_selection RenderContext
rc_aftermove (GoatState -> Selection
_goatState_selection GoatState
goatState)
  r :: GoatState
r = GoatState
goatState {
      _goatState_renderedCanvas = _renderContext_renderedCanvasRegion rc_aftermove
      , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterselection
    }

computeCanvasSelection :: (HasCallStack) => GoatState -> CanvasSelection
computeCanvasSelection :: HasCallStack => GoatState -> CanvasSelection
computeCanvasSelection GoatState
goatState = CanvasSelection
r where
  pfs :: OwlPFState
pfs = GoatState -> OwlPFState
goatState_pFState GoatState
goatState
  filterHiddenOrLocked :: SuperOwl -> Bool
filterHiddenOrLocked SuperOwl
sowl = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ OwlTree -> Int -> LayerMetaMap -> Bool
layerMetaMap_isInheritHiddenOrLocked (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) (LayersState -> LayerMetaMap
_layersState_meta (GoatState -> LayersState
_goatState_layersState GoatState
goatState))
  r :: CanvasSelection
r = OwlTree -> (SuperOwl -> Bool) -> Selection -> CanvasSelection
superOwlParliament_convertToCanvasSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) SuperOwl -> Bool
filterHiddenOrLocked (GoatState -> Selection
_goatState_selection GoatState
goatState)


goat_autoExpandFoldersOfSelection :: GoatState -> GoatState
goat_autoExpandFoldersOfSelection :: GoatState -> GoatState
goat_autoExpandFoldersOfSelection GoatState
goatState = GoatState
r where
  -- 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 (that's not true, you can still collapse it but it will rexpand the moment you make any changes, which might be kind of buggy)
  -- 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 (GoatState -> Selection
_goatState_selection GoatState
goatState) (GoatState -> OwlPFState
goatState_pFState GoatState
goatState) (GoatState -> LayersState
_goatState_layersState GoatState
goatState)
  r :: GoatState
r = GoatState
goatState { _goatState_layersState = next_layersState }


goat_setSelection :: Bool -> SuperOwlParliament -> GoatState -> GoatState
goat_setSelection :: Bool -> Selection -> GoatState -> GoatState
goat_setSelection Bool
add Selection
selection GoatState
goatState = GoatState
r where

  -- set the new selection
  ot :: OwlTree
ot = OwlPFState -> OwlTree
forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree (OwlPFState -> OwlTree)
-> (GoatState -> OwlPFState) -> GoatState -> OwlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFState
goatState_pFState (GoatState -> OwlTree) -> GoatState -> OwlTree
forall a b. (a -> b) -> a -> b
$ GoatState
goatState
  next_selection :: Selection
next_selection = Seq SuperOwl -> Selection
SuperOwlParliament (Seq SuperOwl -> Selection)
-> (Selection -> Seq SuperOwl) -> Selection -> Selection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> SuperOwl -> Ordering) -> Seq SuperOwl -> Seq SuperOwl
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
ot) (Seq SuperOwl -> Seq SuperOwl)
-> (Selection -> Seq SuperOwl) -> Selection -> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Seq SuperOwl
unSuperOwlParliament (Selection -> Selection) -> Selection -> Selection
forall a b. (a -> b) -> a -> b
$ if Bool
add
    then OwlTree -> Selection -> Selection -> Selection
superOwlParliament_disjointUnionAndCorrect OwlTree
ot (GoatState -> Selection
_goatState_selection GoatState
goatState) Selection
selection
    else Selection
selection
  goatState_afterSelection :: GoatState
goatState_afterSelection = GoatState -> GoatState
goat_autoExpandFoldersOfSelection GoatState
goatState { _goatState_selection = next_selection }

  -- set the new canvas selection
  -- create new handler as appropriate
  -- rerender selection
  next_canvasSelection :: CanvasSelection
next_canvasSelection = HasCallStack => GoatState -> CanvasSelection
GoatState -> CanvasSelection
computeCanvasSelection GoatState
goatState_afterSelection
  next_handler :: SomePotatoHandler
next_handler = SomePotatoHandler -> CanvasSelection -> SomePotatoHandler
maybeUpdateHandlerFromSelection (GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState_afterSelection) CanvasSelection
next_canvasSelection
  -- MAYBE TODO consider rendering selected hidden/locked stuff too (it's still possible to select them via layers)? 
  -- Except we removed it from the BroadPhase already. And it would be weird because you bulk selected you would edit only the non-hidden/locked stuff
  rc_afterselection :: RenderContext
rc_afterselection = RenderContext -> Selection -> RenderContext
goat_renderCanvas_selection (GoatState -> RenderContext
renderContextFromGoatState GoatState
goatState_afterSelection) (Seq SuperOwl -> Selection
SuperOwlParliament (Seq SuperOwl -> Selection) -> Seq SuperOwl -> Selection
forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
next_canvasSelection)
  r :: GoatState
r = GoatState
goatState_afterSelection {
      _goatState_handler = next_handler
      , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterselection
      , _goatState_canvasSelection = next_canvasSelection
    }



goat_setLayersStateWithChangesFromToggleHide :: LayersState -> SuperOwlChanges -> GoatState -> GoatState
goat_setLayersStateWithChangesFromToggleHide :: LayersState -> IntMap (Maybe SuperOwl) -> GoatState -> GoatState
goat_setLayersStateWithChangesFromToggleHide LayersState
ls IntMap (Maybe SuperOwl)
changes GoatState
goatState = GoatState
r where
  
  -- set the layers state
  goatState_afterLayers :: GoatState
goatState_afterLayers = GoatState
goatState {
      _goatState_layersState = ls
    }

  -- set the canvas selection and handler
  next_canvasSelection :: CanvasSelection
next_canvasSelection = HasCallStack => GoatState -> CanvasSelection
GoatState -> CanvasSelection
computeCanvasSelection (GoatState -> CanvasSelection) -> GoatState -> CanvasSelection
forall a b. (a -> b) -> a -> b
$ GoatState
goatState_afterLayers
  goatState_afterSelection :: GoatState
goatState_afterSelection = GoatState
goatState_afterLayers {
      _goatState_canvasSelection = next_canvasSelection  
      , _goatState_handler = assert (not . handlerActiveState_isActive $ pIsHandlerActive (_goatState_handler goatState_afterLayers)) makeHandlerFromSelection next_canvasSelection
    }

  -- set the broadphase
  (NeedsUpdateSet
needsupdateaabbs, BroadPhaseState
next_broadPhaseState) = OwlPFState
-> IntMap (Maybe SuperOwl)
-> BPTree
-> (NeedsUpdateSet, BroadPhaseState)
forall a.
HasOwlTree a =>
a
-> IntMap (Maybe SuperOwl)
-> BPTree
-> (NeedsUpdateSet, BroadPhaseState)
update_bPTree (GoatState -> OwlPFState
goatState_pFState GoatState
goatState_afterSelection) IntMap (Maybe SuperOwl)
changes (BroadPhaseState -> BPTree
_broadPhaseState_bPTree (GoatState -> BroadPhaseState
_goatState_broadPhaseState GoatState
goatState_afterSelection))
  goatState_afterUpdateBroadPhase :: GoatState
goatState_afterUpdateBroadPhase = GoatState
goatState_afterSelection { _goatState_broadPhaseState = next_broadPhaseState }

  -- render changes
  -- render selection
  rc :: RenderContext
rc = GoatState -> RenderContext
renderContextFromGoatState GoatState
goatState_afterUpdateBroadPhase
  rc_afterupdate :: RenderContext
rc_afterupdate = HasCallStack =>
RenderContext
-> NeedsUpdateSet -> IntMap (Maybe SuperOwl) -> RenderContext
RenderContext
-> NeedsUpdateSet -> IntMap (Maybe SuperOwl) -> RenderContext
goat_renderCanvas_update RenderContext
rc NeedsUpdateSet
needsupdateaabbs IntMap (Maybe SuperOwl)
changes
  rc_afterselection :: RenderContext
rc_afterselection = RenderContext -> Selection -> RenderContext
goat_renderCanvas_selection RenderContext
rc_afterupdate ( Seq SuperOwl -> Selection
SuperOwlParliament (Seq SuperOwl -> Selection)
-> (CanvasSelection -> Seq SuperOwl)
-> CanvasSelection
-> Selection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanvasSelection -> Seq SuperOwl
unCanvasSelection (CanvasSelection -> Selection) -> CanvasSelection -> Selection
forall a b. (a -> b) -> a -> b
$ CanvasSelection
next_canvasSelection)
  r :: GoatState
r = GoatState
goatState_afterUpdateBroadPhase {
      -- MAYBE TODO refresh the layers handler (), this might be relevant if we support shared lock/hide state of layers in the future
      --, _goatState_layersHandler = fromMaybe (SomePotatoHandler (def :: LayersHandler)) ....
      _goatState_renderedCanvas = _renderContext_renderedCanvasRegion rc_afterupdate
      , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterselection
    }


goat_processHandlerOutput_noSetHandler :: PotatoHandlerOutput -> GoatState -> GoatState
goat_processHandlerOutput_noSetHandler :: PotatoHandlerOutput -> GoatState -> GoatState
goat_processHandlerOutput_noSetHandler PotatoHandlerOutput
pho GoatState
goatState = GoatState
r where

  r :: GoatState
r = case PotatoHandlerOutput -> HandlerOutputAction
_potatoHandlerOutput_action PotatoHandlerOutput
pho of
    HOA_Select Bool
x Selection
y -> Bool -> Selection -> GoatState -> GoatState
goat_setSelection Bool
x Selection
y GoatState
goatState
    HOA_Pan XY
x -> XY -> GoatState -> GoatState
goat_addPan XY
x GoatState
goatState
    HOA_Layers LayersState
x IntMap (Maybe SuperOwl)
y -> LayersState -> IntMap (Maybe SuperOwl) -> GoatState -> GoatState
goat_setLayersStateWithChangesFromToggleHide LayersState
x IntMap (Maybe SuperOwl)
y GoatState
goatState
    HOA_Preview Preview
p -> WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
WSEventType_Local_NoRefresh (Shepard -> Shift -> Preview -> WSEvent
WSEApplyPreview Shepard
dummyShepard Shift
dummyShift Preview
p) GoatState
goatState
    HandlerOutputAction
HOA_Nothing -> GoatState
goatState


goat_processLayersHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState
goat_processLayersHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState
goat_processLayersHandlerOutput PotatoHandlerOutput
pho GoatState
goatState = PotatoHandlerOutput -> GoatState -> GoatState
goat_processHandlerOutput_noSetHandler PotatoHandlerOutput
pho (GoatState -> GoatState) -> GoatState -> GoatState
forall a b. (a -> b) -> a -> b
$ GoatState
goatState { _goatState_layersHandler = fromMaybe (_goatState_layersHandler goatState) (_potatoHandlerOutput_nextHandler pho) }

goat_processCanvasHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState
goat_processCanvasHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState
goat_processCanvasHandlerOutput PotatoHandlerOutput
pho GoatState
goatState = GoatState
r where
  canvasSelection :: CanvasSelection
canvasSelection = HasCallStack => GoatState -> CanvasSelection
GoatState -> CanvasSelection
computeCanvasSelection GoatState
goatState

  next_handler :: SomePotatoHandler
next_handler = case PotatoHandlerOutput -> Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler PotatoHandlerOutput
pho of
    Maybe SomePotatoHandler
Nothing -> CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
canvasSelection
    Just SomePotatoHandler
x -> SomePotatoHandler
x
  goatState' :: GoatState
goatState' = GoatState
goatState { 
      _goatState_handler = next_handler 
    }
  r :: GoatState
r = PotatoHandlerOutput -> GoatState -> GoatState
goat_processHandlerOutput_noSetHandler PotatoHandlerOutput
pho (GoatState -> GoatState) -> GoatState -> GoatState
forall a b. (a -> b) -> a -> b
$ GoatState
goatState'


data WSEventType = WSEventType_Local_NoRefresh | WSEventType_Local_Refresh | WSEventType_Remote_Refresh deriving (WSEventType -> WSEventType -> Bool
(WSEventType -> WSEventType -> Bool)
-> (WSEventType -> WSEventType -> Bool) -> Eq WSEventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WSEventType -> WSEventType -> Bool
== :: WSEventType -> WSEventType -> Bool
$c/= :: WSEventType -> WSEventType -> Bool
/= :: WSEventType -> WSEventType -> Bool
Eq, Int -> WSEventType -> ShowS
[WSEventType] -> ShowS
WSEventType -> String
(Int -> WSEventType -> ShowS)
-> (WSEventType -> String)
-> ([WSEventType] -> ShowS)
-> Show WSEventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WSEventType -> ShowS
showsPrec :: Int -> WSEventType -> ShowS
$cshow :: WSEventType -> String
show :: WSEventType -> String
$cshowList :: [WSEventType] -> ShowS
showList :: [WSEventType] -> ShowS
Show)

wSEventType_isRemote :: WSEventType -> Bool
wSEventType_isRemote :: WSEventType -> Bool
wSEventType_isRemote WSEventType
WSEventType_Remote_Refresh = Bool
True
wSEventType_isRemote WSEventType
_ = Bool
False

wSEventType_needsRefresh :: WSEventType -> Bool
wSEventType_needsRefresh :: WSEventType -> Bool
wSEventType_needsRefresh WSEventType
WSEventType_Local_Refresh = Bool
True
wSEventType_needsRefresh WSEventType
WSEventType_Remote_Refresh = Bool
True
wSEventType_needsRefresh WSEventType
_ = Bool
False

goat_applyWSEvent :: WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent :: WSEventType -> WSEvent -> GoatState -> GoatState
goat_applyWSEvent WSEventType
wsetype WSEvent
wse GoatState
goatState = GoatState
goatState_final where

  -- apply the event
  last_pFState :: OwlPFState
last_pFState = GoatState -> OwlPFState
goatState_pFState GoatState
goatState
  (OwlPFWorkspace
workspace_afterEvent, IntMap (Maybe SuperOwl)
cslmap_afterEvent) = WSEvent
-> OwlPFWorkspace -> (OwlPFWorkspace, IntMap (Maybe SuperOwl))
updateOwlPFWorkspace WSEvent
wse (GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState)
  goatState_afterEvent :: GoatState
goatState_afterEvent = GoatState
goatState { _goatState_workspace = workspace_afterEvent }
  pFState_afterEvent :: OwlPFState
pFState_afterEvent = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
workspace_afterEvent


  -- compute selection based on changes from updating OwlPFState (i.e. auto select newly created stuff if appropriate)
  (Bool
isNewSelection, Selection
next_selection) = if IntMap (Maybe SuperOwl) -> Bool
forall a. IntMap a -> Bool
IM.null IntMap (Maybe SuperOwl)
cslmap_afterEvent
    then (Bool
False, GoatState -> Selection
_goatState_selection GoatState
goatState_afterEvent)
    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 Int -> IntMap (OwlItemMeta, OwlItem) -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
rid (OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping (OwlTree -> IntMap (OwlItemMeta, OwlItem))
-> (OwlPFState -> OwlTree)
-> OwlPFState
-> IntMap (OwlItemMeta, OwlItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> IntMap (OwlItemMeta, OwlItem))
-> OwlPFState -> IntMap (OwlItemMeta, OwlItem)
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 = (Int -> Maybe SuperOwl -> [SuperOwl])
-> IntMap (Maybe SuperOwl) -> [SuperOwl]
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 (Seq SuperOwl -> Selection) -> Seq SuperOwl -> Selection
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> SuperOwl -> Ordering) -> Seq SuperOwl -> Seq SuperOwl
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition (OwlTree -> SuperOwl -> SuperOwl -> Ordering)
-> OwlTree -> SuperOwl -> SuperOwl -> Ordering
forall a b. (a -> b) -> a -> b
$ OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> OwlTree) -> OwlPFState -> OwlTree
forall a b. (a -> b) -> a -> b
$ OwlPFState
pFState_afterEvent) ([SuperOwl] -> Seq SuperOwl
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 WSEvent
wse of
        WSELoad SPotatoFlow
_ -> Bool
True
        WSEvent
_             -> Bool
False

      -- TODO add `|| wasRemoteChange` condition
      r :: (Bool, Selection)
r = if Bool
wasLoad Bool -> Bool -> Bool
|| [SuperOwl] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SuperOwl]
newlyCreatedSEltls Bool -> Bool -> Bool
|| WSEventType -> Bool
wSEventType_isRemote WSEventType
wsetype
        -- 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)) (Seq SuperOwl -> (Bool, Selection))
-> Seq SuperOwl -> (Bool, Selection)
forall a b. (a -> b) -> a -> b
$ Seq (Maybe SuperOwl) -> Seq SuperOwl
forall a. Seq (Maybe a) -> Seq a
catMaybesSeq (Seq (Maybe SuperOwl) -> Seq SuperOwl)
-> ((SuperOwl -> Maybe SuperOwl) -> Seq (Maybe SuperOwl))
-> (SuperOwl -> Maybe SuperOwl)
-> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SuperOwl -> Maybe SuperOwl)
 -> Seq SuperOwl -> Seq (Maybe SuperOwl))
-> Seq SuperOwl
-> (SuperOwl -> Maybe SuperOwl)
-> Seq (Maybe SuperOwl)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SuperOwl -> Maybe SuperOwl)
-> Seq SuperOwl -> Seq (Maybe SuperOwl)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Selection -> Seq SuperOwl
unSuperOwlParliament (GoatState -> Selection
_goatState_selection GoatState
goatState_afterEvent)) ((SuperOwl -> Maybe SuperOwl) -> Seq SuperOwl)
-> (SuperOwl -> Maybe SuperOwl) -> Seq SuperOwl
forall a b. (a -> b) -> a -> b
$ \SuperOwl
sowl ->
          case Int -> IntMap (Maybe SuperOwl) -> Maybe (Maybe SuperOwl)
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       -> SuperOwl -> Maybe SuperOwl
forall a. a -> Maybe a
Just SuperOwl
sowl
            -- if deleted, remove it
            Just Maybe SuperOwl
Nothing  -> Maybe SuperOwl
forall a. Maybe a
Nothing
            -- it was changed, update selection to newest version
            Just (Just SuperOwl
x) -> SuperOwl -> Maybe SuperOwl
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
  goatState_afterSelection :: GoatState
goatState_afterSelection = GoatState
goatState_afterEvent { _goatState_selection = next_selection }

  -- | refresh the handler if there was a non-canvas or non-local state change |
  goatState_afterRefreshHandler :: GoatState
goatState_afterRefreshHandler = if WSEventType -> Bool
wSEventType_needsRefresh WSEventType
wsetype
    then let
        layersHandler :: SomePotatoHandler
layersHandler = GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
goatState_afterSelection
        canvasHandler :: SomePotatoHandler
canvasHandler = GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState_afterSelection 
        -- TODO remove this assert, this will happen for stuff like boxtexthandler
        -- since we don't have multi-user events, the handler should never be active when this happens
        checkvalid :: GoatState -> GoatState
checkvalid = Bool -> GoatState -> GoatState
forall a. HasCallStack => Bool -> a -> a
assert (SomePotatoHandler -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive SomePotatoHandler
canvasHandler HandlerActiveState -> HandlerActiveState -> Bool
forall a. Eq a => a -> a -> Bool
/= HandlerActiveState
HAS_Active_Mouse Bool -> Bool -> Bool
&& SomePotatoHandler -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive SomePotatoHandler
layersHandler HandlerActiveState -> HandlerActiveState -> Bool
forall a. Eq a => a -> a -> Bool
/= HandlerActiveState
HAS_Active_Mouse)

        -- 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
goatState_afterSelection
        canvasSelection :: CanvasSelection
canvasSelection = HasCallStack => GoatState -> CanvasSelection
GoatState -> CanvasSelection
computeCanvasSelection GoatState
goatState_afterSelection
        refreshedCanvasHandler :: SomePotatoHandler
refreshedCanvasHandler = SomePotatoHandler -> Maybe SomePotatoHandler -> SomePotatoHandler
forall a. a -> Maybe a -> a
fromMaybe (CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
canvasSelection) ( SomePotatoHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler SomePotatoHandler
canvasHandler PotatoHandlerInput
next_potatoHandlerInput)
        refreshedLayersHandler :: SomePotatoHandler
refreshedLayersHandler = SomePotatoHandler -> Maybe SomePotatoHandler -> SomePotatoHandler
forall a. a -> Maybe a -> a
fromMaybe (LayersHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (LayersHandler
forall a. Default a => a
def :: LayersHandler)) (SomePotatoHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler SomePotatoHandler
layersHandler PotatoHandlerInput
next_potatoHandlerInput)

        -- TODO cancel the preview

        
      in GoatState -> GoatState
checkvalid GoatState
goatState_afterSelection {
          _goatState_handler = refreshedCanvasHandler
          , _goatState_layersHandler = refreshedLayersHandler
        }
    else GoatState
goatState_afterSelection

  -- | 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 (GoatState -> LayersState
_goatState_layersState GoatState
goatState_afterRefreshHandler)
  goatState_afterSetLayersState :: GoatState
goatState_afterSetLayersState = GoatState -> GoatState
goat_autoExpandFoldersOfSelection (GoatState -> GoatState) -> GoatState -> GoatState
forall a b. (a -> b) -> a -> b
$ GoatState
goatState_afterRefreshHandler { _goatState_layersState = next_layersState' }

  -- | set the new handler based on the new Selection and LayersState
  next_canvasSelection :: CanvasSelection
next_canvasSelection = HasCallStack => GoatState -> CanvasSelection
GoatState -> CanvasSelection
computeCanvasSelection GoatState
goatState_afterSetLayersState -- (TODO pretty sure this is the same as `canvasSelection = computeCanvasSelection goatState_afterSelection` above..)


  -- we check both the pIsHandlerActive and goatState_hasLocalPreview condition to see if we want to recreate the handler
  -- actually, we could only check pIsHandlerActive if all handlers properly reported their state

  -- TODO the issue with not (goatState_hasLocalPreview goatState_afterSetLayersState) is that we may actually want to regen the handler we just haven't commit its preview yet (i.e. box creation)
  -- NO that's not true because in those cases you can return an explicit commit action or you return HOA_Nothing which should also commit when the handler is replaced
  (SomePotatoHandler
next_handler, OwlPFWorkspace
next_workspace) = if (Bool -> Bool
not (Bool -> Bool)
-> (HandlerActiveState -> Bool) -> HandlerActiveState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerActiveState -> Bool
handlerActiveState_isActive) (SomePotatoHandler -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive (GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState_afterSetLayersState)) Bool -> Bool -> Bool
&& Bool -> Bool
not (GoatState -> Bool
goatState_hasLocalPreview GoatState
goatState_afterSetLayersState)
    -- if we replaced the handler, commit its local preview if there was one
    then (CanvasSelection -> SomePotatoHandler
makeHandlerFromSelection CanvasSelection
next_canvasSelection, OwlPFWorkspace -> OwlPFWorkspace
maybeCommitLocalPreviewToLlamaStackAndClear (OwlPFWorkspace -> OwlPFWorkspace)
-> OwlPFWorkspace -> OwlPFWorkspace
forall a b. (a -> b) -> a -> b
$ GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState_afterSetLayersState)
    else (GoatState -> SomePotatoHandler
_goatState_handler GoatState
goatState_afterSetLayersState, GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
goatState_afterSetLayersState)
  goatState_afterSetHandler :: GoatState
goatState_afterSetHandler = GoatState
goatState_afterSetLayersState {
      _goatState_handler = next_handler
      , _goatState_canvasSelection = next_canvasSelection
      , _goatState_workspace = next_workspace
    }

  -- | update AttachmentMap based on new state and clear the cache on these changes |
  (NeedsUpdateSet
needsupdateaabbs, GoatState
goatState_afterUpdateAttachmentsAndRenderState) = IntMap (Maybe SuperOwl) -> GoatState -> (NeedsUpdateSet, GoatState)
goat_updateAttachmentsAndRenderStateFromChanges IntMap (Maybe SuperOwl)
cslmap_afterEvent GoatState
goatState_afterSetHandler

  -- | render everything
  rc :: RenderContext
rc = GoatState -> RenderContext
renderContextFromGoatState GoatState
goatState_afterUpdateAttachmentsAndRenderState
  rc_afterRenderCanvas :: RenderContext
rc_afterRenderCanvas = HasCallStack =>
RenderContext
-> NeedsUpdateSet -> IntMap (Maybe SuperOwl) -> RenderContext
RenderContext
-> NeedsUpdateSet -> IntMap (Maybe SuperOwl) -> RenderContext
goat_renderCanvas_update RenderContext
rc NeedsUpdateSet
needsupdateaabbs IntMap (Maybe SuperOwl)
cslmap_afterEvent
  rc_afterRenderSelection :: RenderContext
rc_afterRenderSelection = RenderContext -> Selection -> RenderContext
goat_renderCanvas_selection RenderContext
rc (GoatState -> Selection
_goatState_selection GoatState
goatState_afterUpdateAttachmentsAndRenderState)

  -- | DONE
  goatState_final :: GoatState
goatState_final = GoatState
goatState_afterUpdateAttachmentsAndRenderState {
      _goatState_renderedCanvas = _renderContext_renderedCanvasRegion rc_afterRenderCanvas
      , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterRenderSelection
    }


-- this one also updates attachment map based on changes
goat_updateAttachmentsAndRenderStateFromChanges :: SuperOwlChanges -> GoatState -> ([AABB], GoatState)
goat_updateAttachmentsAndRenderStateFromChanges :: IntMap (Maybe SuperOwl) -> GoatState -> (NeedsUpdateSet, GoatState)
goat_updateAttachmentsAndRenderStateFromChanges IntMap (Maybe SuperOwl)
cslmap_afterEvent GoatState
goatState = (NeedsUpdateSet, GoatState)
r where

  pFState_afterEvent :: OwlPFState
pFState_afterEvent = GoatState -> OwlPFState
goatState_pFState GoatState
goatState

  -- | 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 = (IntSet -> IntSet -> IntSet)
-> AttachmentMap -> AttachmentMap -> AttachmentMap
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 = IntMap (Maybe SuperOwl)
-> IntMap (Maybe SuperOwl) -> IntMap (Maybe SuperOwl)
forall a. IntMap a -> IntMap a -> IntMap a
IM.union IntMap (Maybe SuperOwl)
cslmap_afterEvent IntMap (Maybe SuperOwl)
attachmentChanges

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

  -- | update the BroadPhase
  (NeedsUpdateSet
needsupdateaabbs, BroadPhaseState
next_broadPhaseState) = OwlTree
-> IntMap (Maybe SuperOwl)
-> BPTree
-> (NeedsUpdateSet, 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_withAttachments (BroadPhaseState -> BPTree
_broadPhaseState_bPTree (GoatState -> BroadPhaseState
_goatState_broadPhaseState GoatState
goatState))

  r :: (NeedsUpdateSet, GoatState)
r = (NeedsUpdateSet
needsupdateaabbs, GoatState
goatState {
      _goatState_attachmentMap = next_attachmentMap
      , _goatState_broadPhaseState = next_broadPhaseState
      , _goatState_renderCache = renderCache_resetOnChangesAndAttachments
    })