{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Hoodle.Coroutine.Window 
-- Copyright   : (c) 2011-2015 Ian-Woo Kim
--
-- License     : BSD3
-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-----------------------------------------------------------------------------

module Hoodle.Coroutine.Window where

import           Control.Applicative
import           Control.Lens (view,set,over,(^.),(.~),_2)
import           Control.Monad.State 
import qualified Data.IntMap as M
import qualified Data.List as L
import           Data.UUID (UUID)
import qualified Graphics.UI.Gtk as Gtk
--
import           Data.Hoodle.Generic
import           Data.Hoodle.Simple (Dimension(..))
--
import           Hoodle.Accessor
import           Hoodle.Coroutine.Draw
import           Hoodle.Coroutine.File
import           Hoodle.Coroutine.Mode
import           Hoodle.Coroutine.Page
import           Hoodle.GUI.Reflect
import           Hoodle.ModelAction.Page
import           Hoodle.ModelAction.Window
import           Hoodle.Type.Canvas
import           Hoodle.Type.Coroutine
import           Hoodle.Type.Enum
import           Hoodle.Type.Event
import           Hoodle.Type.HoodleState
import           Hoodle.Type.PageArrangement
import           Hoodle.Type.Undo
import           Hoodle.Type.Window
import           Hoodle.Util
--

-- | canvas configure with general zoom update func
canvasConfigureGenUpdate :: MainCoroutine () 
                            -> CanvasId 
                            -> CanvasDimension 
                            -> MainCoroutine () 
canvasConfigureGenUpdate updatefunc cid cdim 
  = updateUhdl (\uhdl -> unboxBiAct (fsingle uhdl) (fcont uhdl) (getCanvasInfo cid uhdl)) >> updatefunc 
  where fsingle uhdl cinfo = do 
          cinfo' <- liftIO $ updateCanvasDimForSingle cdim cinfo 
          return $ setCanvasInfo (cid,CanvasSinglePage cinfo') uhdl
        fcont uhdl cinfo = do 
          page <- getCurrentPageCvsId cid
          let pdim = PageDimension (view gdimension page)
          cinfo' <- liftIO $ updateCanvasDimForContSingle pdim cdim cinfo 
          return $ setCanvasInfo (cid,CanvasContPage cinfo') uhdl 
  
-- | 
doCanvasConfigure :: CanvasId -> CanvasDimension -> MainCoroutine () 
doCanvasConfigure = canvasConfigureGenUpdate canvasZoomUpdateAll

-- | 
eitherSplit :: SplitType -> MainCoroutine () 
eitherSplit stype = do
    xst <- get
    let uhdl = view (unitHoodles.currentUnit) xst
    let cmap = view cvsInfoMap uhdl
        currcid = getCurrentCanvasId uhdl
        newcid = newCanvasId cmap 
        fstate = view frameState uhdl
        enewfstate = splitWindow currcid (newcid,stype) fstate 
    case enewfstate of 
      Left _ -> return ()
      Right fstate' -> do 
        cinfobox <- maybeError "eitherSplit" . M.lookup currcid $ cmap 
        let callback = view callBack xst
            rtwin = view rootWindow uhdl
            rtcntr = view rootContainer uhdl
            rtrwin = view rootOfRootWindow xst 
        liftIO $ Gtk.containerRemove rtcntr rtwin
        (uhdl',win,fstate'') <- liftIO $ constructFrame' callback cinfobox uhdl fstate'
        let uhdl'' = ((frameState .~ fstate'') . (rootWindow .~ win)) uhdl'
        let xst3 = (unitHoodles.currentUnit .~ uhdl'') xst
        put xst3 
        liftIO $ registerFrameToContainer rtrwin rtcntr win
        (uhdl3,_wconf) <- liftIO $ eventConnect xst3 uhdl'' (view frameState uhdl'')
        updateUhdl $ const (liftIO $ updatePageAll (view hoodleModeState uhdl3) uhdl3)
        canvasZoomUpdateAll
        invalidateAll 

-- | 
deleteCanvas :: MainCoroutine () 
deleteCanvas = do 
    xst <- get
    let uhdl = view (unitHoodles.currentUnit) xst
        cmap = view cvsInfoMap uhdl
        currcid = getCurrentCanvasId uhdl
        fstate = view frameState uhdl
        enewfstate = removeWindow currcid fstate 
    case enewfstate of 
      Left _ -> return ()
      Right Nothing -> return ()
      Right (Just fstate') -> do 
        let cmap' = M.delete currcid cmap
            newcurrcid = maximum (M.keys cmap')
        updateUhdl $ \_uhdl -> do
          uhdl' <- changeCurrentCanvasId newcurrcid 
          maybe (return uhdl') return $ setCanvasInfoMap cmap' uhdl'
        xst1 <- get
        let uhdl1 = view (unitHoodles.currentUnit) xst1
        let rtwin = view rootWindow uhdl1
            rtcntr = view rootContainer uhdl1 
            rtrwin = view rootOfRootWindow xst1 
        liftIO $ Gtk.containerRemove rtcntr rtwin
        (uhdl2,win,fstate'') <- liftIO $ constructFrame xst1 uhdl1 fstate'
        pureUpdateUhdl (const (((frameState .~ fstate'') . (rootWindow .~ win)) uhdl2))
        xst3 <- get
        liftIO $ registerFrameToContainer rtrwin rtcntr win
        updateUhdl $ \uhdl' -> do
          (uhdl'',_wconf) <- liftIO $ eventConnect xst3 uhdl' (view frameState uhdl')
          liftIO $ updatePageAll (view hoodleModeState uhdl'') uhdl''
        canvasZoomUpdateAll
        invalidateAll 

            
-- | 
paneMoveStart :: MainCoroutine () 
paneMoveStart = do 
    ev <- nextevent 
    case ev of 
      UpdateCanvas cid -> invalidateInBBox Nothing Efficient cid >> paneMoveStart 
      PaneMoveEnd -> return () 
      CanvasConfigure cid w' h'->
        canvasConfigureGenUpdate canvasZoomUpdateBufAll cid (CanvasDimension (Dim w' h')) >> paneMoveStart
      _ -> paneMoveStart
       
-- | not yet implemented?
paneMoved :: MainCoroutine () 
paneMoved = msgShout "paneMoved: not implemented"
    
-- | start full screen mode
fullScreen :: MainCoroutine ()
fullScreen = do 
    xst <- get 
    let rwin = view rootOfRootWindow xst 
    if view isFullScreen xst 
      then liftIO (Gtk.windowUnfullscreen rwin) >> modify (over isFullScreen (const False))
      else liftIO (Gtk.windowFullscreen rwin) >> modify (over isFullScreen (const True))

-- |
addTab :: FileStore -> MainCoroutine ()
addTab filestore = do
    xst <- get
    let notebook = xst ^. rootNotebook
        callback = xst ^. callBack
        btnold = xst ^. (unitHoodles.currentUnit.unitButton)
    liftIO $ Gtk.widgetSetSensitive btnold False
    vboxcvs <- liftIO $ Gtk.vBoxNew False 0
    (tabnum,uuid,btn) <- liftIO $ createTab callback notebook vboxcvs
    let wconf = Node 1
        initcvs = defaultCvsInfoSinglePage { _canvasId = 1 }
        initcvsbox = CanvasSinglePage initcvs
        -- mfp = fileStore2Maybe filestore
    uhdl' <- (undoTable .~ emptyUndo 50)   -- (undo = 50 for the time being) 
             . (frameState .~ wconf) 
             . updateFromCanvasInfoAsCurrentCanvas initcvsbox
             . (cvsInfoMap .~ M.empty)
             . (isSaved .~ True)
             . (hoodleFileControl.hoodleFileName .~ filestore) 
             . (unitKey .~ tabnum) 
             . (unitUUID .~ uuid) 
             . (unitButton .~ btn)
             <$> liftIO emptyUnitHoodle
    modify . set (unitHoodles.currentUnit) =<< (liftIO $ do
      (uhdl'',wdgt,_) <- constructFrame xst uhdl' wconf
      let uhdl3 = (rootWindow .~ wdgt) . (rootContainer .~ Gtk.castToBox vboxcvs) $ uhdl''
      (uhdl4,_wconf) <- eventConnect xst uhdl3 (view frameState uhdl3)
      registerFrameToContainer (xst^.rootOfRootWindow) (Gtk.castToBox vboxcvs) wdgt
      Gtk.widgetShowAll notebook
      return uhdl4)

    doIOaction_ $ 
      blockWhile (view (uiComponentSignalHandler.switchTabSignal) xst) $
        Gtk.set notebook [Gtk.notebookPage Gtk.:= tabnum]
    getFileContent filestore
    updateUhdl $ \uhdl -> do
      liftIO (updatePageAll (view hoodleModeState uhdl) uhdl)
      unboxBiAct (sing2ContPage uhdl) (const (return uhdl)) . view currentCanvasInfo $ uhdl
    pageZoomChange FitWidth
    canvasZoomUpdateAll
    invalidateAll 
    reflectCursor True

-- | 
findTab :: UUID -> MainCoroutine (Maybe Int)
findTab uuid = do
    uhdlmap <- view (unitHoodles._2) <$> get
    let assoc = (map (\x -> (view unitUUID x,view unitKey x)) . M.elems) uhdlmap
    return (L.lookup uuid assoc)

-- |
switchTab :: Int -> MainCoroutine ()
switchTab tabnum = do
    xst <- get
    let notebook = view rootNotebook xst
    doIOaction_ $ Gtk.set notebook [Gtk.notebookPage Gtk.:= tabnum ]
    uhdls <- view unitHoodles <$> get

    let current = fst uhdls
    when (tabnum /= current) $ do 
      let uhdl = fromJustError "switchTab"  (M.lookup tabnum (snd uhdls))
      liftIO $ Gtk.widgetSetSensitive (uhdls^.(currentUnit.unitButton)) False
      liftIO $ Gtk.widgetSetSensitive (uhdl^.unitButton) True
      modify $ (unitHoodles.currentUnit .~ uhdl)
      updateUhdl $ \uhdl' -> liftIO (updatePageAll (view hoodleModeState uhdl') uhdl')
      invalidateAll 
      liftIO $ reflectUIToggle (xst ^. gtkUIManager) "SAVEA" (not (uhdl ^. isSaved))
      reflectPenModeUI
      reflectCursor True

-- |
closeTab :: MainCoroutine ()
closeTab = do 
  xst <- get
  let (currk,uhdlmap) = xst ^. unitHoodles
      uhdlmap' = M.delete currk uhdlmap 
      uhdllst'' = (map (\(x,y)-> (x,(unitKey .~ x) y)) . zip [0..] . M.elems) uhdlmap'
      uhdlmap'' = M.fromList uhdllst''
      sz = M.size uhdlmap
  if (sz > 1) 
    then do
      let notebook = xst ^. rootNotebook
      doIOaction_ $ Gtk.notebookRemovePage notebook currk
      modify $ (unitHoodles .~ (0,uhdlmap''))
      canvasZoomUpdateAll
      switchTab 0
    else liftIO $ Gtk.mainQuit