-- Author:     Andy Stewart <lazycat.manatee@gmail.com>
-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
-- 
-- Copyright (C) 2010 Andy Stewart, all rights reserved.
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module Manatee.Core.Render where

import Control.Monad.State
import DBus.Client hiding (Signal)
import GHC.Conc
import Graphics.UI.Gtk hiding (Window, windowNew, Frame, frameNew, Signal, Frame, Variant, Action, plugNew, plugGetId, get)
import Manatee.Core.DBus
import Manatee.Core.Debug
import Manatee.Core.Page
import Manatee.Core.PageView
import Manatee.Core.Types
import Manatee.Toolkit.General.DBus
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.General.Set hiding (mapM)
import Manatee.Toolkit.General.State
import Manatee.Toolkit.Widget.Plug
import System.Environment
import System.Posix.Process
import System.Posix.Types (ProcessID)

import qualified Data.Map as M
import qualified Data.Set as Set

-- | Irc client render process.
startupRender :: PageBufferNewFun -> IO ()
startupRender bufferNewFun = do
  -- Get program arguments.
  args <- getArgs

  case args of
    [x] -> 
        case (read x :: SpawnProcessArgs) of
          arg@(SpawnRenderProcessArgs {}) -> renderMain arg bufferNewFun
          _ -> return ()
    _ -> return ()
    
-- | Render process main entry.
renderMain :: SpawnProcessArgs -> PageBufferNewFun -> IO ()
renderMain (SpawnRenderProcessArgs pageId pType sId pagePath options) bufferNewFun = do
  -- Init.
  unsafeInitGUIForThreadedRTS

  -- Create page list.
  pageList <- newTVarIO Set.empty 

  -- Get render process id.
  processId <- getProcessID

  -- Make client name.
  let clientName = mkRenderClientName processId

  -- Create client.
  client <- mkSessionClientWithName clientName

  -- Create page buffer.
  bufferWrap <- bufferNewFun pagePath options client pageId 

  -- Build render client for listen dbus signal.
  mkRenderClient client bufferWrap processId pageList pType

  -- Create first page.
  renderPageNew client bufferWrap pageList processId (pageId, pType, sId) True

  -- Loop.
  mainGUI

-- | Build render client for listen dbus signal.
mkRenderClient :: Client -> PageBufferWrap -> ProcessID -> TVar PageList -> PageType -> IO ()
mkRenderClient client bufferWrap processId pageList pType = 
  -- Build match rule.
  mkRenderMatchRules client 
    [(CloneRenderPage,          renderHandleClonePage client bufferWrap pageList processId pType)
    ,(ReparentRenderPage,       renderHandleReparentPage client bufferWrap pageList processId)
    ,(FocusRenderPage,          renderHandleFocusPage pageList)
    ,(PageViewKeyPress,         renderHandleKeyPress pageList)
    ,(DestroyRenderPage,        renderHandleDestroyPage pageList)
    ,(ExitRenderProcess,        renderHandleExitProcess client processId)]

-- | Handle clone render page signal.
renderHandleClonePage :: Client -> PageBufferWrap -> TVar PageList -> ProcessID -> PageType -> RenderSignalArgs -> IO ()
renderHandleClonePage client bufferWrap pageList processId pType (CloneRenderPageArgs pageId sId) = do
  debugDBusMessage $ "renderHandleClonePage: Catch CloneRenderPage signal. Box id: " ++ show sId

  renderPageNew client bufferWrap pageList processId (pageId, pType, sId) False
  
  debugDBusMessage $ "renderHandleClonePage: Finish clone page. Box id : " ++ show sId

