content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  module Hoodle.Coroutine.Window where
  
  import Control.Lens (over, set, view, (.~), (^.), _2)
  import Control.Monad (when)
  import Control.Monad.IO.Class (liftIO)
  import Control.Monad.State (get, gets, modify, put)
  import Data.Hoodle.Generic (gdimension)
  import Data.Hoodle.Simple (Dimension (..))
  import qualified Data.IntMap as M
  import qualified Data.List as L
  import Data.UUID (UUID)
  import qualified Graphics.UI.Gtk as Gtk
  import Hoodle.Accessor
    ( getCurrentPageCvsId,
      pureUpdateUhdl,
      updateUhdl,
    )
  import Hoodle.Coroutine.Draw
    ( doIOaction_,
      invalidateAll,
      invalidateInBBox,
      nextevent,
    )
  import Hoodle.Coroutine.File (getFileContent)
  import Hoodle.Coroutine.Mode (sing2ContPage)
  import Hoodle.Coroutine.Page
    ( canvasZoomUpdateAll,
      canvasZoomUpdateBufAll,
      pageZoomChange,
    )
  import Hoodle.GUI.Reflect
    ( blockWhile,
      changeCurrentCanvasId,
      reflectCursor,
      reflectPenModeUI,
      reflectUIToggle,
    )
  import Hoodle.ModelAction.Page (updatePageAll)
  import Hoodle.ModelAction.Window
    ( constructFrame,
      constructFrame',
      createTab,
      eventConnect,
      newCanvasId,
      registerFrameToContainer,
    )
  import Hoodle.Type.Canvas
    ( CanvasId,
      CanvasInfo (_canvasId),
      CanvasInfoBox (CanvasContPage, CanvasSinglePage),
      defaultCvsInfoSinglePage,
      unboxBiAct,
      updateCanvasDimForContSingle,
      updateCanvasDimForSingle,
    )
  import Hoodle.Type.Coroutine (MainCoroutine, maybeError)
  import Hoodle.Type.Enum (DrawFlag (Efficient))
  import Hoodle.Type.Event
    ( UserEvent (CanvasConfigure, PaneMoveEnd, UpdateCanvas),
    )
  import Hoodle.Type.HoodleState
    ( FileStore,
      callBack,
      currentCanvasInfo,
      currentUnit,
      cvsInfoMap,
      emptyUnitHoodle,
      frameState,
      getCanvasInfo,
      getCurrentCanvasId,
      gtkUIManager,
      hoodleFileControl,
      hoodleFileName,
      hoodleModeState,
      isFullScreen,
      isSaved,
      rootContainer,
      rootNotebook,
      rootOfRootWindow,
      rootWindow,
      setCanvasInfo,
      setCanvasInfoMap,
      switchTabSignal,
      uiComponentSignalHandler,
      undoTable,
      unitButton,
      unitHoodles,
      unitKey,
      unitUUID,
      updateFromCanvasInfoAsCurrentCanvas,
    )
  import Hoodle.Type.PageArrangement
    ( CanvasDimension (..),
      PageDimension (..),
      ZoomMode (FitWidth),
    )
  import Hoodle.Type.Undo (emptyUndo)
  import Hoodle.Type.Window
    ( SplitType,
      WindowConfig (Node),
      removeWindow,
      splitWindow,
    )
  import Hoodle.Util (fromJustError, msgShout)
  
  -- | 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 <- gets (view (unitHoodles . _2))
    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 <- gets (view unitHoodles)
  
    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'' = zipWith (\x y -> (x, (unitKey .~ x) y)) [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
  