Window.hs

module Application.HXournal.Coroutine.Window where

import Application.HXournal.Type.Event
import Application.HXournal.Type.Canvas
import Application.HXournal.Type.Window
import Application.HXournal.Type.XournalState
import Application.HXournal.Type.Coroutine
import Control.Monad.Trans
import Application.HXournal.ModelAction.Window
import Application.HXournal.Accessor
import Control.Category
import Data.Label
import Prelude hiding ((.),id)
import Graphics.UI.Gtk hiding (get,set)
import qualified Data.IntMap as M

eitherSplit :: SplitType -> Iteratee MyEvent XournalStateIO ()
eitherSplit stype = do
    xstate <- getSt
    let cmap = get canvasInfoMap xstate
        currcid = get currentCanvas xstate
        newcid = newCanvasId cmap 
        fstate = get frameState xstate
        -- xojstate = get xournalstate xstate
        enewfstate = splitWindow currcid (newcid,stype) fstate 
    case enewfstate of 
      Left _ -> return ()
      Right fstate' -> do 
        let oldcinfo = case M.lookup currcid cmap of
                         Nothing -> error "noway! in eitherSplit " 
                         Just c -> c 
        liftIO $ removePanes fstate 
        cinfo <- liftIO $ initCanvasInfo xstate newcid 
        let cinfo' = set viewInfo (get viewInfo oldcinfo)
                     . set currentPageNum (get currentPageNum oldcinfo)
                     . set currentPage (get currentPage oldcinfo)
                     $ cinfo
        let cmap' = M.insert newcid cinfo' cmap
        liftIO $ putStrLn $ "in window " ++ show (M.keys cmap')
        let rtwin = get rootWindow xstate
            rtcntr = get rootContainer xstate 
            xstate' = set canvasInfoMap cmap'
                      . set frameState fstate'
                      $ xstate
        putSt xstate'
        liftIO $ containerRemove rtcntr rtwin

        (win,fstate'') <- liftIO $ constructFrame fstate' cmap'         
        let xstate'' = set frameState fstate'' 
                       . set rootWindow win $ xstate'
        putSt xstate''
        liftIO $ boxPackEnd rtcntr win PackGrow 0 
        liftIO $ widgetShowAll rtcntr 


deleteCanvas :: Iteratee MyEvent XournalStateIO ()
deleteCanvas = do 
    liftIO $ putStrLn "deleteCanvas"  
    xstate <- getSt
    let cmap = get canvasInfoMap xstate
        currcid = get currentCanvas xstate
        fstate = get frameState xstate
        -- xojstate = get xournalstate xstate
        enewfstate = removeWindow currcid fstate 
    case enewfstate of 
      Left _ -> return ()
      Right Nothing -> return ()
      Right (Just fstate') -> do 
        let oldcinfo = case M.lookup currcid cmap of
                         Nothing -> error "noway! in deleteCanvas " 
                         Just c -> c 
        liftIO $ removePanes fstate 

        let cmap' = M.delete currcid cmap
            newcurrcid = maximum (M.keys cmap')
        xstate' <- changeCurrentCanvasId newcurrcid 
        liftIO $ putStrLn $ "in window " ++ show (M.keys cmap')
        let rtwin = get rootWindow xstate'
            rtcntr = get rootContainer xstate' 
            xstate'' = set canvasInfoMap cmap'
                       . set frameState fstate'
                       $ xstate'
        putSt xstate''
        liftIO $ containerRemove rtcntr rtwin

        (win,fstate'') <- liftIO $ constructFrame fstate' cmap'         
        let xstate''' = set frameState fstate'' 
                        . set rootWindow win $ xstate''
        putSt xstate'''
        liftIO $ boxPackEnd rtcntr win PackGrow 0 
        liftIO $ widgetShowAll rtcntr 

        liftIO $ widgetDestroy (get scrolledWindow oldcinfo)
        liftIO $ widgetDestroy (get drawArea oldcinfo)