{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Reflex.Vty.Widget.Windows (
) where
import Relude
import Potato.Reflex.Vty.Helpers
import Potato.Reflex.Vty.Widget
import qualified Graphics.Vty.Input.Events as V
import Reflex
import Reflex.Network
import Reflex.Potato.Helpers
import Reflex.Vty
import qualified Data.Map as Map
import Data.Default
import Control.Monad.Fix
type WidgetId = Int
data WindowsAttrs t = WindowsAttrs {
}
data Window = Window {
Window -> Text
_window_name :: Text
, Window -> WidgetId
_window_widgetId :: WidgetId
, Window -> Bool
_window_allowClose :: Bool
, Window -> Bool
_window_allowMove :: Bool
, Window -> Bool
_window_allowResize :: Bool
}
data Tab = OneWindow Window | Tab [Window]
data DockDirection =
DockDirection_Left
| DockDirection_Right
| DockDirection_Top
| DockDirection_Bottom
deriving (WidgetId -> DockDirection -> ShowS
[DockDirection] -> ShowS
DockDirection -> String
forall a.
(WidgetId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockDirection] -> ShowS
$cshowList :: [DockDirection] -> ShowS
show :: DockDirection -> String
$cshow :: DockDirection -> String
showsPrec :: WidgetId -> DockDirection -> ShowS
$cshowsPrec :: WidgetId -> DockDirection -> ShowS
Show)
data DockedTab = DockedTab {
DockedTab -> [(WidgetId, Tab)]
_dockedTab_tabs :: [(Int, Tab)]
, DockedTab -> WidgetId
_dockedTab_size :: Int
, DockedTab -> DockDirection
_dockedTab_dir :: DockDirection
}
data FreeWindow = FreeWindow {
FreeWindow -> Window
_freeWindow_window :: Window
, FreeWindow -> (WidgetId, WidgetId)
_freeWindow_position :: (Int, Int)
, FreeWindow -> (WidgetId, WidgetId)
_freeWindow_size :: (Int, Int)
}
type WindowWidgetMap t m a = Map WidgetId (m a)
data WindowManagerState t m a = WindowManagerState {
forall t (m :: * -> *) a. WindowManagerState t m a -> [DockedTab]
_windowManagerState_docked :: [DockedTab]
, forall t (m :: * -> *) a. WindowManagerState t m a -> [FreeWindow]
_windowManagerState_free :: [FreeWindow]
, forall t (m :: * -> *) a.
WindowManagerState t m a -> (WidgetId, WidgetId)
_windowManagerState_size :: Dimension
, forall t (m :: * -> *) a.
WindowManagerState t m a -> WindowWidgetMap t m a
_windowManagerState_widgetMap :: WindowWidgetMap t m a
}
emptyWindowManagerState :: WindowManagerState t m a
emptyWindowManagerState :: forall t (m :: * -> *) a. WindowManagerState t m a
emptyWindowManagerState = WindowManagerState {
_windowManagerState_docked :: [DockedTab]
_windowManagerState_docked = []
, _windowManagerState_free :: [FreeWindow]
_windowManagerState_free = []
, _windowManagerState_size :: (WidgetId, WidgetId)
_windowManagerState_size = (WidgetId
0,WidgetId
0)
, _windowManagerState_widgetMap :: WindowWidgetMap t m a
_windowManagerState_widgetMap = forall k a. Map k a
Map.empty
}
type Position = (Int, Int)
type Dimension = (Int, Int)
type PosDim = (Position, Dimension)
makeDynRegion :: (Reflex t) => Dynamic t Position -> Dynamic t Dimension -> Dynamic t Region
makeDynRegion :: forall t.
Reflex t =>
Dynamic t (WidgetId, WidgetId)
-> Dynamic t (WidgetId, WidgetId) -> Dynamic t Region
makeDynRegion Dynamic t (WidgetId, WidgetId)
dp Dynamic t (WidgetId, WidgetId)
dd = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t (WidgetId, WidgetId)
dp Dynamic t (WidgetId, WidgetId)
dd forall a b. (a -> b) -> a -> b
$ \(WidgetId
x,WidgetId
y) (WidgetId
w,WidgetId
h) -> WidgetId -> WidgetId -> WidgetId -> WidgetId -> Region
Region WidgetId
x WidgetId
y WidgetId
w WidgetId
h
computeDockDimensions :: PosDim -> [DockedTab] -> [PosDim]
computeDockDimensions :: PosDim -> [DockedTab] -> [PosDim]
computeDockDimensions PosDim
dim = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL PosDim -> DockedTab -> (PosDim, PosDim)
mapAccumFn PosDim
dim where
mapAccumFn :: PosDim -> DockedTab -> (PosDim, PosDim)
mapAccumFn ((WidgetId
accx, WidgetId
accy), (WidgetId
accw, WidgetId
acch)) DockedTab
dt = (PosDim
newAccDim, PosDim
dtpd) where
(PosDim
dtpd, PosDim
newAccDim) = case DockedTab -> DockDirection
_dockedTab_dir DockedTab
dt of
DockDirection
DockDirection_Left -> (
((WidgetId
accx, WidgetId
accy), (WidgetId
dw, WidgetId
acch))
, ((WidgetId
accxforall a. Num a => a -> a -> a
+WidgetId
dw, WidgetId
accy), (WidgetId
accwforall a. Num a => a -> a -> a
-WidgetId
dw, WidgetId
acch))
)
DockDirection
DockDirection_Right -> (
((WidgetId
accx forall a. Num a => a -> a -> a
+ WidgetId
accw forall a. Num a => a -> a -> a
- WidgetId
dw, WidgetId
accy), (WidgetId
dw, WidgetId
acch))
, ((WidgetId
accx, WidgetId
accy), (WidgetId
accwforall a. Num a => a -> a -> a
-WidgetId
dw, WidgetId
acch))
)
DockDirection
DockDirection_Top -> (
((WidgetId
accx, WidgetId
accy), (WidgetId
accw, WidgetId
dh))
, ((WidgetId
accx, WidgetId
accyforall a. Num a => a -> a -> a
+WidgetId
dh), (WidgetId
accw, WidgetId
acchforall a. Num a => a -> a -> a
-WidgetId
dh))
)
DockDirection
DockDirection_Bottom -> (
((WidgetId
accx, WidgetId
accy forall a. Num a => a -> a -> a
+ WidgetId
acch forall a. Num a => a -> a -> a
- WidgetId
dh), (WidgetId
accw, WidgetId
dh))
, ((WidgetId
accx, WidgetId
accy), (WidgetId
accw, WidgetId
acchforall a. Num a => a -> a -> a
-WidgetId
dh))
)
where
dw :: WidgetId
dw = forall a. Ord a => a -> a -> a
min WidgetId
accw (DockedTab -> WidgetId
_dockedTab_size DockedTab
dt)
dh :: WidgetId
dh = forall a. Ord a => a -> a -> a
min WidgetId
acch (DockedTab -> WidgetId
_dockedTab_size DockedTab
dt)
data WindowManagerConfig t m a = WindowManagerConfig {
forall t (m :: * -> *) a.
WindowManagerConfig t m a -> Map WidgetId (m a)
_windowManagerConfig_initialWidgets :: Map WidgetId (m a)
, forall t (m :: * -> *) a.
WindowManagerConfig t m a -> WindowsAttrs t
_windowManagerConfig_style :: WindowsAttrs t
}
data WMCmd = WMCmd_None