Windows.hs

-- TODO FINISH INCOMPLETE
{-# 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_name :: Text
  , _window_widgetId :: WidgetId
  , _window_allowClose :: Bool
  , _window_allowMove :: Bool
  , _window_allowResize :: Bool
}

-- note, OneWindow can not have tabs added to it
data Tab = OneWindow Window | Tab [Window]

data DockDirection =
  DockDirection_Left
  | DockDirection_Right
  | DockDirection_Top
  | DockDirection_Bottom
  deriving (Show)

data DockedTab = DockedTab {
  _dockedTab_tabs :: [(Int, Tab)] -- left to right, or top to bottom
  , _dockedTab_size :: Int
  , _dockedTab_dir :: DockDirection
}

data FreeWindow = FreeWindow {
  _freeWindow_window :: Window
  , _freeWindow_position :: (Int, Int)
  , _freeWindow_size :: (Int, Int)
}

type WindowWidgetMap t m a = Map WidgetId (m a)
data WindowManagerState t m a = WindowManagerState {
  _windowManagerState_docked :: [DockedTab]
  , _windowManagerState_free :: [FreeWindow]
  , _windowManagerState_size :: Dimension
  , _windowManagerState_widgetMap :: WindowWidgetMap t m a
}

emptyWindowManagerState :: WindowManagerState t m a
emptyWindowManagerState = WindowManagerState {
    _windowManagerState_docked = []
    , _windowManagerState_free = []
    , _windowManagerState_size = (0,0)
    , _windowManagerState_widgetMap = Map.empty
  }

-- temp math stuff
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 dp dd = ffor2 dp dd $ \(x,y) (w,h) -> Region x y w h

--(:+) :: (Int, Int) -> (Int, Int) -> (Int, Int)
--(a,b) :+ (x,y) = (a+x, b+y)
--infixl 6 :+
--(-+) :: (Int, Int) -> (Int, Int) -> (Int, Int)
--(a,b) :+ (x,y) = (a-x, b-y)
--infixl 6 -+

computeDockDimensions :: PosDim -> [DockedTab] -> [PosDim]
computeDockDimensions dim = snd . mapAccumL mapAccumFn dim where
  mapAccumFn ((accx, accy), (accw, acch)) dt = (newAccDim, dtpd) where
    (dtpd, newAccDim) = case _dockedTab_dir dt of
      DockDirection_Left -> (
          ((accx, accy), (dw, acch))
          , ((accx+dw, accy), (accw-dw, acch))
        )
      DockDirection_Right -> (
          ((accx + accw - dw, accy), (dw, acch))
          , ((accx, accy), (accw-dw, acch))
        )
      DockDirection_Top -> (
          ((accx, accy), (accw, dh))
          , ((accx, accy+dh), (accw, acch-dh))
        )
      DockDirection_Bottom -> (
          ((accx, accy + acch - dh), (accw, dh))
          , ((accx, accy), (accw, acch-dh))
        )
      where
        dw = min accw (_dockedTab_size dt)
        dh = min acch (_dockedTab_size dt)



data WindowManagerConfig t m a = WindowManagerConfig {
 _windowManagerConfig_initialWidgets :: Map WidgetId (m a)

 -- TODO initial widget configuration

 , _windowManagerConfig_style :: WindowsAttrs t

 -- eventually
 --, _windowManagerConfig_addWidget :: Event t
}

data WMCmd = WMCmd_None

{- TODO fix for new layout stuff
windowManager ::
  forall t m a. (Reflex t, Adjustable t m, NotReady t m, PostBuild t m, MonadFix m, MonadHold t m, MonadNodeId m, Monad m)
  => WindowManagerConfig t m a
  ->  m (Event t (NonEmpty a))
windowManager WindowManagerConfig {..} = mdo

  inpEv <- input
  widthDyn <- displayWidth
  heightDyn <- displayHeight
  initialWidth <- sample . current $ widthDyn
  initialHeight <- sample . current $ heightDyn

  let
    cmdev = never
    foldfn :: WMCmd -> WindowManagerState t m a -> WindowManagerState t m a
    foldfn cmd wms@WindowManagerState {..} = r where
      r = wms

    initialState = emptyWindowManagerState {
        _windowManagerState_size = (initialWidth, initialHeight)
      }

  wmsDyn <- foldDyn foldfn initialState cmdev

  -- TODO wrap everything in a VtyWidget so you can capture mouse input for dock manipulation

  -- TODO first render docked widgets

  -- next render floating widgets
  let
    freeWindowFn :: WindowWidgetMap t m a -> Dynamic t Bool -> Dynamic t FreeWindow -> m a
    freeWindowFn wwm focussedDyn freeWindowDyn  = do
      -- TODO change return type to Dynamic t (m a) so that these params can change too
      Window {..} <- sample . current $ fmap _freeWindow_window freeWindowDyn
      let
        child = case Map.lookup _window_widgetId wwm of
          -- TODO pretty sure you should just change to m ()
          Nothing -> return undefined
          Just w -> w
        dynRegion = makeDynRegion (_freeWindow_position <$> freeWindowDyn) (_freeWindow_size <$> freeWindowDyn)
      pane dynRegion focussedDyn $ do
        -- TODO add close button
        -- TODO proper window widget, this is just temp render for testing
        boxTitle (constant roundedBoxStyle) (constant _window_name) child

  let
    freeWindowsDyn = fmap _windowManagerState_free wmsDyn
    -- TODO figure out how to pass in focussedDyn
    fmapFnFreeWindow wms = simpleList freeWindowsDyn (freeWindowFn (_windowManagerState_widgetMap wms) (constDyn False))
  outputEvs <- networkView $ fmap fmapFnFreeWindow wmsDyn


  -- TODO fmap through wmsDyn window stack and render them
  -- TODO fanMap out window events (close/moved)
  return never
-}
-- TODO monad for making initial configuration
{-
dock = do
  free $ widget1
  free $ widget2
  free $ widget3
  dock DockDirection_Left $ do
    addTab $ do
      tab $ widget4
      tab $ widget5
    addTab $ do
      tab $ widget6
      tab $ widget7
  dock DockDirection_Bottom $ do
    addWindow $ widget8
-}