-- | Handle re-parent render page signal.
renderHandleReparentPage :: Client -> PageBufferWrap -> TVar PageList -> ProcessID -> RenderSignalArgs -> IO ()
renderHandleReparentPage client (PageBufferWrap buffer) pageList processId (ReparentRenderPageArgs pageId oldPlugId sId) = do
  debugDBusMessage $ "renderHandleReparentPage: Catch ReparentRenderPage signal. Box id: " ++ show sId

  -- Get old plug.
  pList <- readTVarIO pageList
  let oldPage = maybeFindMin pList (\x -> pagePlugId x == oldPlugId)

  -- Try to re-parent children from old plug.
  case oldPage of
    Just op -> do
          -- Create new plug.
          newPlug <- plugNew Nothing
          let pId = plugId newPlug
              pType = pageType op 

          -- Reparent.
          writeTVarIO (pageApplyViewWrap op pageViewPlugId) pId -- update new page plug id
          widgetReparent (pageScrolledWindow op) (plugBody newPlug)
          widgetShowAll $ plugBody newPlug

          -- New page.
          page <- pageNew pageId pType newPlug (pageView op)

          -- Add page to page list.
          runTVarStateT pageList $ put . Set.insert page

          -- Destroy old plug.
          renderHandleDestroyPage pageList (DestroyRenderPageArgs pageId oldPlugId)
  
          -- Send `NewRenderPageConfirm` signal.
          let modeName = pageModeName $ pageBufferMode buffer 
          path <- pageBufferGetName buffer
          mkDaemonSignal client 
                         NewRenderPageConfirm 
                         (NewRenderPageConfirmArgs pageId pType sId pId processId modeName path False)

          debugDBusMessage $ "renderHandleReparentPage: Finish reparent page. Box id : " ++ show sId
    Nothing -> debugDBusMessage $ "Warning (renderHandleReparentPage): Cant find old plug " ++ show oldPlugId ++ " to reparent."

-- | Handle new render page signal.
renderPageNew :: Client -> PageBufferWrap -> TVar PageList -> ProcessID -> (PageId, PageType, SignalBoxId) -> Bool -> IO ()
renderPageNew client (PageBufferWrap buffer) pageList processId (pageId, pType, sId) isFirstPage = do
   -- Create page plug.
  plug <- plugNew Nothing
  let pId = plugId plug
  
  -- Create page.
  viewWrap <- pageBufferCreateView buffer pId
  page <- pageNew pageId pType plug viewWrap
  
  -- Create page and pageView.
  plugBody plug `containerAdd` pageScrolledWindow page
  widgetShowAll $ plugBody plug
  
  -- Add page to page list.
  runTVarStateT pageList $ put .  Set.insert page
  
  -- Send `NewRenderPageConfirm` signal.
  let modeName = pageModeName $ pageBufferMode buffer 
  path <- pageBufferGetName buffer
  mkDaemonSignal client 
                 NewRenderPageConfirm 
                 (NewRenderPageConfirmArgs pageId pType sId pId processId modeName path isFirstPage)

-- | Handle focus render page signal.
renderHandleFocusPage :: TVar PageList -> RenderSignalArgs -> IO ()
renderHandleFocusPage pageList (FocusRenderPageArgs plugId) = do
  pl <- readTVarIO pageList
  maybeFindMin pl (\x -> pagePlugId x == plugId) 
     ?>= \ page -> pageApplyViewWrap page pageViewFocus 

-- | Handle page view key press signal.
renderHandleKeyPress :: TVar PageList -> RenderSignalArgs -> IO ()
renderHandleKeyPress pageList (PageViewKeyPressArgs plugId keystoke sEvent) = do
  pl <- readTVarIO pageList
  maybeFindMin pl (\x -> pagePlugId x == plugId) 
     ?>= \ (Page {pageView = PageViewWrap view}) -> 
       case M.lookup keystoke pageViewKeymap of
         -- Execute page view common action when match.
         Just action -> action view
         -- Otherwise pass key to page view instance.
         Nothing -> pageViewHandleKeyAction view keystoke sEvent

-- | Handle destroy render page signal.
renderHandleDestroyPage :: TVar PageList -> RenderSignalArgs -> IO ()
renderHandleDestroyPage pageList (DestroyRenderPageArgs _ plugId) = 
    runTVarStateT pageList $ \pl -> 
      maybeFindMin pl (\x -> pagePlugId x == plugId) ?>= \mp -> do
         lift $ debugDBusMessage $ "renderHandleDestroyPage: Catch DestroyRenderPage signal. Plug id : " ++ show plugId
         -- Delete page from page list.
         put (Set.delete mp pl)                              
         -- Destroy page.
         lift $ plugDestroy $ pagePlug mp
                  
-- | Handle exit process signal.
renderHandleExitProcess :: Client -> ProcessID -> RenderSignalArgs -> IO ()
renderHandleExitProcess client processId (ExitRenderProcessArgs pageId) = do
  -- Send RenderProcessExit signal to daemon process.
  mkDaemonSignal client RenderProcessExit (RenderProcessExitArgs pageId processId)

  -- Quit process.
  mainQuit