tinytools-vty-0.1.0.0: src/Potato/Flow/Vty/Left.hs
-- TODO someday we will do dockable widget manager, but this is what yo uget for now
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Flow.Vty.Left (
LeftWidgetConfig(..)
, holdLeftWidget
, LeftWidget(..)
, MenuButtonsWidget(..)
) where
import Relude
import Potato.Flow
import Potato.Flow.Vty.Info
import Potato.Flow.Vty.Layer
import Potato.Flow.Vty.Params
import Potato.Flow.Vty.PotatoReader
import Potato.Flow.Vty.Tools
import Potato.Flow.Vty.ToolOptions
import Potato.Flow.Vty.Common
import Potato.Reflex.Vty.Helpers
import qualified Data.Text.IO as T
import Reflex
import Reflex.Vty
import qualified Graphics.Vty as V
-- could put into a different file but whatever
data MenuButtonsWidget t = MenuButtonsWidget {
_menuButtonsWidget_newEv :: Event t ()
, _menuButtonsWidget_openEv :: Event t ()
, _menuButtonsWidget_saveEv :: Event t ()
, _menuButtonsWidget_saveAsEv :: Event t ()
, _menuButtonsWidget_exportEv :: Event t ()
, _menuButtonsWidget_quitEv :: Event t ()
}
data LeftWidgetConfig t = LeftWidgetConfig {
-- TODO rename to _leftWidgetConfig_goatW
_layersWidgetConfig_goatW :: GoatWidget t
-- TODO other stuff
}
data LeftWidget t = LeftWidget {
_leftWidget_layersW :: LayerWidget t
, _leftWidget_toolsW :: ToolWidget t
, _leftWidget_paramsW :: ParamsWidget t
, _leftWidget_menuButtonsW :: MenuButtonsWidget t
, _leftWidget_setFocusEvent :: Event t GoatFocusedArea
-- TODO other stuff
}
hdivider :: forall t m. (MonadWidget t m, HasLayout t m) => m ()
hdivider = (grout. fixed) 1 $ fill (constant '-')
-- | Mouse down events for a particular mouse button
mouseFocus
:: (Reflex t, Monad m, HasInput t m)
=> m (Event t Bool)
mouseFocus = do
i <- input
return $ fforMaybe i $ \case
V.EvMouseDown _ _ _ _ -> Just True
_ -> Nothing
holdLeftWidget :: forall t m. (MonadWidget t m, HasPotato t m)
=> LeftWidgetConfig t
-> m (LeftWidget t)
holdLeftWidget LeftWidgetConfig {..} = do
widthDyn <- displayWidth
-- this will toggle true/fales as you click between left/canvas panels
-- this only works because you use splitHDrag to split the Left/Canvas panels (it toggles the focus)
focusDyn <- focus
let
loseFocusEv = void $ ffilter (not . id) $ updated focusDyn
initLayout $ col $ mdo
-- Menu
-- TODO height should be dynamic but not sure if there's away to do this dynamically because width (from which buttonsHeightDyn) is derived depends on `grout . fixed`. You need to pull width from outside of the `grout . fixed` call to make this work right...
(menuButtons, menuFocusEv, buttonsHeightDyn) <- (grout . fixed) buttonsHeightDyn $ row $ do
(buttonsEv, heightDyn) <- buttonList (constDyn ["new", "open", "save", "save as", "export to \"potato.txt\"", "quit"]) (Just widthDyn)
let
exportEv = ffilterButtonIndex 4 buttonsEv
menuButtons' = MenuButtonsWidget {
_menuButtonsWidget_newEv = ffilterButtonIndex 0 buttonsEv
, _menuButtonsWidget_openEv = ffilterButtonIndex 1 buttonsEv
, _menuButtonsWidget_saveEv = ffilterButtonIndex 2 buttonsEv
, _menuButtonsWidget_saveAsEv = ffilterButtonIndex 3 buttonsEv
, _menuButtonsWidget_exportEv = exportEv
, _menuButtonsWidget_quitEv = ffilterButtonIndex 5 buttonsEv
}
clickPrintEv = tag (current $ _goatWidget_renderedCanvas _layersWidgetConfig_goatW) (void exportEv)
-- TODO don't do this here cmon...
performEvent_ $ ffor clickPrintEv $ \rc -> do
let t = renderedCanvasToText rc
-- TODO at least use filename...
liftIO $ T.writeFile "potato.txt" t
menuFocusEv' <- mouseFocus
return (menuButtons', menuFocusEv', heightDyn)
hdivider
-- Tools
(tools, toolsFocusEv) <- (grout . fixed) (_toolWidget_heightDyn tools) $ do
tools' <- holdToolsWidget $ ToolWidgetConfig {
_toolWidgetConfig_tool = _goatWidget_tool _layersWidgetConfig_goatW
, _toolWidgetConfig_widthDyn = widthDyn
}
toolsFocusEv' <- mouseFocus
return (tools', toolsFocusEv')
-- ToolsOptions
-- doesn't do anything right now, just a stub
(toolOptions, toolsOptionsFocusEv) <- (grout . fixed) (_toolOptionsWidget_heightDyn toolOptions) $ do
toolsOptions' <- holdToolOptionsWidget $ ToolOptionsWidgetConfig {
_toolOptionsWidgetConfig_tool = _goatWidget_tool _layersWidgetConfig_goatW
, _toolOptionsWidgetConfig_widthDyn = widthDyn
}
toolsOptionsFocusEv' <- mouseFocus
return (toolsOptions', toolsOptionsFocusEv')
hdivider
-- Layers
(layers, layersFocusEv) <- (grout . stretch) 1 $ do
layers' <- holdLayerWidget $ LayerWidgetConfig {
_layerWidgetConfig_layers = _goatWidget_layers _layersWidgetConfig_goatW
, _layerWidgetConfig_layersView = _goatWidget_layersHandlerRenderOutput _layersWidgetConfig_goatW
, _layerWidgetConfig_selection = _goatWidget_selection _layersWidgetConfig_goatW
}
layersFocusEv' <- mouseFocus
return (layers', layersFocusEv')
hdivider
{-
-- Info
infoFocusEv <- (grout . fixed) 5 $ do
holdInfoWidget $ InfoWidgetConfig {
_infoWidgetConfig_selection = _goatWidget_selection _layersWidgetConfig_goatW
}
mouseFocus
hdivider
-}
let infoFocusEv = never
-- Params
(params, paramsFocusEv) <- (grout . fixed) (_paramsWidget_widgetHeight params) $ do
params' <- holdParamsWidget $ ParamsWidgetConfig {
_paramsWidgetConfig_selectionDyn = _goatWidget_selection _layersWidgetConfig_goatW
, _paramsWidgetConfig_canvasDyn = _goatWidget_canvas _layersWidgetConfig_goatW
, _paramsWidgetConfig_defaultParamsDyn = _goatWidget_potatoDefaultParameters _layersWidgetConfig_goatW
, _paramsWidgetConfig_toolDyn = _goatWidget_tool _layersWidgetConfig_goatW
, _paramsWidgetConfig_loseFocusEv = loseFocusEv
}
paramsFocusEv' <- mouseFocus
return (params', paramsFocusEv')
let
refinedFocusEv = leftmost
[ fmap (const "menu") menuFocusEv
, fmap (const "tools") toolsFocusEv
, fmap (const "toolsOptions") toolsOptionsFocusEv
, fmap (const "layers") layersFocusEv
, fmap (const "info") infoFocusEv
, fmap (const "params") paramsFocusEv
]
refinedFocusDyn <- holdDyn "none" refinedFocusEv
let
setFocusDyn' = ffor2 focusDyn refinedFocusDyn $ \f1 f2 -> case (f1, f2) of
(True, "layers") -> Just GoatFocusedArea_Layers
(True, _) -> Just GoatFocusedArea_Other
-- right now, canvas is the only other choice, eventually there migh be more, in which case change this to Nothing
-- NOTE changing this to Nothing will break the rename via layers -> click on canvas case as currently Goat does not know how to resolve the layer rename handler without an explicit focus change
(False, _) -> Just GoatFocusedArea_Canvas
setFocusDyn <- holdUniqDyn setFocusDyn'
return LeftWidget {
_leftWidget_layersW = layers
, _leftWidget_toolsW = tools
, _leftWidget_paramsW = params
, _leftWidget_menuButtonsW = menuButtons
, _leftWidget_setFocusEvent = fmapMaybe id (updated setFocusDyn)
}