{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Flow.Vty.Tools (
Tool(..)
, ToolWidgetConfig(..)
, ToolWidget(..)
, holdToolsWidget
) where
import Relude
import Potato.Flow.Controller
import Potato.Flow.Vty.Common
import Potato.Reflex.Vty.Helpers
import Control.Monad.Fix
import Control.Monad.NodeId
import Reflex
data ToolWidgetConfig t = ToolWidgetConfig {
forall t. ToolWidgetConfig t -> Dynamic t Tool
_toolWidgetConfig_tool :: Dynamic t Tool
, forall t. ToolWidgetConfig t -> Dynamic t Int
_toolWidgetConfig_widthDyn :: Dynamic t Int
}
data ToolWidget t = ToolWidget {
forall t. ToolWidget t -> Event t Tool
_toolWidget_setTool :: Event t Tool
, forall t. ToolWidget t -> Dynamic t Int
_toolWidget_heightDyn :: Dynamic t Int
}
toolWidgetToIndex :: Tool -> Int
toolWidgetToIndex :: Tool -> Int
toolWidgetToIndex = \case
Tool
Tool_Select -> Int
0
Tool
Tool_Pan -> Int
1
Tool
Tool_Box -> Int
2
Tool
Tool_Line -> Int
3
Tool
Tool_TextArea -> Int
4
Tool
_ -> Int
0
holdToolsWidget :: forall t m. (PostBuild t m, MonadWidget t m)
=> ToolWidgetConfig t
-> m (ToolWidget t)
holdToolsWidget :: forall t (m :: * -> *).
(PostBuild t m, MonadWidget t m) =>
ToolWidgetConfig t -> m (ToolWidget t)
holdToolsWidget ToolWidgetConfig {Dynamic t Int
Dynamic t Tool
_toolWidgetConfig_widthDyn :: Dynamic t Int
_toolWidgetConfig_tool :: Dynamic t Tool
_toolWidgetConfig_widthDyn :: forall t. ToolWidgetConfig t -> Dynamic t Int
_toolWidgetConfig_tool :: forall t. ToolWidgetConfig t -> Dynamic t Tool
..} = mdo
(Event t Int
radioEvs, Dynamic t Int
heightDyn) <- forall t (m :: * -> *).
(Reflex t, MonadNodeId m, HasDisplayRegion t m, HasImageWriter t m,
HasInput t m, HasTheme t m) =>
Dynamic t [Text]
-> Dynamic t [Int]
-> Maybe (Dynamic t Int)
-> m (Event t Int, Dynamic t Int)
radioList (forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn [Text
"(v)select",Text
"(p)an",Text
"(b)ox",Text
"(l)ine",Text
"pai(n)t"]) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tool -> Int
toolWidgetToIndex) Dynamic t Tool
_toolWidgetConfig_tool) (forall a. a -> Maybe a
Just Dynamic t Int
_toolWidgetConfig_widthDyn)
let
selectB :: Event t ()
selectB = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
==Int
0) Event t Int
radioEvs
panB :: Event t ()
panB = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
==Int
1) Event t Int
radioEvs
boxB :: Event t ()
boxB = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
==Int
2) Event t Int
radioEvs
lineB :: Event t ()
lineB = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
==Int
3) Event t Int
radioEvs
textareaB :: Event t ()
textareaB = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
==Int
4) Event t Int
radioEvs
let
setTool :: Event t Tool
setTool = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[Tool
Tool_Select forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
selectB]
, Tool
Tool_Pan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
panB]
, Tool
Tool_Box forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
boxB]
, Tool
Tool_Line forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
lineB]
, Tool
Tool_TextArea forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
textareaB]]
forall (m :: * -> *) a. Monad m => a -> m a
return ToolWidget {
_toolWidget_setTool :: Event t Tool
_toolWidget_setTool = Event t Tool
setTool
, _toolWidget_heightDyn :: Dynamic t Int
_toolWidget_heightDyn = Dynamic t Int
heightDyn
}