{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Flow.Reflex.GoatWidget (
GoatWidgetConfig(..)
, emptyGoatWidgetConfig
, GoatWidget(..)
, holdGoatWidget
) where
import Relude
import Reflex
import Potato.Flow.BroadPhase
import Potato.Flow.Controller.Goat
import Potato.Flow.Controller.Handler
import Potato.Flow.Controller.Input
import Potato.Flow.Controller.OwlLayers
import Potato.Flow.Controller.Types
import Potato.Flow.Llama
import Potato.Flow.Math
import Potato.Flow.OwlState
import Potato.Flow.OwlWorkspace
import Potato.Flow.Render
import Potato.Flow.Types
import Control.Monad.Fix
data GoatWidgetConfig t = GoatWidgetConfig {
forall t. GoatWidgetConfig t -> (OwlPFState, ControllerMeta)
_goatWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
, forall t. GoatWidgetConfig t -> Maybe UnicodeWidthFn
_goatWidgetConfig_unicodeWidthFn :: Maybe UnicodeWidthFn
, forall t. GoatWidgetConfig t -> Event t LMouseData
_goatWidgetConfig_mouse :: Event t LMouseData
, forall t. GoatWidgetConfig t -> Event t KeyboardData
_goatWidgetConfig_keyboard :: Event t KeyboardData
, forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_canvasRegionDim :: Event t XY
, forall t. GoatWidgetConfig t -> Event t Tool
_goatWidgetConfig_selectTool :: Event t Tool
, forall t. GoatWidgetConfig t -> Event t EverythingLoadState
_goatWidgetConfig_load :: Event t EverythingLoadState
, forall t. GoatWidgetConfig t -> Event t Llama
_goatWidgetConfig_paramsEvent :: Event t Llama
, forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_canvasSize :: Event t XY
, forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_newFolder :: Event t ()
, forall t. GoatWidgetConfig t -> Event t SetPotatoDefaultParameters
_goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters
, forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_markSaved :: Event t ()
, forall t. GoatWidgetConfig t -> Event t GoatFocusedArea
_goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea
, forall t. GoatWidgetConfig t -> Event t Text
_goatWidgetConfig_setDebugLabel :: Event t Text
, forall t. GoatWidgetConfig t -> Event t WSEvent
_goatWidgetConfig_bypassEvent :: Event t WSEvent
}
emptyGoatWidgetConfig :: (Reflex t) => GoatWidgetConfig t
emptyGoatWidgetConfig :: forall t. Reflex t => GoatWidgetConfig t
emptyGoatWidgetConfig = GoatWidgetConfig {
_goatWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_goatWidgetConfig_initialState = (OwlPFState
emptyOwlPFState, ControllerMeta
emptyControllerMeta)
, _goatWidgetConfig_selectTool :: Event t Tool
_goatWidgetConfig_selectTool = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_load :: Event t EverythingLoadState
_goatWidgetConfig_load = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_mouse :: Event t LMouseData
_goatWidgetConfig_mouse = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_keyboard :: Event t KeyboardData
_goatWidgetConfig_keyboard = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_paramsEvent :: Event t Llama
_goatWidgetConfig_paramsEvent = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_unicodeWidthFn :: Maybe UnicodeWidthFn
_goatWidgetConfig_unicodeWidthFn = forall a. Maybe a
Nothing
, _goatWidgetConfig_canvasRegionDim :: Event t XY
_goatWidgetConfig_canvasRegionDim = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_canvasSize :: Event t XY
_goatWidgetConfig_canvasSize = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_newFolder :: Event t ()
_goatWidgetConfig_newFolder = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters
_goatWidgetConfig_setPotatoDefaultParameters = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_markSaved :: Event t ()
_goatWidgetConfig_markSaved = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea
_goatWidgetConfig_setFocusedArea = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_setDebugLabel :: Event t Text
_goatWidgetConfig_setDebugLabel = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_bypassEvent :: Event t WSEvent
_goatWidgetConfig_bypassEvent = forall {k} (t :: k) a. Reflex t => Event t a
never
}
data GoatWidget t = GoatWidget {
forall t. GoatWidget t -> Dynamic t Tool
_goatWidget_tool :: Dynamic t Tool
, forall t. GoatWidget t -> Dynamic t Selection
_goatWidget_selection :: Dynamic t Selection
, forall t. GoatWidget t -> Dynamic t PotatoDefaultParameters
_goatWidget_potatoDefaultParameters :: Dynamic t PotatoDefaultParameters
, forall t. GoatWidget t -> Dynamic t LayersState
_goatWidget_layers :: Dynamic t LayersState
, forall t. GoatWidget t -> Dynamic t XY
_goatWidget_pan :: Dynamic t XY
, forall t. GoatWidget t -> Dynamic t BroadPhaseState
_goatWidget_broadPhase :: Dynamic t BroadPhaseState
, forall t. GoatWidget t -> Dynamic t HandlerRenderOutput
_goatWidget_handlerRenderOutput :: Dynamic t HandlerRenderOutput
, forall t. GoatWidget t -> Dynamic t LayersViewHandlerRenderOutput
_goatWidget_layersHandlerRenderOutput :: Dynamic t LayersViewHandlerRenderOutput
, forall t. GoatWidget t -> Dynamic t SCanvas
_goatWidget_canvas :: Dynamic t SCanvas
, forall t. GoatWidget t -> Dynamic t RenderedCanvasRegion
_goatWidget_renderedCanvas :: Dynamic t RenderedCanvasRegion
, forall t. GoatWidget t -> Dynamic t RenderedCanvasRegion
_goatWidget_renderedSelection :: Dynamic t RenderedCanvasRegion
, forall t. GoatWidget t -> Dynamic t Bool
_goatWidget_unsavedChanges :: Dynamic t Bool
, forall t. GoatWidget t -> Dynamic t GoatState
_goatWidget_DEBUG_goatState :: Dynamic t GoatState
}
holdGoatWidget :: forall t m. (Adjustable t m, MonadHold t m, MonadFix m)
=> GoatWidgetConfig t
-> m (GoatWidget t)
holdGoatWidget :: forall t (m :: * -> *).
(Adjustable t m, MonadHold t m, MonadFix m) =>
GoatWidgetConfig t -> m (GoatWidget t)
holdGoatWidget GoatWidgetConfig {Maybe UnicodeWidthFn
(OwlPFState, ControllerMeta)
Event t ()
Event t EverythingLoadState
Event t Text
Event t XY
Event t LMouseData
Event t KeyboardData
Event t Llama
Event t WSEvent
Event t SetPotatoDefaultParameters
Event t Tool
Event t GoatFocusedArea
_goatWidgetConfig_bypassEvent :: Event t WSEvent
_goatWidgetConfig_setDebugLabel :: Event t Text
_goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea
_goatWidgetConfig_markSaved :: Event t ()
_goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters
_goatWidgetConfig_newFolder :: Event t ()
_goatWidgetConfig_canvasSize :: Event t XY
_goatWidgetConfig_paramsEvent :: Event t Llama
_goatWidgetConfig_load :: Event t EverythingLoadState
_goatWidgetConfig_selectTool :: Event t Tool
_goatWidgetConfig_canvasRegionDim :: Event t XY
_goatWidgetConfig_keyboard :: Event t KeyboardData
_goatWidgetConfig_mouse :: Event t LMouseData
_goatWidgetConfig_unicodeWidthFn :: Maybe UnicodeWidthFn
_goatWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_goatWidgetConfig_bypassEvent :: forall t. GoatWidgetConfig t -> Event t WSEvent
_goatWidgetConfig_setDebugLabel :: forall t. GoatWidgetConfig t -> Event t Text
_goatWidgetConfig_setFocusedArea :: forall t. GoatWidgetConfig t -> Event t GoatFocusedArea
_goatWidgetConfig_markSaved :: forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_setPotatoDefaultParameters :: forall t. GoatWidgetConfig t -> Event t SetPotatoDefaultParameters
_goatWidgetConfig_newFolder :: forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_canvasSize :: forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_paramsEvent :: forall t. GoatWidgetConfig t -> Event t Llama
_goatWidgetConfig_load :: forall t. GoatWidgetConfig t -> Event t EverythingLoadState
_goatWidgetConfig_selectTool :: forall t. GoatWidgetConfig t -> Event t Tool
_goatWidgetConfig_canvasRegionDim :: forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_keyboard :: forall t. GoatWidgetConfig t -> Event t KeyboardData
_goatWidgetConfig_mouse :: forall t. GoatWidgetConfig t -> Event t LMouseData
_goatWidgetConfig_unicodeWidthFn :: forall t. GoatWidgetConfig t -> Maybe UnicodeWidthFn
_goatWidgetConfig_initialState :: forall t. GoatWidgetConfig t -> (OwlPFState, ControllerMeta)
..} = mdo
let
initialscreensize :: XY
initialscreensize = XY
0
initialgoat :: GoatState
initialgoat = XY -> (OwlPFState, ControllerMeta) -> GoatState
makeGoatState XY
initialscreensize (OwlPFState, ControllerMeta)
_goatWidgetConfig_initialState
endoStyle :: [Event t (GoatState -> GoatState)]
endoStyle = [
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatFocusedArea -> GoatState -> GoatState
endoGoatCmdSetFocusedArea Event t GoatFocusedArea
_goatWidgetConfig_setFocusedArea
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SetPotatoDefaultParameters -> GoatState -> GoatState
endoGoatCmdSetDefaultParams Event t SetPotatoDefaultParameters
_goatWidgetConfig_setPotatoDefaultParameters
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> GoatState -> GoatState
endoGoatCmdMarkSaved Event t ()
_goatWidgetConfig_markSaved
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tool -> GoatState -> GoatState
endoGoatCmdSetTool Event t Tool
_goatWidgetConfig_selectTool
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> GoatState -> GoatState
endoGoatCmdSetDebugLabel Event t Text
_goatWidgetConfig_setDebugLabel
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XY -> GoatState -> GoatState
endoGoatCmdSetCanvasRegionDim Event t XY
_goatWidgetConfig_canvasRegionDim
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EverythingLoadState -> GoatState -> GoatState
endoGoatCmdLoad Event t EverythingLoadState
_goatWidgetConfig_load
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\()
_ -> Text -> GoatState -> GoatState
endoGoatCmdNewFolder Text
"folder") Event t ()
_goatWidgetConfig_newFolder
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WSEvent -> GoatState -> GoatState
endoGoatCmdWSEvent Event t WSEvent
_goatWidgetConfig_bypassEvent
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WSEvent -> GoatState -> GoatState
endoGoatCmdWSEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Llama
_goatWidgetConfig_paramsEvent forall a b. (a -> b) -> a -> b
$ \Llama
llama -> (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
False, Llama
llama)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WSEvent -> GoatState -> GoatState
endoGoatCmdWSEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t XY
_goatWidgetConfig_canvasSize forall a b. (a -> b) -> a -> b
$ \XY
xy -> (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
False, OwlPFCmd -> Llama
makePFCLlama forall a b. (a -> b) -> a -> b
$ DeltaLBox -> OwlPFCmd
OwlPFCResizeCanvas (XY -> XY -> DeltaLBox
DeltaLBox XY
0 XY
xy))
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LMouseData -> GoatState -> GoatState
endoGoatCmdMouse Event t LMouseData
_goatWidgetConfig_mouse
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyboardData -> GoatState -> GoatState
endoGoatCmdKeyboard Event t KeyboardData
_goatWidgetConfig_keyboard
]
Dynamic t GoatState
goatDyn' :: Dynamic t GoatState
<- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn forall a b. (a -> b) -> a -> b
($) GoatState
initialgoat forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [Event t (GoatState -> GoatState)]
endoStyle
let goatDyn :: Dynamic t GoatState
goatDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> a
id Dynamic t GoatState
goatDyn'
Dynamic t Tool
r_tool <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> Tool
goatState_selectedTool Dynamic t GoatState
goatDyn
Dynamic t Selection
r_selection <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> Selection
_goatState_selection Dynamic t GoatState
goatDyn
Dynamic t PotatoDefaultParameters
r_potatoDefaultParams <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> PotatoDefaultParameters
_goatState_potatoDefaultParameters Dynamic t GoatState
goatDyn
Dynamic t BroadPhaseState
r_broadphase <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> BroadPhaseState
_goatState_broadPhaseState Dynamic t GoatState
goatDyn
Dynamic t XY
r_pan <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> XY
_goatState_pan Dynamic t GoatState
goatDyn
Dynamic t LayersState
r_layers <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> LayersState
_goatState_layersState Dynamic t GoatState
goatDyn
Dynamic t HandlerRenderOutput
r_handlerRenderOutput <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GoatState
gs -> forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (GoatState -> SomePotatoHandler
_goatState_handler GoatState
gs) (GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
gs)) Dynamic t GoatState
goatDyn
Dynamic t LayersViewHandlerRenderOutput
r_layersHandlerRenderOutput <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GoatState
gs -> forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
gs) (GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
gs)) Dynamic t GoatState
goatDyn
Dynamic t SCanvas
r_canvas <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlPFState -> SCanvas
_owlPFState_canvas forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFWorkspace
_goatState_workspace) Dynamic t GoatState
goatDyn
Dynamic t Bool
r_unsavedChanges <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GoatState -> Bool
goatState_hasUnsavedChanges) Dynamic t GoatState
goatDyn
let
r_renderedCanvas :: Dynamic t RenderedCanvasRegion
r_renderedCanvas = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas Dynamic t GoatState
goatDyn
r_renderedSelection :: Dynamic t RenderedCanvasRegion
r_renderedSelection = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> RenderedCanvasRegion
_goatState_renderedSelection Dynamic t GoatState
goatDyn
forall (m :: * -> *) a. Monad m => a -> m a
return GoatWidget
{
_goatWidget_tool :: Dynamic t Tool
_goatWidget_tool = Dynamic t Tool
r_tool
, _goatWidget_selection :: Dynamic t Selection
_goatWidget_selection = Dynamic t Selection
r_selection
, _goatWidget_potatoDefaultParameters :: Dynamic t PotatoDefaultParameters
_goatWidget_potatoDefaultParameters = Dynamic t PotatoDefaultParameters
r_potatoDefaultParams
, _goatWidget_layers :: Dynamic t LayersState
_goatWidget_layers = Dynamic t LayersState
r_layers
, _goatWidget_pan :: Dynamic t XY
_goatWidget_pan = Dynamic t XY
r_pan
, _goatWidget_broadPhase :: Dynamic t BroadPhaseState
_goatWidget_broadPhase = Dynamic t BroadPhaseState
r_broadphase
, _goatWidget_canvas :: Dynamic t SCanvas
_goatWidget_canvas = Dynamic t SCanvas
r_canvas
, _goatWidget_renderedCanvas :: Dynamic t RenderedCanvasRegion
_goatWidget_renderedCanvas = Dynamic t RenderedCanvasRegion
r_renderedCanvas
, _goatWidget_renderedSelection :: Dynamic t RenderedCanvasRegion
_goatWidget_renderedSelection = Dynamic t RenderedCanvasRegion
r_renderedSelection
, _goatWidget_handlerRenderOutput :: Dynamic t HandlerRenderOutput
_goatWidget_handlerRenderOutput = Dynamic t HandlerRenderOutput
r_handlerRenderOutput
, _goatWidget_layersHandlerRenderOutput :: Dynamic t LayersViewHandlerRenderOutput
_goatWidget_layersHandlerRenderOutput = Dynamic t LayersViewHandlerRenderOutput
r_layersHandlerRenderOutput
, _goatWidget_unsavedChanges :: Dynamic t Bool
_goatWidget_unsavedChanges = Dynamic t Bool
r_unsavedChanges
, _goatWidget_DEBUG_goatState :: Dynamic t GoatState
_goatWidget_DEBUG_goatState = Dynamic t GoatState
goatDyn
}